Click to change color scheme

Notes on codes, projects and everything

How to solve all puzzles at 4clojure in a week

I was trying to learn scala and clojure to find one that I may want to use in my postgraduate project. After trying to learn scala for a couple of days, I gave up because I really don’t like the syntax (too OO for my liking). Then I continued with clojure and found myself liking the syntax better.

I briefly tried haskell through this interactive tutorial before starting scala, so I first started with this clojure equivalent web-app. It is a great tutorial, but not quite enough to get myself started to code, so I went on with this Labrepl tutorial guide. The first few sessions was great but it became a bit difficult to follow due to the lack of instruction. Probably I am just being impatient.

A guy nicknamed raek at #clojure irc then suggested a couple of other resources that I may be interested in. One of them is a web-app called 4clojure. Basically it is an app that creates a series of puzzles that let u fill in the blanks so that the statement becomes valid.

After about a week (started last Thursday, and finished on 1st June!), I have solved all posted puzzles (99 in total, and new puzzles are frequently added). The first few puzzles are kinda straight forward, but the later ones took me like hours to half a day to actually came out with a rough idea. Implementing it also took quite some time as I am still not used to programming in functional way.

Some of the puzzles that I kinda like, although the code count is on the high side of the histogram (most people solves the same problem with less code). Besides, I don’t really care about computation complexity because I have not learned it in proper manner (lol, that means I don’t really understand Big-O notation)

Game of Life (Problem 94)

Assuming everyone knows about the game, I guess I would just post the solution straight away.

(fn [i-board]
     (let [
           c-count (count (first i-board))
           r-count (count i-board)
           in-board (fn [i-coor]
                            (let [[i-row i-col] i-coor]
                              (and
                                (>= i-row 0)
                                (< i-row r-count)
                                (>= i-col 0)
                                (< i-col c-count))))
           has-life (fn [i-coor]
                        (= \# (nth (nth i-board (first i-coor)) (last i-coor))))
           board-coor (reduce
                        concat
                        '()
                        (map
                          (fn [my-row]
                              (map #(vector my-row %) (range c-count)))
                          (range r-count)))
           live-list (filter has-life board-coor)
           dead-list (filter #(not (has-life %)) board-coor)
           neighbour (fn [i-coor]
                         (let [[i-row i-col] i-coor]
                           (filter
                             #(let [[my-row my-col] %] (not (and (= my-row i-row) (= my-col i-col))))
                             (reduce
                               concat
                               '()
                               (map
                                 (fn [i-coors]
                                     (filter in-board i-coors))
                                 (map
                                   (fn [my-row]
                                       (map
                                         (fn [my-col]
                                             (vector my-row my-col))
                                         (range (dec i-col) (+ i-col 2))))
                                   (range (dec i-row) (+ i-row 2))))))))
           living-neighbour (fn [i-coor] (filter has-life (neighbour i-coor)))
           lives-on (fn [i-coor]
                        (let [n-count (count (living-neighbour i-coor))]
                          (or (= 2 n-count) (= 3 n-count))))
           reproducible (fn [i-coor]
                            (= 3 (count (living-neighbour i-coor))))
           new-lives (group-by
                       #(first %)
                       (concat
                         (filter lives-on live-list)
                         (filter reproducible dead-list)))
           draw-row (fn plot-lives
                        ([i-row] (plot-lives [] 0 (sort (map last (get new-lives i-row)))))
                        ([result i-pos i-lives]
                         (if (= c-count i-pos)
                           (apply str result)
                           (let [c-life (first i-lives) n-pos (inc i-pos)]
                             (if (= i-pos c-life)
                               (plot-lives (conj result \#) n-pos (rest i-lives))
                               (plot-lives (conj result \space) n-pos i-lives))))))
           ]
       (map draw-row (range r-count))))

OK, I know this is one of the longest solution one can write (and perhaps not the most efficient way).

Roman Numbers (Problem 92)

Completing this also mean I need to be able to read the numbers properly too.

(fn roman
     ([i-literal] (roman 0 i-literal))
     ([i-result i-literal]
      (if (zero? (count i-literal))
        i-result
        (let [
              v-map {\I 1, \V 5, \X 10, \L 50, \C 100, \D 500 \M 1000}
              head (first i-literal)
              tail (rest i-literal)
              t-head (first tail)
              ]
          (if (and (not (nil? t-head)) (> (get v-map t-head) (get v-map head)))
            (roman (+ i-result (- (get v-map t-head) (get v-map head))) (rest tail))
            (roman (+ i-result (get v-map head)) tail))))))

I really hate graphs/trees related puzzles, like this following puzzle.

Graph Connectivity (Problem 91)

Given a set of edges, find if the graph is connected.

(fn [i-set]
     (let [
           nodes (reduce
                   #(conj (conj %1 (first %2)) (last %2))
                   #{}
                   i-set)

           n-count (count nodes)
           n-range (range n-count)
           n-map (apply hash-map (interleave nodes n-range))
           n-index (fn [i-node] (get n-map i-node))

           edges (concat i-set (map #(apply vector (reverse %)) i-set))
           grouped-edges (group-by #(n-index (first %)) edges)

           n-dest (fn [i-node]
                      (map last (get grouped-edges (n-index i-node))))
           walk-graph (fn discover
            ([i-node] (discover #{} (hash-set i-node)))
            ([result discovered]
             (if (zero? (count discovered))
               result
               (let [
                     current (first discovered)
                     n-result (conj result current)
                     new-nodes (filter #(not (contains? n-result %)) (n-dest current))
                     ]
                 (discover n-result (reduce conj (apply hash-set (rest discovered)) new-nodes))))))
           ]
       (= nodes (walk-graph (first (first i-set))))))

This answer sort of gave me idea on how to solve the following 2 very similar questions (although most people don't agree). Note how I start not to care about the code length.

Word ChainWord Ladder (Problem 82)

According to Wikipedia, the game is actually called Word Ladder instead of Word Chain.

(fn [i-words]
     (let [
           n-count (count i-words)
           n-range (range n-count)
           n-map (apply hash-map (interleave i-words n-range))
           n-index (fn [i-word] (get n-map i-word))

           edit-distance (fn diff ([a-word b-word] (diff 0 a-word b-word))
                             ([distance a-word b-word]
                              (let [
                                    a-head (first a-word)
                                    b-head (first b-word)

                                    a-tail (rest a-word)
                                    b-tail (rest b-word)

                                    a-next (first a-tail)
                                    b-next (first b-tail)
                                    ]
                                (if (and (nil? a-head) (nil? b-head))
                                  distance
                                  (if (= a-head b-head)
                                    (diff distance a-tail b-tail)
                                    (if (= a-next b-head)
                                      (diff (inc distance) a-tail b-word)
                                      (if (= a-head b-next)
                                        (diff (inc distance) a-word b-tail)
                                        (diff (inc distance) a-tail b-tail))))))))
           edges (reduce
                   (fn [result i-word]
                       (reduce
                         #(conj %1 (vector i-word %2))
                         result
                         (filter #(= 1 (edit-distance i-word %)) i-words)))
                   #{}
                   i-words)
           grouped-edges (group-by #(n-index (first %)) edges)

           n-dest (fn [i-word]
                      (map last (get grouped-edges (n-index i-word))))

           build-chains (fn chain
                            ([i-word] (chain (dec n-count) (vector (vector i-word))))
                            ([i result]
                             (if (zero? i)
                               result
                               (chain
                                 (dec i)
                                 (reduce
                                   concat
                                   []
                                   (map
                                     (fn [i-chain]
                                         (map
                                           #(conj (apply vector i-chain) %)
                                           (filter #(not (contains? (apply hash-set i-chain) %)) (n-dest (last i-chain)))))
                                     result))))))
           ]
       (reduce
         (fn [result i-word]
             (if (false? result)
               (boolean (some #(= (count %) n-count) (build-chains i-word)))
               result))
         false
         i-words)))

Graph Tour (Problem 89)

(fn [i-edges]
     (let [
           nodes (reduce #(conj (conj %1 (first %2)) (last %2)) #{} i-edges)

           n-count (count nodes)
           n-range (range n-count)
           n-map (apply hash-map (interleave nodes n-range))
           n-index (fn [i-node] (get n-map i-node))

           e-count (count i-edges)

           edges-count (fn [my-edges]
                           (reduce
                             (fn [result i-edge]
                                 (let [[edge occurences] i-edge]
                                   (conj result (hash-map edge (count occurences)))))
                             {}
                             (group-by #(apply vector %) (map sort my-edges))))
           edge-count (fn [i-edge]
                          (let [e-count (edges-count i-edges)]
                            (get e-count i-edge 0)))

           edges (concat i-edges (map #(apply vector (reverse %)) i-edges))
           grouped-edges (group-by #(n-index (first %)) edges)

           n-dest (fn [i-node]
                      (reduce #(conj %1 (last %2)) #{} (get grouped-edges (n-index i-node))))

           build-chains (fn chain
                            ([i-edge] (chain (dec e-count) (vector (vector i-edge))))
                            ([i result]
                             (if (zero? i)
                               result
                               (chain
                                 (dec i)
                                 (reduce
                                   concat
                                   []
                                   (map
                                     (fn [i-chain]
                                         (let [
                                               t-node (last (last i-chain))
                                               n-edges (map #(vector t-node %) (n-dest t-node))
                                               ]
                                           (filter
                                             (fn [my-chain]
                                                 (reduce
                                                   (fn [result i-edge]
                                                       (let [[edge o-count] i-edge]
                                                         (and result (>= (edge-count edge) o-count))))
                                                   true
                                                   (edges-count my-chain)))
                                             (map #(conj i-chain %) n-edges))))
                                     result))))))
           ]
       (reduce
         (fn [result i-edge]
             (if (false? result)
               (boolean (some #(= (count %) e-count) (build-chains i-edge)))
               result))
         false
         i-edges)))

I guess that's all for now lol. Oh, my supervisor's reaction (his primary language is probably JAVA) to scala and clojure was - try not to learn strange (weird) language. Then he mentioned about bad employment opportunity or something I don't really care to remember (I am actually trying very hard to avoid learning JAVA because I don't like it). So I guess this is it.

There may be some other interesting questions that I may have missed. Hopefully I will have the time to revisit on this and post more solutions.

leave your comment

name is required

email is required

have a blog?

This blog uses scripts to assist and automate comment moderation, and the author of this blog post does not hold responsibility in the content of posted comments. Please note that activities such as flaming, ungrounded accusations as well as spamming will not be entertained.

Pings

Comments

@bob good one 🙂

author
Jeffrey04
date
2011-07-18
time
02:04:50

My favorite solution is for the roman numeral conversion:
(fn [a]
(last (reduce (fn [[max sum] num]
(if (< num max)
[max (- sum num)]
[num (+ sum num)])) [0 0]
(map {\X 10 \I 1 \V 5 \C 100 \L 50 \D 500 \M 1000} (reverse a))
)))

author
Bob
date
2011-07-16
time
12:25:42

@dbryne yeah, really like 4clojure (and clojure), but unfortunately probably not going to use it for my postgrad project :/

author
Jeffrey04
date
2011-06-3
time
11:12:14

Glad you are enjoying 4clojure! Didn’t realize “word ladders” existed. Thanks for the info. I’ll change the title of the problem and link to that Wikipedia page.

author
dbyrne
date
2011-06-3
time
06:56:05