clementine 0.0.1 → 0.0.2

data/ext/clojure-clojurescript-bef56a7/samples/twitterbuzz/src/twitterbuzz/dom-helpers.cljs

@@ -0,0 +1,95 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns twitterbuzz.dom-helpers
+  (:require [clojure.string :as string]
+            [goog.dom :as dom]))
+
+(defn get-element
+  "Return the element with the passed id."
+  [id]
+  (dom/getElement (name id)))
+
+(defn append
+  "Append all children to parent."
+  [parent & children]
+  (do (doseq [child children]
+        (dom/appendChild parent child))
+      parent))
+
+(defn set-text
+  "Set the text content for the passed element returning the
+  element. If a keyword is passed in the place of e, the element with
+  that id will be used and returned."
+  [e s]
+  (let [e (if (keyword? e) (get-element e) e)]
+    (doto e (dom/setTextContent s))))
+
+(defn normalize-args [tag args]
+  (let [parts (string/split (name tag) #"(\.|#)")
+        [tag attrs] [(first parts)
+                     (apply hash-map (map #(cond (= % ".") :class
+                                                 (= % "#") :id
+                                                 :else %)
+                                          (rest parts)))]]
+    (if (map? (first args))
+      [tag (merge attrs (first args)) (rest args)]
+      [tag attrs args])))
+
+(defn element
+  "Create a dom element using a keyword for the element name and a map
+  for the attributes. Append all children to parent. If the first
+  child is a string then the string will be set as the text content of
+  the parent and all remaining children will be appended."
+  [tag & args]
+  (let [[tag attrs children] (normalize-args tag args)
+        parent (dom/createDom (name tag)
+                              (reduce (fn [o [k v]]
+                                        (aset o k v))
+                                      (js-obj)
+                                      (map #(vector (name %1) %2)
+                                           (keys attrs)
+                                           (vals attrs))))
+        [parent children] (if (string? (first children))
+                            [(set-text (element tag attrs) (first children))
+                             (rest children)]
+                            [parent children])]
+    (apply append parent children)))
+
+(defn remove-children
+  "Remove all children from the element with the passed id."
+  [id]
+  (let [parent (dom/getElement (name id))]
+    (do (dom/removeChildren parent))))
+
+(defn html
+  "Create a dom element from an html string."
+  [s]
+  (dom/htmlToDocumentFragment s))
+
+(defn- element-arg? [x]
+  (or (keyword? x)
+      (map? x)
+      (string? x)))
+
+(defn build
+  "Build up a dom element from nested vectors."
+  [x]
+  (if (vector? x)
+    (let [[parent children] (if (keyword? (first x))
+                              [(apply element (take-while element-arg? x))
+                               (drop-while element-arg? x)]
+                              [(first x) (rest x)])
+          children (map build children)]
+      (apply append parent children))
+    x))
+
+(defn insert-at
+  "Insert a child element at a specific location."
+  [parent child index]
+  (dom/insertChildAt parent child index))

data/ext/clojure-clojurescript-bef56a7/samples/twitterbuzz/src/twitterbuzz/layout.cljs

@@ -0,0 +1,100 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns twitterbuzz.layout
+  (:require [twitterbuzz.anneal :as ann]
+            [twitterbuzz.radial :as rad]
+            [goog.math :as math]))
+
+(defn random-loc []
+  {:x (ann/random) :y (ann/random)})
+
+(defn sqr [x]
+  (* x x))
+
+(defn sqrt [x]
+  (js/Math.sqrt x))
+
+(defn dist [{x1 :x y1 :y} {x2 :x y2 :y}]
+  (sqrt (+ (sqr (- x2 x1)) (sqr (- y2 y1)))))
+
+(defn init-state [mentions-data]
+  (let [connected (reduce (fn [ret [k {:keys [mentions]}]]
+                            (if (pos? (count mentions))
+                              (into (conj ret k) (keys mentions))
+                              ret))
+                          #{} mentions-data)
+        mentions-data (select-keys mentions-data connected)]
+    {:locs (zipmap connected (repeatedly #(random-loc)))
+     :mentions mentions-data}))
+
+(defn roots [mentions-data]
+  (let [parents (reduce (fn [ret [k {:keys [mentions]}]]
+                          (if (pos? (count mentions))
+                            (conj ret k)
+                            ret))
+                        #{} mentions-data)]
+    (reduce disj parents (mapcat #(keys (:mentions %)) (vals mentions-data)))))
+
+(defn radial
+  [mentions-data]
+  (let [mentions #(rad/get-mentions mentions-data %)
+        weights (rad/weights
+                 (into (set (roots mentions-data)) (mapcat mentions (keys mentions-data)))
+                 mentions)]
+    {:mentions mentions-data
+     :locs (-> (rad/layout (roots mentions-data) weights mentions)
+               (rad/polar->cartesian 3))}))
+
+(defn score [{:keys [locs mentions]}]
+  (let [metric (fn [d w] (sqr (- 1 (* d w))))
+        score-user (fn [[k {:keys [mentions]}]]
+                     (if (zero? (count mentions))
+                       0
+                       (let [loc (locs k)]
+                         (reduce (fn [score [ok w]]
+                                   (+ score (metric (dist loc (locs ok)) w)))
+                                 0
+                                 mentions))))]
+    (reduce + (map score-user mentions))))
+
+(defn permute-swap [{:keys [locs mentions]} t]
+  ;;first cut - swap
+  (let [xys (vec (vals locs))
+        swap1 (math/randomInt (count xys))
+        swap2 (math/randomInt (count xys))
+        temp (xys swap1)
+        xys (assoc xys swap1 (xys swap2))
+        xys (assoc xys swap2 temp)]
+    {:locs (zipmap (keys locs) xys)
+     :mentions mentions}))
+
+(defn permute-move [{:keys [locs mentions]} t]
+  (let [adj #(min 1.0 (max 0 (+ % (- (* (ann/random) 0.1) 0.05))))
+        move (fn [{:keys [x y] :as loc}]
+               (if true ;;(> (ann/random) 0.8)
+                 {:x (adj x)
+                  :y (adj y)}
+                 loc))
+        xys (vec (vals locs))]
+    {:locs (zipmap (keys locs) (map move (vals locs)))
+     :mentions mentions}))
+
+(comment
+(def test-data {})
+
+(def init (init-state test-data))
+
+(map (fn [x] {:best-score (:best-score x) :t (:t x)})
+     (take 10 (take-nth 100
+                        (ann/anneal score
+                                    (ann/linear-cooling 1000)
+                                    permute-move
+                                    ann/standard-prob
+                                    init))))
+  )

data/ext/clojure-clojurescript-bef56a7/samples/twitterbuzz/src/twitterbuzz/leaderboard.cljs

@@ -0,0 +1,40 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns twitterbuzz.leaderboard
+  (:require [twitterbuzz.core :as buzz]
+            [twitterbuzz.dom-helpers :as dom]))
+
+(defn leaderboard-element
+  "Create a leaderboard element from a user map."
+  [user]
+  (dom/build [:div.tweet
+              [:img.profile-pic {:src (:image-url user)}]
+              [:div.tweet-details
+               [:div.user-name (:username user)]
+               [:div.tweet-text (dom/html (buzz/markup (:last-tweet user)))]
+               [:div (str (buzz/num-mentions user))]]]))
+
+(defn leaders
+  "Given a map of users, return a sequence of users in order of the
+  greatest to least number of mentions."
+  [nodes]
+  (reverse (sort-by #(buzz/num-mentions (second %)) nodes)))
+
+(defn update-leaderboard
+  "Put the top 5 mentioned users in the leaderboard."
+  [graph]
+  (do (dom/remove-children :leaderboard-content)
+      (doseq [next-node (take 5 (leaders (seq graph)))]
+        (dom/append (dom/get-element :leaderboard-content)
+                    (leaderboard-element (second next-node))))))
+
+;; Register event listeners.
+
+(buzz/register :track-clicked #(dom/remove-children :leaderboard-content))
+(buzz/register :graph-update update-leaderboard)

data/ext/clojure-clojurescript-bef56a7/samples/twitterbuzz/src/twitterbuzz/radial.cljs

@@ -0,0 +1,91 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns twitterbuzz.radial
+  (:require [clojure.set :as set]
+            [goog.math :as math]))
+
+(defn get-mentions
+  "Returns the set of mentions for k in mentions-data"
+  [mentions-data k]
+  (-> (get-in mentions-data [k :mentions])
+      keys
+      set))
+
+(defn get-descendants
+  "Given child-fn (a map of parent to child), and k, return the
+   set of all k's descendants. Set includes k."
+  [child-fn k]
+  (loop [kids #{k}
+         check #{k}]
+    (let [[c] (seq check)]
+      (if c
+        (recur (into kids (child-fn c))
+               (into (disj check c) (remove kids (child-fn c))))
+        kids))))
+
+(defn weight
+  "Weight of noce, given child-fn (mapping of node to set
+   of kids)."
+  [node child-fn]
+  (if-let [kids (seq (child-fn node))]
+    (reduce + (map #(weight % child-fn) kids))
+    1))
+
+(defn weights
+  "Return a map of node to its weight,
+   using child-fn to get the set of children for a node."
+  [nodes child-fn]
+  (reduce
+   (fn [m n] (assoc m n (weight n child-fn)))
+   {}
+   nodes))
+
+(defn layout
+  "Returns a map of node => :radius, :slice, :angle.
+
+    weight-fn: one arg fn of node returning weight
+    child-fn:  one arg fn of node returning set of nodes"
+  ([nodes weight-fn child-fn]
+     (layout nodes weight-fn child-fn 1 0 360 #{}))
+  ([nodes weight-fn child-fn radius a1 a2 seen]
+     (let [slice (- a2 a1)
+           total-weight (reduce + (map #(or (weight-fn %)
+                                            (throw (str "No weight for " %))) nodes))
+           seen (into seen nodes)]
+       (loop [m {}
+              c1 a1
+              [node & more] (seq nodes)]
+         (if node
+           (let [s (* slice (/ (weight-fn node) total-weight))
+                 c2 (+ c1 s)]
+             (recur
+              (merge
+               m
+               {node {:radius radius :slice s :angle (/ (+ c1 c2) 2)}}
+               (when-let [children (seq (remove seen (child-fn node)))]
+                 (layout children weight-fn child-fn (inc radius) c1 c2 seen)))
+              c2
+              more))
+           m)))))
+
+(defn polar->cartesian
+  "Convert polar coordinates (from layout) into
+   cartesian coordinates on the unit square, assuming the
+   square will display max-rings rings."
+  [polar-map max-rings]
+  (reduce
+   (fn [m [k {:keys [radius angle]}]]
+     (let [r (/ radius (+ 0.5 max-rings) 2)]
+       (assoc m k {:x (+ 0.5 (math/angleDx angle r))
+                   :y (+ 0.5 (math/angleDy angle r))})))
+   {}
+   polar-map))
+
+
+

data/ext/clojure-clojurescript-bef56a7/samples/twitterbuzz/src/twitterbuzz/showgraph.cljs

@@ -0,0 +1,121 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns twitterbuzz.showgraph
+  (:require [twitterbuzz.core :as buzz]
+            [twitterbuzz.layout :as layout]
+            [twitterbuzz.dom-helpers :as dom]
+            [twitterbuzz.timeline :as timeline]
+            [goog.events :as events]
+            [goog.style :as style]
+            [goog.math.Coordinate :as Coordinate]
+            [goog.ui.HoverCard :as HoverCard]
+            [goog.graphics.Font :as Font]
+            [goog.graphics.Stroke :as Stroke]
+            [goog.graphics.SolidFill :as SolidFill]
+            [goog.graphics :as graphics]))
+
+; Drawing configuration
+(def avatar-size 32) ; used for both x and y dimensions of avatars
+; fail whale
+;(def default-avatar "http://farm3.static.flickr.com/2562/4140195522_e207b97280_s.jpg")
+; google+ silhouette
+(def default-avatar "http://ssl.gstatic.com/s2/profiles/images/silhouette48.png")
+(defn debug [_])
+;(defn debug [a] (str "t: " (:t a) " score: " (:best-score a)))
+
+; BAD HACK: don't change globals like this -- find a better way:
+;(set! anim/TIMEOUT 500)
+
+(def edge-stroke (graphics/Stroke. 1 "#009"))
+
+(def g
+  (doto (graphics/createGraphics "100%" "100%")
+    (.render (dom/get-element :network))))
+
+(def font (graphics/Font. 12 "Arial"))
+(def fill (graphics/SolidFill. "#f00"))
+
+(defn unit-to-pixel [unit-arg canvas-size]
+  (+ (* unit-arg (- canvas-size avatar-size)) (/ avatar-size 2)))
+
+(defn log [& args]
+  (js/console.log (apply pr-str args)))
+
+(def avatar-hover
+  (doto
+    (goog.ui/HoverCard. (js-obj)) ; svg IMAGE tags don't work here
+    (.setElement (dom/get-element :avatar-hover))))
+
+(defn hide-tooltip [event]
+  (.setVisible avatar-hover false))
+
+(defn attach-tooltip [img canvas-offset px py tweet]
+  (events/listen img events/EventType.MOUSEOUT hide-tooltip)
+  (events/listen
+    img events/EventType.MOUSEOVER
+    (fn [event]
+        (hide-tooltip event)
+        (.setPosition avatar-hover
+                    (goog.ui/Tooltip.CursorTooltipPosition.
+                        (Coordinate/sum (goog.math/Coordinate. px py)
+                                        canvas-offset)))
+        (dom/remove-children :avatar-hover-body)
+        (dom/append (dom/get-element :avatar-hover-body)
+                    (timeline/timeline-element tweet))
+        (.triggerForElement avatar-hover img))))
+
+(defn draw-graph [{:keys [locs mentions]} text]
+  (let [canvas-size (. g (getPixelSize))
+        canvas-offset (style/getPageOffset (dom/get-element :network))]
+    (. g (clear))
+
+    ; Draw mention edges
+    (doseq [[username {ux1 :x, uy1 :y}] locs
+            :let [x1 (unit-to-pixel ux1 (.-width canvas-size))
+                  y1 (unit-to-pixel uy1 (.-height canvas-size))]
+            [mention-name mention-count] (:mentions (get mentions username))]
+      (when-let [{ux2 :x, uy2 :y} (get locs mention-name)]
+        (let [x2 (unit-to-pixel ux2 (.-width canvas-size))
+              y2 (unit-to-pixel uy2 (.-height canvas-size))]
+          (.drawPath g
+                    (-> (. g (createPath)) (.moveTo x1 y1) (.lineTo x2 y2))
+                    edge-stroke nil))))
+
+    ; Draw avatar nodes
+    (doseq [[username {:keys [x y] :as foo}] locs]
+      ;(log (pr-str foo))
+      (let [px (- (unit-to-pixel x (.-width canvas-size))  (/ avatar-size 2))
+            py (- (unit-to-pixel y (.-height canvas-size)) (/ avatar-size 2))
+            user (get mentions username)
+            image-url (get user :image-url default-avatar)
+            img (.drawImage g px py avatar-size avatar-size image-url)]
+        (attach-tooltip img canvas-offset px py
+                        {:profile_image_url image-url
+                         :text (:last-tweet user)
+                         :from_user (:username user)})))
+
+    (let [text (if (empty? locs)
+                 "No locations to graph"
+                 text)]
+      (when text
+        (.drawTextOnLine g text 5 20 (.-width canvas-size) 20
+                        "left" font nil fill)))))
+
+(def graph-data (atom nil))
+
+;; Register event listeners.
+
+(buzz/register :graph-update
+  (fn [data]
+    (reset! graph-data data)
+    (draw-graph (layout/radial data) nil)))
+
+(events/listen (dom/get-element :network) events/EventType.CLICK
+               #(draw-graph (layout/radial @graph-data) nil))
+(buzz/register :track-clicked #(. g (clear)))