Next round of 4clojure.com solutions

After the seventh round, five more 4clojure.com solutions:

;;; Problem 60 - Sequence Reduction
(deftest test-problem-60
  (let [v1 (fn fred
             ([f [p1 & ps]] (fred f p1 ps))
             ([f p1 [p2 & ps]]
              (cons p1
                    (when p2
                      (lazy-seq (fred f (f p1 p2) ps))))))
        __ v1]
    (is (= (take 5 (__ + (range))) [0 1 3 6 10]))
    (is (= (__ conj [1] [2 3 4]) [[1] [1 2] [1 2 3] [1 2 3 4]]))
    (is (= (last (__ * 2 [3 4 5])) (reduce * 2 [3 4 5]) 120))))

;;; Problem 59 - Juxtaposition
(deftest test-problem-59
  (let [v1 (fn [& fns]
             (fn [& xs]
               (map #(apply % xs) fns)))
        __ v1]
    (is (= [21 6 1] ((__ + max min) 2 3 5 1 6 4)))
    (is (= ["HELLO" 5] ((__ #(.toUpperCase %) count) "hello")))
    (is (= [2 6 4] ((__ :a :c :b) {:a 2, :b 4, :c 6, :d 8 :e 10})))))

;;; Problem 58 - Function composition
(deftest test-problem-58
  (let [v1 (fn [& fns]
             (fn [& xs]
               (let [[f & rfns] (reverse fns)]
                 (reduce #(%2 %)
                         (apply f xs)
                         rfns))))
        v2 (fn [& fns]
             (reduce (fn [f g]
                       (fn [& xs]
                         (f (apply g xs))))
                     fns))
        __ v2]
    (is (= [3 2 1] ((__ rest reverse) [1 2 3 4])))
    (is (= 5 ((__ (partial + 3) second) [1 2 3 4])))
    (is (= true ((__ zero? #(mod % 8) +) 3 5 7 9)))
    (is (= "HELLO" ((__ #(.toUpperCase %) #(apply str %) take) 5 "hello world")))))

;;; Problem 57 - Simple Recursion
(deftest test-problem-57
  (let [v1 [5 4 3 2 1] 
        __ v1]
    (is (= __ ((fn foo [x] (when (> x 0) (conj (foo (dec x)) x))) 5)))))

;;; Problem 56 - Find Distinct Items
(deftest test-problem-56
  (let [v1 (fn [xs]
             (loop [[e & c] xs a [] d #{}]
               (if e
                 (recur c
                        (if (d e) a (conj a e))
                        (conj d e))
                 a)))
        __ v1]
    (is (= (__ [1 2 1 3 1 2 4]) [1 2 3 4]))
    (is (= (__ [:a :a :b :b :c :c]) [:a :b :c]))
    (is (= (__ '([2 4] [1 2] [1 3] [1 3])) '([2 4] [1 2] [1 3])))
    (is (= (__ (range 50)) (range 50)))))

(run-tests)

Next round of 4clojure.com solutions

After the sixth round, five more 4clojure.com solutions:

;;; Problem 55 - Count Occurrences
(deftest test-problem-55
  (let [v1 (fn [xs]
             (reduce (fn [a v] (assoc a v (inc (get a v 0)))) {} (vec xs)))
        __ v1]
    (is (= (__ [1 1 2 3 2 1 1]) {1 4, 2 2, 3 1}))
    (is (= (__ [:b :a :b :a :b]) {:a 2, :b 3}))
    (is (= (__ '([1 2] [1 3] [1 3])) {[1 2] 1, [1 3] 2}))))

 ;;; Problem 54 - Partition a Sequence
(deftest test-problem-54
  (let [v1 (fn [n xs]
             (loop [a [] r xs]
               (if (< (count r) n)
                 a
                 (recur (conj a (take n r)) (drop n r)))))
        __ v1]
    (is (= (__ 3 (range 9)) '((0 1 2) (3 4 5) (6 7 8))))
    (is (= (__ 2 (range 8)) '((0 1) (2 3) (4 5) (6 7))))
    (is (= (__ 3 (range 8)) '((0 1 2) (3 4 5))))))

 ;;; Problem 53 - Longest Increasing Sub-Seq
(deftest test-problem-53
  (let [subseqs #(take-while not-empty (iterate (partial rest) %))
        filter2 (fn [f xs]
                  (loop [ll (first xs) l [ll] [fr :as r] (rest xs)]
                    (if (or (nil? ll)
                            (nil? fr)
                            (not (f ll fr)))
                      l
              (recur fr (conj l fr) (rest r)))))
        do-run #(map (partial filter2 <) %)
        do-long (partial filter #(> (count %) 1))
        do-sort (partial sort-by #(-' (count %)))
        v1 #(-> % subseqs do-run do-long (conj []) do-sort first)
        __ v1]
    (is (= (__ [1 0 1 2 3 0 4 5]) [0 1 2 3]))
    (is (= (__ [5 6 1 3 2 7]) [5 6]))
    (is (= (__ [2 3 3 4 5]) [3 4 5]))
    (is (= (__ [7 6 5 4]) []))))

 ;;; Problem 52 - Intro to Destructuring
(deftest test-problem-52
  (is (= [2 4] (let [[a b c d e f g] (range)] ))))

 ;;; Problem 51 - Advanced Destructuring
(deftest test-problem-51
  (let [v1 [1 2 3 4 5]
        __ v1]
    (is (= [1 2 [3 4 5] [1 2 3 4 5]] (let [[a b & c :as d] __] [a b c d])))))

(run-tests)

Solving the Impossible puzzle in Clojure

I found this puzzle recently. I should say I rediscovered it, as I knew it from before. I wanted to solve it in Clojure – here’s one possible solution, with comments on the thought process involved in solving it (in the comments before the actual code).

(ns com.icyrock.clojure.prb.xynum)

; http://puzzling.stackexchange.com/questions/251/i-dont-know-the-two-numbers-but-now-i-do
; http://en.wikipedia.org/wiki/Impossible_Puzzle
; http://people.sc.fsu.edu/~jburkardt/fun/puzzles/impossible_solution.html

; Two numbers, 1 < x < y, x + y < n (n = 100 in the linked question)
; p = x * y
; s = x + y

; p: I cannot determine the two numbers.
;   => p not unique: p = x1 * y1 = x2 * y2 = ...
;      Let's call this an ambiguous product

; s: I knew that.
;   => s can be created from one or multiple pairs: s = x1 + y1 = x2 + y2 = ...
;      Those pairs form these products:
;        p1 = x1 * y1
;        p2 = x2 * y2
;        ...
;      Each of these products can be created from multiple pairs (i.e. is ambiguous):
;        p1 = x11 * y11 = x12 * y12 = ...
;        p2 = x21 * y21 = x12 * y22 = ...
;        ...
;      Let's call this product-ambiguous sum

; p: Now I can determine them.
;   => p = x1 * y1 = x2 * y2 = ...
;      Only one of (xk, yk) forms a product-ambiguous sum
;      Let's call this unambiguous product

; s: So can I.
;   => s = x1 + y1 = x2 + y2 = ...
;      Only one of all the possible products:
;        p1 = x1 * y1
;        p2 = x2 * y2
;        ...
;      is an unambiguous product
;      Let's call this unambiguous sum

(defn xynum [n]
  (let [pairs (for [y (range 2 n) x (range 2 y) :when (< (+ x y) n)] [x y])
        sum-map (group-by (partial apply +) pairs)
        prod-map (group-by (partial apply *) pairs)
        ; Pair forms a product. That product can be formed from at least some other pair.
        is-ambiguous-product (fn [pair] 
                               (> (count (prod-map (apply * pair))) 1))
        ; Pair forms a sum. That sum can be formed from other pairs. Those pairs form some products. All those products are ambiguous.
        is-product-ambiguous-sum (fn [pair] 
                                   (every? true? (map is-ambiguous-product (sum-map (apply + pair)))))
        ; Pair forms a product. That product can be formed from other pairs. Only one of those pairs forms a product-ambiguous sum.
        is-unambiguous-product (fn [pair] 
                                 (= 1 (count (filter true? (map is-product-ambiguous-sum (prod-map (apply * pair)))))))
        ; Pair forms a sum. That sum can be formed from other pairs. Only one of those pairs forms an unambiguous product.
        is-unambiguous-sum (fn [pair] 
                             (= 1 (count (filter true? (map is-unambiguous-product (sum-map (apply + pair)))))))
        is-pair-a-candidate (fn [pair] (and
                                         (is-ambiguous-product pair)
                                         (is-product-ambiguous-sum pair)
                                         (is-unambiguous-product pair)
                                         (is-unambiguous-sum pair)))
        candidates (filter is-pair-a-candidate pairs)]
    (println "Pair count:" (count pairs))
    (println "Sum map count:" (count sum-map))
    (println "Product map count:" (count prod-map))
    (println "Candidates count:" (count candidates))
    (println "Candidates: " candidates)))

(defn -main []
  (xynum 100))

(-main)

Note also the Wikipedia entry, which contains solutions in other languages. I particularly liked the Scala version, notably for its conciseness and readability.


Next round of 4clojure.com solutions

After the fifth round, five more 4clojure.com solutions:

;;; Problem 50 - Split by Type
(deftest test-problem-50
  (let [v1 (fn [xs] (for [t (map type xs)] (filter #(= (type %) t) xs))) 
        v2 (fn [xs] (vals (group-by type xs)))
        __ v2]
    (is (= (set (__ [1 :a 2 :b 3 :c])) #{[1 2 3] [:a :b :c]}))
    (is (= (set (__ [:a "foo"  "bar" :b])) #{[:a :b] ["foo" "bar"]}))
    (is (= (set (__ [[1 2] :a [3 4] 5 6 :b])) #{[[1 2] [3 4]] [:a :b] [5 6]}))))
 
;;; Problem 49 - Split a sequence
(deftest test-problem-49
  (let [v1 (fn [n xs] [(take n xs) (drop n xs)]) 
        __ v1]
    (is (= (__ 3 [1 2 3 4 5 6]) [[1 2 3] [4 5 6]]))
    (is (= (__ 1 [:a :b :c :d]) [[:a] [:b :c :d]]))
    (is (= (__ 2 [[1 2] [3 4] [5 6]]) [[[1 2] [3 4]] [[5 6]]]))))
 
;;; Problem 48 - Intro to some
(deftest test-problem-48
  (let [v1 6 
        __ v1]
    (is (= __ (some #{2 7 6} [5 6 7 8])))
    (is (= __ (some #(when (even? %) %) [5 6 7 8])))))

;;; Problem 47 - Contain Yourself
(deftest test-problem-47
  (let [v1 4 
        __ v1]
    (is (contains? #{4 5 6} __))
    (is (contains? [1 1 1 1 1] __))
    (is (contains? {4 :a 2 :b} __))
    ; No longer works in CLojure 1.5+: http://clojuredocs.org/clojure_core/clojure.core/contains_q
    ; (is (not (contains? '(1 2 4) __))) 
    ))

;;; Problem 46 - Flipping out
(deftest test-problem-46
  (let [v1 (fn [f] #(f %2 %)) 
        __ v1]
    (is (= 3 ((__ nth) 2 [1 2 3 4 5])))
    (is (= true ((__ >) 7 8)))
    (is (= 4 ((__ quot) 2 8)))
    (is (= [1 2 3] ((__ take) [1 2 3 4 5] 3)))))

(run-tests)

Next round of 4clojure.com solutions

After the fourth round, five more 4clojure.com solutions:

;;; Problem 45 - Intro to Iterate
(deftest test-problem-45
  (let [v1 [1 4 7 10 13] 
        __ v1]
    (is (= __ (take 5 (iterate #(+ 3 %) 1))))))
 
;;; Problem 44 - Rotate Sequence
(deftest test-problem-44
  (let [v1 (fn [n xs] (let [k (mod n (count xs))] (concat (drop k xs) (take k xs))))
        __ v1]
    (is (= (__ 2 [1 2 3 4 5]) '(3 4 5 1 2)))
    (is (= (__ -2 [1 2 3 4 5]) '(4 5 1 2 3)))
    (is (= (__ 6 [1 2 3 4 5]) '(2 3 4 5 1)))
    (is (= (__ 1 '(:a :b :c)) '(:b :c :a)))
    (is (= (__ -4 '(:a :b :c)) '(:c :a :b)))))
 
;;; Problem 43 - Reverse Interleave
(deftest test-problem-43
  (let [v1 (fn [xs n] (partition (/ (count xs) n) (apply interleave (partition n xs)))) 
        __ v1]
    (is (= (__ [1 2 3 4 5 6] 2) '((1 3 5) (2 4 6))))
    (is (= (__ (range 9) 3) '((0 3 6) (1 4 7) (2 5 8))))
    (is (= (__ (range 10) 5) '((0 5) (1 6) (2 7) (3 8) (4 9))))))
 
;;; Problem 42 - Factorial Fun 
(deftest test-problem-42
  (let [v1 #(apply * (range 1 (inc %)))
        __ v1]
    (is (= (__ 1) 1))
    (is (= (__ 3) 6))
    (is (= (__ 5) 120))
    (is (= (__ 8) 40320))))
 
;;; Problem 41 - Drop Every Nth Item
(deftest test-problem-41
  (let [v1 (fn [xs n] (apply concat (map #(take (dec n) %) (partition-all n xs))))
        __ v1] 
    (is (= (__ [1 2 3 4 5 6 7 8] 3) [1 2 4 5 7 8]))
    (is (= (__ [:a :b :c :d :e :f] 2) [:a :c :e]))
    (is (= (__ [1 2 3 4 5 6] 4) [1 2 3 5 6]))))
 
(run-tests)

Lazy seq for Pascal’s triangle in Clojure

Here’s a lazy-seq for Pascal’s triangle:

(ns com.icyrock.clojure.prb.lazy_seq
  (:use clojure.test))

(defn next-pascal-row [prev]
  (concat [1] (map #(apply + %) (map list prev (rest prev))) [1]))

(deftest next-pascal-row-test
  (is (= [1 1] (next-pascal-row [1])))
  (is (= [1 2 1] (next-pascal-row [1 1])))
  (is (= [1 3 3 1] (next-pascal-row [1 2 1])))
  (is (= [1 4 6 4 1] (next-pascal-row [1 3 3 1]))))

(defn lazy-pascal-triangle 
  ([] (lazy-pascal-triangle [1]))
  ([prev] (cons prev 
                (lazy-seq (lazy-pascal-triangle (next-pascal-row prev))))))

(deftest lazy-pascal-triangle-test
  (is (= [[1]
          [1 1]
          [1 2 1]
          [1 3 3 1]
          [1 4 6 4 1]
          [1 5 10 10 5 1]
          [1 6 15 20 15 6 1]]
         (take 7 (lazy-pascal-triangle)))))

(run-tests)

Next round of 4clojure.com solutions

After the third round, five more 4clojure.com solutions:

(ns com.icyrock.clojure.a4clojure_com.core
  (:use clojure.test))

;;; Problem 40 - Interpose a Seq
(deftest test-problem-40
  (let [v1 #(rest (interleave (repeat %) %2))
        __ v1]
    (is (= (__ 0 [1 2 3]) [1 0 2 0 3]))
    (is (= (apply str (__ ", " ["one" "two" "three"])) "one, two, three"))
    (is (= (__ :z [:a :b :c :d]) [:a :z :b :z :c :z :d]))))

;;; Problem 39 - Interleave Two Seqs
(deftest test-problem-39
  (let [v1 #(mapcat list % %2)
        __ v1]
    (is (= (__ [1 2 3] [:a :b :c]) '(1 :a 2 :b 3 :c)))
    (is (= (__ [1 2] [3 4 5 6]) '(1 3 2 4)))
    (is (= (__ [1 2 3 4] [5]) [1 5]))
    (is (= (__ [30 20] [25 15]) [30 25 20 15]))))

;;; Problem 38 - Maximum value
(deftest test-problem-38
  (let [v1 #(first (sort > %&))
        __ v1]
    (is (= (__ 1 8 3 4) 8))
    (is (= (__ 30 20) 30))
    (is (= (__ 45 67 11) 67))))

;;; Problem 37 - Regular Expressions
(deftest test-problem-37
  (let [v1 "ABC"
        __ v1]
    (is (= __ (apply str (re-seq #"[A-Z]+" "bA1B3Ce "))))))

;;; Problem 36 - Let it Be
(deftest test-problem-36
  (do
    (is (= 10 (let [x 7 y 3 z 1] (+ x y))))
    (is (= 4 (let [x 7 y 3 z 1] (+ y z))))
    (is (= 1 (let [x 7 y 3 z 1] z)))))

(run-tests)

Next round of 4clojure.com solutions

After the second round, five more 4clojure.com solutions:

(ns com.icyrock.clojure.a4clojure_com.core
  (:use clojure.test))

;;; Problem 35 - Local bindings
(deftest test-problem-35
  (let [v1 7
        __ v1]
    (is (= __ (let [x 5] (+ 2 x))))
    (is (= __ (let [x 3, y 10] (- y x))))
    (is (= __ (let [x 21] (let [y 3] (/ x y)))))))

;;; Problem 34 - Implement range
(deftest test-problem-34
  (let [v1 #(take (- %2 %) (iterate inc %))
        __ v1]
    (is (= (__ 1 4) '(1 2 3)))
    (is (= (__ -2 2) '(-2 -1 0 1)))
    (is (= (__ 5 8) '(5 6 7)))))

;;; Problem 33 - Replicate a Sequence
(deftest test-problem-33
  (let [v1 #(mapcat (fn [e] (repeat %2 e)) %)
        v2 #(apply interleave (repeat %2 %))
        __ v2]
    (is (= (__ [1 2 3] 2) '(1 1 2 2 3 3)))
    (is (= (__ [:a :b] 4) '(:a :a :a :a :b :b :b :b)))
    (is (= (__ [4 5 6] 1) '(4 5 6)))
    (is (= (__ [[1 2] [3 4]] 2) '([1 2] [1 2] [3 4] [3 4])))
    (is (= (__ [44 33] 2) [44 44 33 33]))))

;;; Problem 32 - Duplicate a Sequence
(deftest test-problem-32
  (let [v1 #(mapcat (fn [x] [x x]) %)
        v2 #(mapcat list % %)
        v3 #(interleave % %)
        __ v3]
    (is (= (__ [1 2 3]) '(1 1 2 2 3 3)))
    (is (= (__ [:a :a :b :b]) '(:a :a :a :a :b :b :b :b)))
    (is (= (__ [[1 2] [3 4]]) '([1 2] [1 2] [3 4] [3 4])))
    (is (= (__ [[1 2] [3 4]]) '([1 2] [1 2] [3 4] [3 4])))))

;;; Problem 31 - Pack a Sequence
(deftest test-problem-31
  (let [v1 #(partition-by identity %)
        __ v1]
    (is (= (__ [1 1 2 1 1 1 3 3]) '((1 1) (2) (1 1 1) (3 3))))
    (is (= (__ [:a :a :b :b :c]) '((:a :a) (:b :b) (:c))))
    (is (= (__ [[1 2] [1 2] [3 4]]) '(([1 2] [1 2]) ([3 4]))))))

(run-tests)

Split string with regex and keep delimiters

The other day I needed to split a string with regex delimiter, but also keep these delimiters. Java’s default String.split does not do that – it throws away the delimiters. Below is the code that can be used to achieve this.

Java

import java.util.List;
import java.util.ArrayList;
import java.util.Arrays;
import java.util.regex.Pattern;
import java.util.regex.Matcher;

public class SplitWithDelimiters {
  public static void main(String[] args) {
    new SplitWithDelimiters().run();
  }

  private void run() {
    String regex = "\\s*[+\\-*/]\\s*";

    assert !new String[] { }.equals(
      splitWithDelimiters("", regex));
    assert !new String[] { "1" }.equals(
      splitWithDelimiters("1", regex));
    assert !new String[] { "1", "+" }.equals(
      splitWithDelimiters("1+", regex));
    assert !new String[] { "-", "1" }.equals(
      splitWithDelimiters("-1", regex));
    assert !new String[] { "- ", "- ", "-", "1" }.equals(
      splitWithDelimiters("- - -1", regex));
    assert !new String[] { "1", " + ", "2" }.equals(
      splitWithDelimiters("1 + 2", regex));
    assert !new String[] { "-", "1", " + ", "2", " - ", "3", "/", "4" }.equals(
      splitWithDelimiters("-1 + 2 - 3/4", regex));
    
    System.out.println("Done.");
  }

  private String[] splitWithDelimiters(String str, String regex) {
    List<String> parts = new ArrayList<String>();

    Pattern p = Pattern.compile(regex);
    Matcher m = p.matcher(str);

    int lastEnd = 0;
    while(m.find()) {
      int start = m.start();
      if(lastEnd != start) {
        String nonDelim = str.substring(lastEnd, start);
        parts.add(nonDelim);
      }
      String delim = m.group();
      parts.add(delim);

      int end = m.end();
      lastEnd = end;
    }

    if(lastEnd != str.length()) {
      String nonDelim = str.substring(lastEnd);
      parts.add(nonDelim);
    }

    String[] res =  parts.toArray(new String[]{});
    System.out.println("result: " + Arrays.toString(res));

    return res;
  }
}

Clojure

Here’s a test file for the Clojure version:

(deftest split-keep-delim-test
  (is (= []
         (split-keep-delim "" #"\d+")))
  (is (= ["abc"]
         (split-keep-delim "abc" #"\d+")))
  (is (= ["-" "1" " + " "2" " - " "3" "/" "4"]
         (split-keep-delim "-1 + 2 - 3/4" #"\s*[+\-*/]\s*")))
  (is (= ["a" "b" "12" "b" "a"]
         (split-keep-delim "ab12ba" #"[ab]"))))

and the implementation:

(defn split-keep-delim 
  "Splits str with re-delim. Returns list of parts, including delimiters. Lazy.

   > (split-keep-delim \"-1 + 2 - 3/4\" #\"\\s*[+\\-*/]\\s*\")
   [\"-\" \"1\" \" + \" \"2\" \" - \" \"3\" \"/\" \"4\"]
   > (split-keep-delim \"ab12ba\" #\"[ab]\")
   [\"a\" \"b\" \"12\" \"b\" \"a\"]"
  [str re-delim]
  (let [m (.matcher re-delim str)]
    ((fn step [last-end]
       (if (.find m)
         (let [start (.start m)
               end (.end m)
               delim (.group m)
               new-head (if (not= last-end start)
                          [(.substring str last-end start) delim]
                          [delim])]
           (concat new-head (lazy-seq (step end))))
         (if (not= last-end (.length str))
           [(.substring str last-end)]
           []))) 0)))

This version is lazy, though I did not notice any speedup as you can see from the timings below. Timings are rather good for what I needed:

> (let [s (apply str (take 100 (cycle "-1 + 2 - 3/4"))) pat #"\s*[+\-*/]\s*"] (time (dotimes [_ 1000] (take 1 (split-keep-delim s pat)))))
"Elapsed time: 26.013445 msecs"
nil
> (let [s (apply str (take 100 (cycle "-1 + 2 - 3/4"))) pat #"\s*[+\-*/]\s*"] (time (dotimes [_ 1000] (take 3 (split-keep-delim s pat)))))
"Elapsed time: 28.754948 msecs"
nil
> (let [s (apply str (take 100 (cycle "-1 + 2 - 3/4"))) pat #"\s*[+\-*/]\s*"] (time (dotimes [_ 1000] (take 300 (split-keep-delim s pat)))))
"Elapsed time: 28.388654 msecs"
nil

Maze display app for Always Turn Left

Last time, I presented a solution for Always Turn Left, a Google Code Jam problem. Given that their large dataset was quite big (up to 10k moves), I thought: “It would be interesting to see what mazes those moves produce”. So I set to write (in Clojure, of course) a maze-display app (using Seesaw, of course). Here’s what came out of that.

(ns com.icyrock.clojure.codejam.maze-display
  (:use clojure.java.io
        flatland.ordered.map
        seesaw.border
        seesaw.chooser
        seesaw.color
        seesaw.core
        seesaw.graphics
        seesaw.mig)
  (:require [seesaw.bind :as ssb]))

First, declare a lot of things I’m to use later. Most Seesaw and one thing from here, which is a Clojure implementation of ordered sets / maps which I wanted to try out.

(def state
  {:frame (atom nil)
   :file (atom nil)
   :cases (atom nil)
   :curr-case (atom nil)
   :maze (atom nil)})

Main state – contains:

  • Main frame
  • Currently selected case-file
  • Loaded cases themselves
  • Currently selected case
  • Maze bound to the currently selected case
(def room-width 16)
(def room-height 16)

Default room size when drawn, in pixels.

(def default-style
  (style
   :foreground "#000000"
   :stroke (stroke :width 3 :cap :round)))

Default style to use when drawing walls. It’s a black, 3-pixel wide line, with rounded edges.

(defn draw-wall [g w h wall]
  (case wall
    :n (draw g (line 0 0 w 0) default-style)
    :s (draw g (line 0 h w h) default-style)
    :w (draw g (line 0 0 0 h) default-style)
    :e (draw g (line w 0 w h) default-style)))

This draws a wall. Given that translation is used below, the north-west corner of the room is always at (0, 0), so the above is easy to understand given the case keys (:n for north, :s for south, :w for west and :e for east).

(defn draw-room [g w h walls-desc]
  (let [walls (case walls-desc
                \1 #{   :s :w :e}
                \2 #{:n    :w :e}
                \3 #{      :w :e}
                \4 #{:n :s    :e}
                \5 #{   :s    :e}
                \6 #{:n       :e}
                \7 #{         :e}
                \8 #{:n :s :w   }
                \9 #{   :s :w   }
                \a #{:n    :w   }
                \b #{      :w   }
                \c #{:n :s      }
                \d #{   :s      }
                \e #{:n         }
                \f #{           }
                )]
    (doseq [wall walls]
      (push g
            (draw-wall g w h wall)))))

The room is a set of cases to decipher the letter as set of walls for that room, as given in the problem description and then draw each of these walls.

(defn paint-maze 
  (try
    (let [w room-width
          h room-height
          maze @(state :maze)]
      (when maze
        (anti-alias g)
        (translate g w h)
        (doseq [row maze]
          (push g
                (doseq [room row]
                  (draw-room g w h room)
                  (translate g w 0)))
          (translate g 0 h))))
    (catch Exception e
      (invoke-later (alert e))
      (println e))))

Main paint function:

  • Check if maze is valid (i.e. user has selected a case)
  • Turn on anit-aliasing
  • Go through the rows of the maze
  • Translate to the position of the current room
  • Draw it
(defn content-panel []
  (mig-panel
   :constraints ["fill" "[|grow]"]
   :items [[(button :id :load
                    :text "Load file...") ""]
           [(text :id :file-name) "growx, wrap"]
           [(scrollable (listbox :id :cases)
                        :border (line-border)) "grow"]
           [(let [s (scrollable (canvas :id :maze-pict
                                        :background "#ffffff"
                                        :paint paint-maze)
                                :border (line-border))]
              (-> s (.getHorizontalScrollBar) (.setUnitIncrement (* 3 room-width)))
              (-> s (.getVerticalScrollBar) (.setUnitIncrement (* 3 room-height)))
              s) "grow, push"]]))

Main window contents:

  • “Load” button
  • Current file name
  • List box for cases
  • Canvas for the maze

Uses MigLayout, of course.

(defn split-cases [acc line]
  (let [case (re-find #"^Case #\d+:$" line)]
    (if case
      ;; Found case start line
      (assoc acc
        :curr-case case
        :cases (assoc (acc :cases) case []))
      ;; Continuation of the current case (maze definition)
      (let [cases (acc :cases)
            curr-case (acc :curr-case)
            curr-maze (cases curr-case)
            new-maze (conj curr-maze line)
            new-cases (assoc cases curr-case new-maze)]
        (assoc acc
          :cases new-cases)))))

When loading, split the cases one by one, taking into account maze description has two kinds of lines:

  • Case start
  • Maze lines for the current case
(defn load-cases [file]
  (with-open [r (reader file)]
    (let [lines (reduce conj [] (line-seq r))
          {:keys [cases]} (reduce split-cases {:cases (ordered-map)} lines)]
      (reset! (state :cases) cases))))

Case loader function:

  • Use reader to read from the file
  • Get the lines
  • Reduce using previous split-cases function
(defn load [e]
  (let [frame (to-frame e)]
    (choose-file frame
                 :type :open
                 :success-fn (fn [fc file] (reset! (state :file) file)))))

Just shows the standard Java file chooser to pick the file.

(defn set-listeners [frame]
  (listen (select frame [:#load])
            :action load))

(defn set-bindings [frame]
  ;; File binding
  (ssb/bind
   (state :file)
   (ssb/tee
    (ssb/b-do* load-cases)
    (ssb/bind
     (ssb/transform #(.getPath %))
     (select frame [:#file-name]))))
  ;; Cases binding
  (ssb/bind
   (state :cases)
   (ssb/transform #(keys %))
   (ssb/tee
    (ssb/property (select frame [:#cases]) :model)
    (ssb/b-do* (fn [v] (selection! (select frame [:#cases]) (first v))))))
  ;; Case selection binding
  (ssb/bind
   (ssb/selection (select frame [:#cases]))
   (ssb/b-do* #(reset! (state :curr-case) %)))
  ;; Selected case binding
  (ssb/bind
   (state :curr-case)
   (ssb/transform #(@(state :cases) %))
   (ssb/b-do* #(reset! (state :maze) %)))
  ;; Maze binding
  (ssb/bind
   (state :maze)
   (ssb/b-do* (fn [maze] (let [canvas (select frame [:#maze-pict])
                               cw (* room-width (+ 2 (count (first maze))))
                               ch (* room-height (+ 2 (count maze)))]
                           (config! canvas :preferred-size [cw :by ch])
                           (.revalidate canvas)
                           (repaint! canvas))))))

These two set up the listeners (only one in this case – button click) and bindings which nicely describe the state machine for this simple app:

  • When file is selected, load the cases and display the file name
  • When cases were loaded, populate the list box with the case map description
  • When a case is selected, update the current case
  • When the current case changes, update the maze
  • When the maze is updated, draw it
(defn maze-display []
  (native!)
  (let [f (frame :title *ns*
                 :width 1200 :height 700
                 :on-close :dispose
                 :visible? true
                 :content (content-panel))]
    (.setLocation f (java.awt.Point. 100 100))
    (reset! (state :frame) f)
    (set-listeners f)
    (set-bindings f)))

Main function:

  • Make the frame
  • Set its location
  • Set the listeners and bindings

The final result looks like this:

maze-display-app