OM Life and Benchwarmer

With Holidays come days off, so I had a chance to explore OM and core.async in ClojureScript.

First, I created a simple scoreboard sans timer, to keep track of various states in a structure like this:

	(defonce init
	(reset! app-state
	{:home {:home? true
	:score 0
	:timeouts 3}
	:away {:home? false
	:score 0
	:timeouts 3}
	:ball-on 50
	:to-go 10
	:down 1
	:qtr 1
	:time "15:00"
	:possession :home}))

view raw gistfile1.clj hosted with ❤ by GitHub

With the scoreboard driven by events put on a core.async channel, I had the idea to test the state changes with an event generator:

	(ns scoreboard.test
	(:require [scoreboard.events :as e :refer [publish!]]
	[scoreboard.core :as s]))
	(def score-range (range 0 150))
	(def timeouts-range (range 1 4))
	(def paths-values
	[[[:home :score] score-range]
	[[:home :timeouts] timeouts-range]
	[[:away :score] score-range]
	[[:away :timeouts] timeouts-range]
	[[:ball-on] (range 0 101)]
	[[:to-go] (range 0 101)]
	[[:down] (range 1 5)]
	[[:qtr] (range 1 5)]])
	(defn update-number-events []
	(map
	(fn [[path possible-values]]
	(e/event ::s/update-number {:path path
	:max (max possible-values)
	:min (min possible-values)
	:number (rand-nth possible-values)}))
	paths-values))
	(defn event-bag []
	(concat [(e/event ::s/change-possession)]
	(update-number-events)))
	(defn publish-random-event []
	(publish! (rand-nth (event-bag))))
	(defn main []
	(.setInterval js/window publish-random-event 10))

view raw gistfile1.clj hosted with ❤ by GitHub

The rendered results were kind of humorous: BenchWarmer

Watching the numbers on the scoreboard whiz by, I decided to redo my implementation of Conway's Game of Life using OM:

	(ns om-life.core
	(:require [om.core :as om :include-macros true]
	[om.dom :as dom :include-macros true]
	[om-life.events :as e :refer [publish! event]]
	[sablono.core :as html :refer-macros [html]]))
	(def seed
	#{[8 13] [9 13] [4 11] [6 13] [8 14] [11 14] [4 12] [5 13]
	[4 13] [14 14] [12 13] [15 14] [12 14] [14 13] [38 13]
	[37 13] [34 13] [35 14] [4 14] [34 14] [5 14] [32 13]
	[6 14] [27 12] [29 13] [27 11] [28 13] [31 14] [29 14]
	[37 14] [24 14] [27 14] [27 13] [41 14] [18 13] [20 14]
	[40 13] [18 14] [21 14] [17 14] [40 15] [17 13] [18 12]
	[23 14] [23 13] [21 13] [20 13]})
	(defonce life (atom seed))
	(defn change-cell
	([x y]
	(swap! life (fn [cells]
	(if (cells [x y])
	(set (remove #{[x y]} cells))
	(conj cells [x y])))))
	([x y add?]
	(if add?
	(swap! life conj [x y])
	(swap! life #(set (remove #{[x y]} %))))))
	(defn change [x y]
	(fn [e]
	(.preventDefault e)
	(change-cell x y)))
	(defonce dragging? (atom false))
	(defn drag-start [x y]
	(fn [e]
	(.preventDefault e)
	(reset! dragging? true)))
	(defn drag-end [x y]
	(fn [e]
	(.preventDefault e)
	(reset! dragging? false)))
	(defn drag-by [x y]
	(fn [e]
	(.preventDefault e)
	(if @dragging?
	(change-cell x y :add))))
	(defn cell [{:keys [x y alive?]} owner]
	(reify
	om/IRender
	(render [_]
	(html
	[:td {:class (if alive? "alive")
	:draggable true
	:on-click (change x y)
	:on-mouse-down (drag-start x y)
	:on-mouse-up (drag-end x y)
	:on-mouse-move (drag-by x y)}]))))
	(defonce ticker (atom nil))
	(defn publish-step-event! []
	(publish! (event ::step)))
	(defn start [owner]
	(fn [e]
	(.preventDefault e)
	(js/clearInterval @ticker)
	(om/set-state! owner :running? true)
	(reset! ticker (.setInterval js/window publish-step-event! 80))))
	(defn stop [owner]
	(fn [e]
	(.preventDefault e)
	(om/set-state! owner :running? false)
	(js/clearInterval @ticker)))
	(defn game [world owner]
	(reify
	om/IInitState
	(init-state [_]
	{:height 40
	:width 70})
	om/IRenderState
	(render-state [_ {:keys [width height running?]}]
	(html
	[:div
	[:div.tools
	[:button {:on-click (fn [e]
	(.preventDefault e)
	(publish-step-event!))} "Step"]
	(if running?
	[:button {:on-click (stop owner)} "Stop"]
	[:button {:on-click (start owner)} "Start"])]
	[:table.game
	(for [h (range height)]
	[:tr
	(for [w (range width)]
	(om/build cell {:x w :y h :alive? (world [w h])}))])]]))))
	(defn get-neighbors [p]
	((apply juxt (for [a [-1 0 1]
	b [-1 0 1]
	:when (not= [0 0] [a b])]
	(fn [[x y]] [(+ x a) (+ y b)]))) p))
	(defn generation [cells]
	(set (for [[loc n] (frequencies (mapcat get-neighbors cells))
	:when (or (= n 3) (and (= n 2) (cells loc)))]
	loc)))
	(def benchmarks (atom []))
	(defn step [_]
	(swap! benchmarks #(cons (. (js/Date.) (getTime)) (take 999 %)))
	(swap! life generation))
	(defn bench []
	(let [latest (take 1000 @benchmarks)]
	(/ (- (first latest) (last latest))
	(dec (count latest)))))
	(defonce _
	(e/subscriptions
	[::step] step))
	(defn main []
	(om/root
	game
	life
	{:target (. js/document (getElementById "app"))}))

view raw gistfile1.clj hosted with ❤ by GitHub

The results ended up a lot faster than my last attempt.

Old: Life

New: OM-Life
(the new one has drag-to-draw capabilities)

Check out the project on github.

HTML Scraper

I haven't posted in a long time, but today I did something that will likely be useful again. It also can definitely be improved upon, so if you find this and know what I might want to do differently, then speak up.

It parses html into a clojure tree which it can then walk, stripping the plain text as it goes. You can define how you want to replace specific tags and entities, or black list tags you want to ignore completely.

	(ns bhenry.example
	(:require [clojure.string :as string]
	[pl.danieljanus.tagsoup :as tags]))
	;;============
	;; HTML Vacuum
	;;============
	(def entities
	{" " " "
	" " " "
	"&lt;" "<"
	"&#60;" "<"
	"&gt;" ">"
	"&#62;" ">"
	"&amp;" "&"
	"&#38;" "&"
	"&quot;" "\""
	"&#34;" "\""
	"&apos;" "'"
	"&#39;" "'"})
	(def ent? (re-pattern "(?i)&[^;\\s]+;"))
	(defn replace-entities [text]
	(let [subs (re-seq ent? text)]
	(loop [subs subs
	text text]
	(if (first subs)
	(let [sub (first subs)]
	(recur (rest subs) (string/replace text sub (get entities sub ""))))
	text))))
	(def line-breaks? (re-pattern "\n[\\s]+\n"))
	(defn replace-excessive-line-breaks [text]
	(string/replace text line-breaks? "\n\n"))
	(defn string [c]
	(string/join " " (flatten c)))
	(defn replace-anchor-tag [{:keys [attr content]}]
	(format "%s (%s) " (string content) (:href attr)))
	(defn replace-breaking-tag [{:keys [content]}]
	(format "\n%s\n" (string content)))
	(defn emphasize-text [{:keys [content]}]
	(string/upper-case (string content)))
	;;=======================================
	;; The function mapped to a special-tag
	;; should take a map with the keys:
	;; :tag :attr :content. where :content is
	;; a list of contents of any nested tags
	;;=======================================
	(def special-tags
	{:a replace-anchor-tag
	:hr (constantly "\n==========\n")
	:br (constantly "\n")
	:div replace-breaking-tag
	:p replace-breaking-tag
	:h1 replace-breaking-tag
	:h2 replace-breaking-tag
	:h3 replace-breaking-tag
	:h4 replace-breaking-tag
	:ul replace-breaking-tag
	:ol replace-breaking-tag
	:b emphasize-text
	:i emphasize-text
	:li (fn [{:keys [content]}] (format "- %s\n" (string content)))})
	;;=====================================
	;; Blacklisted tags are ignored completely
	;;=====================================
	(def blacklist #{:head
	:link
	:style
	:script})
	(def get-content (comp next next))
	(def get-tag first)
	(def get-attr second)
	(def node (juxt get-tag get-attr get-content))
	(defn process-content [tag attr content]
	(let [action (get special-tags tag :content)]
	(if (not (some blacklist [tag]))
	(action
	{:tag tag
	:attr attr
	:content (for [cont content]
	(if (vector? cont)
	(apply process-content (node cont))
	(string/trim cont)))}))))
	(defn clj->text [converted-html]
	(->> converted-html
	node
	(apply process-content)
	flatten
	string/join))
	(defn html->clj [html]
	(tags/parse-string html))
	(defn strip-html [html]
	(-> html
	html->clj
	clj->text
	replace-entities
	replace-excessive-line-breaks))

view raw gistfile1.clj hosted with ❤ by GitHub

Clojure Report Generation

The entire code from this blog post is here. I will chunk it up to explain:
https://gist.github.com/4fcd64dc020a9c749b76

Working with collections in Clojure makes programming such a natural experience. Especially when you want to report on your data. Many different data stores have libraries which make getting information into Clojure trivial. They often use a collection of maps where map keys are the "column" names and the values are the data. The following generate-report function should work on any collection of maps.

	(defn generate-report
	"take query-results and vectors each with the following info:
	[header-display [key(s)] manipulation-function]
	key(s) is a vector of nested keywords. e.g. [:operator :first-name]
	which is passed to a get-in call
	manipulation-function is the function to apply to the item.
	returns a map with :headers and :rows"
	[query-results & report-items]
	(let [headers (vec (map first report-items))
	process (fn [ks f]
	#(f (get-in % ks)))
	columns (map #(process (% 1) (% 2)) report-items)
	rows (for [r query-results]
	((apply juxt columns) r))]
	{:headers headers
	:rows rows}))

view raw generate-report.clj hosted with ❤ by GitHub

Above I am taking a set of query results (i.e. a collection of maps) and any number of report items. A small sample of one of the maps in the collections with which I'm dealing is here.

The first thing to do is grab the headers. These are just the firsts of each report item. Pretty simple. The process function takes the keys from each report-item and applies manipulation-function to the result of (get-in % ks). Process returns a new function that takes a query-result, so I can map it over every report-item to get columns as a seq of functions. Finally to get rows, I use apply juxt to call every function in columns on each query-result to get a vector of each of the results of those calls.

You can tell from the doc string what report-items are supposed to look like, so I will show you two of my reports. The first one uses the generate-report function to put its :headers and :rows into an html table.

	(defn html-report
	[headers rows]
	[:table.report
	[:tr.report-header
	(for [h headers]
	[:td h])]
	(for [row rows]
	[:tr.report-row
	(for [item row]
	item)])])
	(defn scorecard-table
	[cards]
	(let [{:keys [headers rows]}
	(generate-report
	cards
	["Operator" [:operator] employee-td]
	["Evaluator" [:evaluator] employee-td]
	["Client" [:client] client-td]
	["Entry Time" [:timestamp] date-td]
	["Call Time" [:call-date] date-td]
	["Score" [:grade] grade-td])]
	(html-report headers rows)))

view raw html-report.clj hosted with ❤ by GitHub

The code above is all that is required to create this:

Granted the manipulation functions in each report-item are doing most of the display work, the generate-report function makes it easier to focus on what matters out of each map in the collection of query-results.

The reason I wanted to break out the generate-report function is that reports on the same data might not always look the same. The next example looks at a report that needs to export to a spreadsheet. For the HTML table, I wanted to shorten up some of the fields, by displaying "Lastname, First initial." The title tag for the td displays the entire name if the user needs to know. However, once exported, there are no title tags, so the user would have no idea if he was looking at John Smith's or Jessica Smith's score. In xls-report I use a function to display all of the parts of the operators and evaluators which together constitute a unique identifier (see employee-display).

	(defn xls-report
	[headers rows]
	(str
	(join "\t" headers)
	(apply str
	(for [r rows]
	(str "\n"
	(join "\t" r))))))
	(defn employee-display [emp]
	(entity-display emp [:last-name ", " :first-name " (" :user-name ")"]))
	(defn spreadsheet
	[cards]
	(let [{:keys [headers rows]}
	(generate-report
	cards
	["Operator" [:operator] employee-display]
	["Evaluator" [:evaluator] employee-display]
	["Client Number" [:client :account-number] identity]
	["Client Name" [:client :account-name] identity]
	["Entry Time" [:timestamp] html/display-date]
	["Call Time" [:call-date] html/display-date]
	["Scored" [:grade :scored] html/display-number]
	["Possible" [:grade :possible] html/display-number]
	["Percentage" [:grade :percentage] #(* 100.0 %)]
	["ID" [:_id] identity])]
	(xls-report headers rows)))

view raw export-xls.clj hosted with ❤ by GitHub

This report demonstrates the use of the nested maps by getting out the vector of [:client :account-numer] and [:client :account-name]. These are passed to a get-in call which gets me the :client of each score, and then the :account-number and :account-name of that result. Now the *.xls that gets saved can be sorted by either account-number or account-name.

Definitely handy stuff. I'm really starting to love this whole idea that code is data and vice versa.

clojure map-keys

Someone in #clojure was asking about how to case-insensitively check the keys of a map. The best answer anyone present at the time came up with was pre-processing the map by naming, lowering, and keywordifying the keywords. We then found out the asker was looking for keys in nested maps, so I wrote a function for that.

After writing the function I realized I could extract the lowering function and let it take a function to apply to all keys of m and all keys in m's vals.

Here is the map-keys function with the lower-key function extracted. I run it on some goofy data at the end. Try it in a REPL.

	(defn lower-key [x]
	(if (or (string? x) (keyword? x))
	(-> x name .toLowerCase keyword)
	x))
	(defn map-keys
	"applies f to each key of m. also to keys of m's vals and so on."
	[f m]
	(zipmap
	(map (fn [k]
	(f k))
	(keys m))
	(map (fn [v]
	(if (map? v)
	(map-keys f v)
	v))
	(vals m))))
	(map-keys lower-key
	{:aBaB 123
	"CAsasas" {1 "doesn't apply to non-string non-keyword keys"
	:yoGURt "mmMMm"
	:notVALUES "either"}})

view raw map-keys.clj hosted with ❤ by GitHub

Clojure Dates with Java Interop

I really just want to test how an embedded gist looks in blogger. I thought I would do it with a simple function I wrote to test if a date object was between two other date objects in clojure. I found how to do it in Java on stackoverflow, so I took advantage of clojure's java interop, and this is what we get:

	(defn in-range [start end d]
	(not (or (.before d start)
	(.after d end))))

view raw gistfile1.clj hosted with ❤ by GitHub

Optimize your Optimization.

I constantly am looking for a better way to write my functions. I want them to be fast, flexible and readable. However, in the fast department, I also want to write them fast. Tradeoffs are always made in programming. It hit me recently to optimize my optimizations. That is, focus my optimization on the things used the most.

I was working out a function in a web app controller which gets accessed every time there is a write operation on the database. I was trying to figure out how to perform less reads to get the data into the write function. This is when I realized that the write operations would be done, on average, less than once a day. I think I can handle two or three reads per write in that frequency.

Now I can move on, but while I'm working on optimizing things that happen every second, what do you think of this approach? Am I caring too little? Should I be concerned of anything? How would you approach it?

33,000 cases of beer on the wall. . .

SHSH - home - BONHEUR PROVISOIRE