Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Exploring quadratic residues and fixed points with clock arithmetic and digraphs, in Clojurescript with force-directed graph layout provided by _arbor.js_. Inspired, in part, by http://pi3.sites.sheffield.ac.uk/tutorials/week-8. Defaults to 51 data points, which produces a pleasing digraph, but add a _num=X_ param to the URL to show different ri…
(ns quadratic-residue.demo.core)
(defn follow [lookup-table]
(fn [n]
(loop [k n
edges {}]
(let [next-k (lookup-table k)]
(if (edges next-k)
edges
(recur next-k (assoc edges k next-k)))))))
(defn digraph [n f]
(let [lookup-table (mapv #(mod (f %) n) (range n))]
(apply merge (map (follow lookup-table) (range n)))))
(defn fixed-point? [[a b]] (= a b))
(ns quadratic-residue.demo.renderer
(:require
[arbor :as arbor]
[enchilada :refer [ctx canvas value-of]]
[quadratic-residue.demo.core :refer [digraph fixed-point?]]
[jayq.core :refer [show]]
[monet.canvas :refer [begin-path move-to line-to save translate rotate restore
fill-style fill fill-rect circle text text-align text-baseline
stroke-style stroke-width stroke]]))
(defn draw-edge! [edge pt1 pt2]
(let [x1 (.-x pt1)
y1 (.-y pt1)
x2 (.-x pt2)
y2 (.-y pt2)
angle (+ (Math/atan (/ (- y2 y1) (- x2 x1)))
(/ Math/PI (if (> x2 x1) 2 -2)))]
(->
ctx
(move-to x1 y1) ; line
(line-to x2 y2)
(save) ; arrow on (x2,y2)
(translate x2 y2)
(rotate angle)
(move-to 3 15)
(line-to 0 8)
(line-to -3 15)
(restore))))
(defn draw-node! [node pt]
(let [args {:x (.-x pt) :y (.-y pt) :r 10 :text (.-name node)}]
(->
ctx
(fill-style :lightblue)
(circle args)
(fill)
(fill-style :black)
(text args))))
(deftype Renderer [init redraw])
(defn renderer [width height]
(let [particle-system (atom nil)]
(Renderer.
; init
(fn [system]
(reset! particle-system system)
(. @particle-system (screenSize width height))
(. @particle-system (screenPadding 80)))
; redraw
(fn []
(->
ctx
(text-align :center)
(text-baseline :middle)
(fill-style :white)
(fill-rect {:x 0 :y 0 :w width :h height})
(stroke-style :lightgrey)
(stroke-width 1)
(begin-path))
(. @particle-system (eachEdge draw-edge!))
(-> ctx (stroke))
(. @particle-system (eachNode draw-node!))))))
(defn process [n f]
(let [edges (digraph (js/parseInt n) f)
sys (arbor/ParticleSystem.
(js/parseInt (value-of :repulsion 200))
(js/parseInt (value-of :stiffness 100))
(js/parseFloat (value-of :friction 0.5))
true)] ; gravity
(set! (.-renderer sys) (renderer 800 600))
(doseq [[from to] (remove fixed-point? edges)]
(.addEdge sys (str from) (str to) (clj->js {"length" 2})))
(doseq [node (->> edges (filter fixed-point?) (map first))]
(.addNode sys (str node) (clj->js {"mass" 1.0})))))
(show canvas)
(process
(value-of :num 51)
(fn [x] (* x x)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment