Created
August 8, 2016 04:32
-
-
Save xtrntr/df868bc63ad3c82ca9aa7629ecf4fd2c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
var CLOSURE_UNCOMPILED_DEFINES = null; | |
if(typeof goog == "undefined") document.write('<script src="js/compiled/out/goog/base.js"></script>'); | |
document.write('<script src="js/compiled/out/cljs_deps.js"></script>'); | |
document.write('<script>if (typeof goog == "undefined") console.warn("ClojureScript could not load :main, did you forget to specify :asset-path?");</script>'); | |
document.write("<script>if (typeof goog != \"undefined\") { goog.require(\"figwheel.connect\"); }</script>"); | |
document.write('<script>goog.require("cljs_d3.core");</script>'); |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns cljs-d3.gamelogic | |
(:require [om.core :as om :include-macros true] | |
[clojure.core.reducers :as reducers])) | |
(defn find-zero-indexes [lst] | |
"takes a list of numbers, and returns the indexes of 0 values" | |
(keep-indexed (fn [idx v] | |
(when (= 0 v) idx)) lst)) | |
(defn new-tile [] | |
"10% chance of 4 tile, 90% chance of 2 tile" | |
(if (zero? (rand-int 10)) 4 2)) | |
(defn unmemoized-merge-row [row] | |
"applies 2048 rules of merging from right to left" | |
(let [non-zeroes (remove zero? row) | |
merged (loop [lst non-zeroes | |
acc []] | |
(cond | |
(empty? lst) acc | |
(= (first lst) (second lst)) (recur (drop 2 lst) (conj acc (* 2 (first lst)))) | |
:else (recur (rest lst) (conj acc (first lst))))) | |
num-zeroes-removed (- 4 (count merged))] | |
(into merged (vec (repeat num-zeroes-removed 0))))) | |
(def merge-row (memoize unmemoized-merge-row)) | |
(defn rotate-grid [grid] | |
"rotate a grid 90 degrees clockwise" | |
(if grid | |
(into [] (for [idx (list 12 8 4 0 | |
13 9 5 1 | |
14 10 6 2 | |
15 11 7 3)] | |
(nth grid idx))) | |
false)) | |
;; for other directions, rotate then apply move-left and rotate back | |
;; if not a valid, return false | |
(defn unmemoized-move-left [grid] | |
(let [row1 (subvec grid 0 4) | |
row2 (subvec grid 4 8) | |
row3 (subvec grid 8 12) | |
row4 (subvec grid 12 16) | |
res (-> (map merge-row (list row1 row2 row3 row4)) | |
flatten | |
vec)] | |
(if (= grid res) | |
false | |
res))) | |
(def move-left | |
;; takes a grid returns a grid | |
(memoize unmemoized-move-left)) | |
(defn move-down [grid] | |
(-> grid | |
rotate-grid | |
move-left | |
rotate-grid | |
rotate-grid | |
rotate-grid)) | |
(defn move-right [grid] | |
(-> grid | |
rotate-grid | |
rotate-grid | |
move-left | |
rotate-grid | |
rotate-grid)) | |
(defn move-up [grid] | |
(-> grid | |
rotate-grid | |
rotate-grid | |
rotate-grid | |
move-left | |
rotate-grid)) | |
(defn show-game-over [app] | |
(om/update! app [:game-over] "game-message game-over")) | |
(defn game-over? [grid] | |
"return f on a full non-zero grid with no possible mergeable row/columns" | |
;; (let [col1 (utils/subset grid '(0 4 8 12)) | |
;; col2 (utils/subset grid '(1 5 9 13)) | |
;; col3 (utils/subset grid '(2 6 10 14)) | |
;; col4 (utils/subset grid '(3 7 11 15)) | |
;; row1 (subvec grid 0 4) | |
;; row2 (subvec grid 4 8) | |
;; row3 (subvec grid 8 12) | |
;; row4 (subvec grid 12 16)] | |
;; (every? (fn [lst] | |
;; (loop [lst lst] | |
;; (cond | |
;; (empty? lst) true | |
;; (zero? (first lst)) false | |
;; (= (first lst) (second lst)) false | |
;; :else (recur (rest lst))))) | |
;; (list col1 col2 col3 col4 row1 row2 row3 row4))) | |
false) | |
(defn clear-grid [app] | |
(om/update! app [:grid-values] [0 0 0 0 | |
0 0 0 0 | |
0 0 0 0 | |
0 0 0 0])) | |
(defn add-new-tile [app] | |
(let [grid (get @app :grid-values) | |
indexes (find-zero-indexes grid) | |
chosen-idx (nth indexes (rand-int (count indexes))) | |
new-grid (assoc grid chosen-idx (new-tile))] | |
(om/update! app [:grid-values] new-grid) | |
(if (game-over? new-grid) | |
(show-game-over app)))) | |
(defn restart-game [app] | |
(om/update! app [:game-over] false) | |
(clear-grid app) | |
(add-new-tile app) | |
(add-new-tile app)) | |
(defn move [app direction] | |
(let [grid (get @app :grid-values) | |
new-grid (cond (= direction :left) (move-left grid) | |
(= direction :right) (move-right grid) | |
(= direction :down) (move-down grid) | |
(= direction :up) (move-up grid))] | |
(when new-grid | |
(om/update! app [:grid-values] new-grid) | |
(add-new-tile app)))) | |
(defn generate-moves [grid] | |
;; takes a grid as arg and returns a vector of valid moves | |
(filterv #(not (false? %)) [(move-left grid) | |
(move-right grid) | |
(move-up grid) | |
(move-down grid)])) | |
(defn generate-spawns [grid] | |
;; takes a grid as arg and returns a vector of possible spawns | |
(let [indexes (find-zero-indexes grid)] | |
(reduce into (for [idx indexes] | |
[(assoc grid idx 2) | |
(assoc grid idx 4)])))) | |
(def geom-seq | |
(for [idx (range 16)] | |
(/ 1 (.pow js/Math 2 idx)))) | |
(defn sumlist [list] | |
(reduce + list)) | |
(def monotonicity | |
"state is vector of 16 values | |
zip multiply the vector with a geometric sequence" | |
(memoize | |
(fn [grid] | |
(let [configs (list grid | |
(reverse grid) | |
(rotate-grid grid) | |
(reverse (rotate-grid grid)))] | |
(apply max | |
(map | |
(fn [grid] (sumlist (map * geom-seq grid))) | |
configs)))))) | |
(defn weight-zero-tiles [grid] | |
"bonus for more empty tiles" | |
(* (/ 1 16) (count (inc (find-zero-indexes grid))))) | |
(defn score-grid [grid] | |
"2 heuristics used : number of empty spaces, monotonicity of the board." | |
(monotonicity grid)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns cljs-d3.gametree | |
(:require [cljs.core.async :refer [put! chan <! >! timeout close!]] | |
[om.core :as om :include-macros true] | |
[om.dom :as dom :include-macros true] | |
[clojure.string :as str] | |
[cljsjs.d3] | |
[goog.string :as gstring] | |
[goog.string.format] | |
[cljs-d3.gamelogic :as logic] | |
[clojure.data :as data]) | |
(:require-macros | |
[cljs.core.async.macros :as m :refer [go go-loop]])) | |
(defn my-timeout [ms] | |
(let [c (chan)] | |
(js/setTimeout (fn [] (close! c)) ms) | |
c)) | |
(def row 0) | |
(def col 0) | |
(defn cell-color [val] | |
(cond (or (= val 0) (= val 2)) "#eee4da" | |
(= val 4) "#ede0c8" | |
(= val 8) "#f2b179" | |
(= val 16) "#f59563" | |
(= val 32) "#f67c5f" | |
(= val 64) "#f65e3b" | |
(= val 128) "#edcf72" | |
(= val 256) "#edcc61" | |
(= val 512) "#edc850" | |
(= val 1024) "#edc53f" | |
(= val 2048) "#edc22e")) | |
(defn digits [n] | |
(if (zero? n) | |
'(0) | |
(->> n | |
(iterate #(quot % 10)) | |
(take-while pos?) | |
(mapv #(mod % 10)) | |
count))) | |
(defn text-color [val] | |
(let [white "#f9f6f2" | |
black "#776e65"] | |
(if (> val 4) white black))) | |
(def max-depth 4) | |
(def visited-nodes (clj->js [])) | |
(def prev-node (clj->js {:parent "null" | |
:grid | |
[0 2 4 512 | |
2 4 8 256 | |
4 2 16 128 | |
2 4 32 64] | |
})) | |
(def scores (clj->js [])) | |
(def best-grid (clj->js {:score 0})) | |
(def node-counter 0) | |
;; push next-node into the array of all nodes. | |
(defn depth-first-search [owner] | |
(let [curr-depth (om/get-state owner :depth)] | |
(cond (zero? curr-depth) (do (.push visited-nodes prev-node) | |
(om/set-state! owner :depth (inc curr-depth))) | |
:else (let [visited-grids (js->clj (.map visited-nodes (fn [n] (.-grid n)))) | |
possible-children (if (odd? curr-depth) | |
(logic/generate-moves (js->clj (.-grid prev-node))) | |
(logic/generate-spawns (js->clj (.-grid prev-node)))) | |
valid-children (for [children possible-children | |
:when (not (some #{children} visited-grids))] | |
children) | |
has-children? (not (empty? valid-children)) | |
going-down? (and has-children? (not (= curr-depth max-depth))) | |
probability (if (odd? curr-depth) | |
1 | |
(let [new-spawn (first (filter integer? (first (data/diff (first valid-children) | |
(js->clj (.-grid prev-node))))))] | |
(if (= new-spawn 2) | |
0.9 | |
0.1))) | |
next-node (if (even? curr-depth) | |
(clj->js {:grid (first valid-children) | |
:probability probability}) | |
(clj->js {:grid (first valid-children)}))] | |
;; we go up when there is no more children. | |
(if going-down? | |
(om/set-state! owner :depth (inc curr-depth)) | |
(if (not has-children?) | |
(om/set-state! owner :depth (dec curr-depth)))) | |
(if going-down? | |
(do (when prev-node | |
(if (.. prev-node -children) | |
(.. prev-node -children (push next-node)) | |
(set! (.-children prev-node) (clj->js [next-node])))) | |
(.push visited-nodes next-node) | |
(set! prev-node next-node)) | |
(if has-children? | |
(do (when prev-node | |
(if (.. prev-node -children) | |
(.. prev-node -children (push next-node)) | |
(set! (.-children prev-node) (clj->js [next-node])))) | |
(.push visited-nodes next-node)) | |
(let [children-num (.. prev-node -children -length) | |
score (if (even? curr-depth) | |
(/ (reduce + (for [x (range children-num)] | |
(let [obj (.pop visited-nodes) | |
grid (.-grid obj) | |
prob (.-probability obj)] | |
;; (om/set-state! owner :id (dec (om/get-state owner :id))) | |
(* prob (logic/score-grid grid))))) children-num) | |
(apply max (for [x (range children-num)] | |
(let [obj (.pop visited-nodes) | |
grid (.-grid obj) | |
score (.-score obj)] | |
(when (> score (.-score best-grid)) | |
(set! best-grid obj)) | |
score))))] | |
(set! (.. prev-node -score) score) | |
(set! (.. prev-node -children -length) 0) | |
;; (.pop visited-nodes) | |
;; (.push visited-nodes prev-node) | |
(if (not (= (.-parent prev-node) "null")) | |
(set! prev-node (.-parent prev-node)) | |
(do ;; (set! (.. prev-node -score) "null") | |
;; (set! (.. prev-node -grid) (.-grid best-grid)) | |
(set! (.-length visited-nodes) 0) | |
(set! prev-node (clj->js {:parent "null" | |
:grid (.-grid best-grid)})) | |
(.push visited-nodes prev-node) | |
(.log js/console "r u ") | |
;; (.log js/console curr-depth) | |
;; (.log js/console (.-length visited-nodes)) | |
;; (js/clearInterval (om/get-state owner :timer)) | |
))))))))) | |
(defn tree-viz [app owner] | |
(reify | |
om/IInitState | |
(init-state [_] | |
{:margin (clj->js {:top 50 | |
:right 50 | |
:bottom 50 | |
:left 50}) | |
:width 1020 | |
:height 820 | |
:board-size 100 | |
:cell-size 25 | |
:tree (.. js/d3.layout | |
tree | |
(size (clj->js [800 600]))) | |
:diagonal (.. js/d3.svg | |
diagonal | |
(projection (fn [d] (clj->js [(.-x d) (.-y d)])))) | |
:bg-color "rgb(255, 219, 122)" | |
:grid-color "#bbada0" | |
:finished false | |
:id 0 | |
:timer nil | |
:timeout 250 | |
:depth 0 | |
:svg nil}) | |
om/IDidMount | |
(did-mount [_] | |
(let [timeout (om/get-state owner :timeout) | |
tree (om/get-state owner :tree)] | |
(.. tree (separation (fn [a b] 2))) | |
(om/set-state! owner :svg (.. js/d3 | |
(select ".svg") | |
(append "svg") | |
(attr (clj->js {:width (om/get-state owner :width) | |
:height (om/get-state owner :height)})) | |
(append "g") | |
(attr (clj->js {:transform (str "translate(" 110 "," 110 ")")})))) | |
(om/set-state! owner :timer | |
(js/setInterval (fn [] | |
(depth-first-search owner) | |
(.log js/console "ok?") | |
(let [root (aget visited-nodes 0) | |
svg (om/get-state owner :svg) | |
board-size (om/get-state owner :board-size) | |
cell-size (om/get-state owner :cell-size) | |
width (om/get-state owner :width) | |
grid-color (om/get-state owner :grid-color) | |
root (aget visited-nodes 0) | |
node (.. svg | |
(selectAll "g.node-group") | |
(data (.. tree (nodes root)) | |
(fn [d] | |
(let [curr-id (om/get-state owner :id)] | |
(if (.-id d) | |
(.-id d) | |
(do (set! (.-id d) curr-id) | |
(om/set-state! owner :id (inc curr-id)) | |
(.-id d))))))) | |
node-group (.. node | |
enter | |
(append "g") | |
(attr (clj->js {:class "node-group" | |
:transform (fn [d] | |
(if (= "null" (.-parent d)) | |
(str "translate(" (- (/ width 2) (/ board-size 2)) "," (- 0 (/ board-size 2)) ")") | |
(str "translate(" (- (.. d -parent -px) (/ board-size 2)) "," (- (.. d -parent -py) (/ board-size 2)) ")")))}))) | |
links (.. svg | |
(selectAll ".link") | |
(data (.. tree (links visited-nodes)) | |
(fn [d] (str (.. d -source -id) "-" (.. d -target -id)))))] | |
(.. links | |
enter | |
(insert "path" ".node-group") | |
(attr (clj->js {:class "link" | |
:fill "none" | |
:stroke "#666666" | |
:stroke-width 5 | |
:d (fn [d] | |
(let [o (clj->js {:x (.. d -source -px) | |
:y (.. d -source -py)})] | |
((om/get-state owner :diagonal) (clj->js {:source o | |
:target o}))))}))) | |
(.. node-group | |
(each (fn [d i] | |
(this-as this | |
(let [cell (.. js/d3 | |
(select this) | |
(selectAll "g.cell") | |
(data (.-grid d)) | |
enter | |
(append "g") | |
(attr (clj->js {:class "node" | |
:transform (fn [d] | |
(let [res (str "translate(" (* col cell-size) "," (* row cell-size) ")")] | |
(set! row (inc row)) | |
(when (= row 4) (set! row 0) (set! col (inc col))) | |
(when (= col 4) (set! col 0)) | |
res))})))] | |
(.. cell | |
(append "rect") | |
(attr (clj->js {:width cell-size | |
:height cell-size | |
:x 0 :y 0 | |
:stroke grid-color | |
:stroke-width 1 | |
:fill-opacity (fn [d] (if (= d 0) 0.85 1)) | |
:fill (fn [d] (cell-color d))}))) | |
(.. cell | |
(append "svg:text") | |
(attr (clj->js {:x (fn [d] | |
(let [n (digits d)] | |
(cond (= n 1) (* (+ 0.6 row) cell-size) | |
(= n 2) (* (+ 0.8 row) cell-size) | |
(= n 3) (* (+ 0.9 row) cell-size)))) | |
:y (* (+ 0.7 col) cell-size) | |
:fill (fn [d] (text-color d)) | |
:font-family "Clear Sans, Helvetica Neue, Arial, sans-serif" | |
:font-weight "Bold" | |
:font-size (/ cell-size 2) | |
:text-anchor "end"})) | |
(text (fn [d] (if (not (= 0 d)) d)))) | |
;; (.. cell | |
;; exit | |
;; remove) | |
cell))))) | |
(.. node | |
(each (fn [d i] | |
(this-as this | |
(when (and (not (= "null" (.-score d))) (.-score d)) | |
(let [grid (.. js/d3 | |
(select this) | |
(selectAll "g.grid") | |
(data (clj->js [1])))] | |
(.. grid | |
enter | |
(append "svg:rect") | |
(attr (clj->js {:class "cover" | |
:width board-size | |
:height board-size | |
;; :fill-opacity "0.5" | |
:x 0 :y 0}))) | |
(.. grid | |
enter | |
(append "svg:text") | |
(attr (clj->js {:x (/ board-size 2) | |
:y (/ board-size 2) | |
:fill "#776e65" | |
:font-family "Clear Sans, Helvetica Neue, Arial, sans-serif" | |
:font-weight "Bold" | |
:font-size 20 | |
:text-anchor "middle"})) | |
(text (gstring/format "%.3f" (.-score d)))))))))) | |
(.. node | |
transition | |
(duration timeout) | |
(attr (clj->js {:transform (fn [d] | |
(set! (.-py d) (.-y d)) | |
(set! (.-px d) (.-x d)) | |
(str "translate(" (- (.. d -x) (/ board-size 2)) "," (- (.. d -y) (/ board-size 2)) ")"))}))) | |
(.. links | |
transition | |
(duration timeout) | |
(attr (clj->js {:d (om/get-state owner :diagonal)}))) | |
(.. node | |
exit | |
transition | |
(duration timeout) | |
(attr (clj->js {:transform (fn [d] | |
(str "translate(" (- (.. d -parent -px) (/ board-size 2)) "," (- (.. d -parent -py) (/ board-size 2)) ")") | |
;;(str "translate(" 0 "," 0 ")") | |
)})) | |
remove) | |
(.. links | |
exit | |
transition | |
(duration timeout) | |
(attr (clj->js {:d (fn [d] | |
(let [o (clj->js {:x (.. d -source -x) | |
:y (.. d -source -y)})] | |
((om/get-state owner :diagonal) (clj->js {:source o | |
:target o}))))})) | |
remove) | |
;; (when (= "null" next-node) | |
;; (js/clearInterval (om/get-state owner :timer)) | |
;; (om/update! owner :finished true)) | |
)) | |
(+ 50 timeout))))) | |
om/IRender | |
(render [this] | |
(dom/div #js {:className "svg"})))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<!DOCTYPE html> | |
<html> | |
<head> | |
<meta charset="UTF-8"> | |
<!-- <meta name="viewport" content="width=device-width, initial-scale=1"> --> | |
<link href="css/style.css" rel="stylesheet" type="text/css"> | |
</head> | |
<body> | |
<div id="app"></div> | |
<script src="http://d3js.org/d3.v3.min.js"></script> | |
<script src="js/compiled/cljs_d3.js" type="text/javascript"></script> | |
</body> | |
</html> |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment