Skip to content

Instantly share code, notes, and snippets.

@xtrntr

xtrntr/cljs_d3.js

Created August 8, 2016 04:32
Show Gist options
  • Save xtrntr/df868bc63ad3c82ca9aa7629ecf4fd2c to your computer and use it in GitHub Desktop.
Save xtrntr/df868bc63ad3c82ca9aa7629ecf4fd2c to your computer and use it in GitHub Desktop.
Download ZIP
Raw
cljs_d3.js
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>');
Raw
gamelogic.cljs
(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))
Raw
gametrees.cljs
(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"}))))
Raw
index.html
<!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