Finally done with all the 100 problems listed on 4clojure.com so far :-). When new problems appears there, I will probably do them when I have some time to kill, but I will not post my solutions here any more. If I found interesting programming exercises, I may submit to 4clojure as well.
This has been a great learning experience. I become very familiar with the core Clojure functions, especially the great sequence library. The functional way of writing code is so much fun, I wish I have been exposed to it earlier. Now I am hooked and would like to learn more. It's a pity there ain't many functional algorithm books around. The one I found is Chris Okasaki's "Purely Functional Data Structures", but the exposition language is Standard ML. Let's hope it can be easily translated into Clojure...
; 77: Write a function which finds all the anagrams in a vector of words. A
; word x is an anagram of word y if all the letters in x can be rearranged in
; a different order to form y. Your function should return a set of sets, where
; each sub-set is a group of words which are anagrams of each other. Each
; sub-set should have at least two words. Words without any anagrams should not
; be included in the result.
; (= (__ ["meat" "mat" "team" "mate" "eat"]) #{#{"meat" "team" "mate"}})
; (= (__ ["veer" "lake" "item" "kale" "mite" "ever"])
; #{#{"veer" "ever"} #{"lake" "kale"} #{"mite" "item"}})
(fn [coll]
(->> (group-by frequencies coll)
(vals)
(filter #(> (count %) 1))
(map set )
set))
; anagrams have the same distribution of characters
; 79: Write a function which calculates the sum of the minimal path through a
; triangle. The triangle is represented as a vector of vectors. The path should
; start at the top of the triangle and move to an adjacent number on the next
; row until the bottom of the triangle is reached.
; (= (__ [ [1]
;[2 4]
;[5 1 4]
;[2 3 4 5]])
;(+ 1 2 1 3)
;7)
(fn [triangle]
(apply min ((fn path-sum [p]
(concat
(if (= (count triangle) (count p))
[(reduce + (map-indexed #(get-in triangle [%1 %2]) p))]
(let [x (last p)]
(concat
(path-sum (conj p x))
(path-sum (conj p (inc x))))))))
[0])))
; We enumerate all possible paths. The next step in a path can only go to the
; same or the plus one row index as the previous step, so the paths form a
; binary tree. We walk the tree recursively, building a row index vector p for
; each path.
; 81: Reimplement set intersection
#(set (filter %1 %2))
; sets are functions too, so this works
; 82: A word chain consists of a set of words ordered so that each word differs
; by only one letter from the words directly before and after it. The one
; letter difference can be either an insertion, a deletion, or a substitution.
; Here is an example word chain:
; cat -> cot -> coat -> oat -> hat -> hot -> hog -> dog
; Write a function which takes a sequence of words, and returns true if they
; can be arranged into one continous word chain, and false if they cannot.
; (= false (__ #{"cot" "hot" "bat" "fat"}))
; (= true (__ #{"spout" "do" "pot" "pout" "spot" "dot"}))
(fn [word-set]
(letfn [(edit-dist [a b]
(cond
(not (or a b)) 0
(not b) (count a)
(not a) (count b)
:else (let [ra (next a) rb (next b)]
(if (= (first a) (first b))
(edit-dist ra rb)
(+ 1 (min
(edit-dist ra rb)
(edit-dist ra b)
(edit-dist a rb)))))))
(find-paths [graph start seen]
(if (seen start)
seen
(for [n (graph start)]
(find-paths graph n (conj seen start)))))]
(let [graph (into {}
(for [s word-set]
[s (filter #(= 1 (edit-dist s %)) word-set)]))]
(if (some (fn [w]
(some #(= word-set %)
(flatten (find-paths graph w #{}))))
word-set)
true false))))
; This problem consists of two sub-problems: A. Determine the edit distance
; between two strings. For brevity, we just used the standard recursive
; algorithm instead of dynamic programming. B. For the graph of strings
; connected by edges of edit distance 1, find a simple (no loop) path that
; goes through all strings once and only once. The graph is represented as
; a map of adjacent node lists. We enumerate all simple paths in the graph
; until we found one going through all nodes.
; 84: Write a function which generates the transitive closure of a binary
; relation. The relation will be represented as a set of 2 item vectors.
; (let [divides #{[8 4] [9 3] [4 2] [27 9]}]
; (= (__ divides) #{[4 2] [8 4] [8 2] [9 3] [27 9] [27 3]}))
; (let [progeny
; #{["father" "son"] ["uncle" "cousin"] ["son" "grandson"]}]
; (= (__ progeny)
; #{["father" "son"] ["father" "grandson"]
; ["uncle" "cousin"] ["son" "grandson"]}))
(fn [relation]
(letfn [(expand [r]
(let [m (into {} r)]
(->> (concat
r
(for [[k v] m]
(when-let [nv (m v)] [k nv])))
(filter identity)
set)))
(first-consecutive [pred [f & rs]]
(when rs
(if (pred f (first rs))
f
(recur pred rs))))]
(first-consecutive = (iterate expand relation))))
; we iteratively expand the set of transitive relation, until the set no
; longer changes
; 85: Write a function which generates the power set of a given set. The power
; set of a set x is the set of all subsets of x, including the empty set and x
; itself.
; (= (__ #{1 :a}) #{#{1 :a} #{:a} #{} #{1}})
(fn [s]
(reduce
(fn [init e]
(set (concat init (map #(conj % e) init) [#{e}])))
#{#{}} s))
; we just add one element at a time
; 86: Happy numbers are positive integers that follow a particular formula: take
; each individual digit, square it, and then sum the squares to get a new number
; Repeat with the new number and eventually, you might get to a number whose
; squared sum is 1. This is a happy number. An unhappy number (or sad number) is
; one that loops endlessly. Write a function that determines if a number is
; happy or not.
; (= (__ 7) true)
; (= (__ 986543210) true)
(fn [x]
(letfn [(digits [n]
(for [y (iterate (partial * 10) 1) :while (<= y n)]
(rem (int (/ n y)) 10)))
(sqr-sum [ds]
(reduce + (map #(* % %) ds)))]
(let [r (some #{1 4} (iterate (comp sqr-sum digits) x))]
(cond
(= 1 r) true
(= 4 r) false))))
; it turns out that 4 is a sad number, as it results into an infinite loop
; 88: Write a function which returns the symmetric difference of two sets. The
; symmetric difference is the set of items belonging to one but not both of
; the two sets.
; (= (__ #{1 2 3 4 5 6} #{1 3 5 7}) #{2 4 6 7})
#(set (remove (set (filter %1 %2)) (into %1 %2)))
; we remove the intersection from the union
; 89: Starting with a graph you must write a function that returns true if it
; is possible to make a tour of the graph in which every edge is visited exactly
; once. The graph is represented by a vector of tuples, where each tuple
; represents a single edge. The rules are:
; - You can start at any node.
; - You must visit each edge exactly once.
; - All edges are undirected.
; (= true (__ [[1 2] [2 3] [3 4] [4 1]]))
; (= false (__ [[1 2] [2 3] [2 4] [2 5]]))
; (= false (__ [[:a :b] [:a :b] [:a :c] [:c :a] [:a :d] [:b :d] [:c :d]]))
; (= true (__ [[:a :b] [:a :c] [:c :b] [:a :e] [:b :e] [:a :d] [:b :d]
; [:c :e] [:d :e] [:c :f] [:d :f]]))
(fn [edge-list]
(let [graph (apply merge-with
#(into %1 %2)
(apply concat
(map-indexed
(fn [i [k v]]
[{k #{{:node v :index i}}}
{v #{{:node k :index i}}}])
edge-list)))]
(if (some
(fn [node]
(some
identity
(flatten
((fn visit [n vs]
(if (every? #(vs (:index %)) (graph n))
(if (every? identity vs) true false)
(for [x (graph n)]
(when-not (vs (:index x))
(visit (:node x) (assoc vs (:index x) true))))))
node (vec (repeat (count edge-list) false))))))
(set (apply concat edge-list)))
true false)))
; This problem looks similar to problem 82 as both are graph traversals, but
; the graphs are quite different. Here redundent edges exist, so we cannot use
; a set or a map to track edge visits, we instead use a vector of booleans.
; Also, the condition is to traverse all edges instead of all nodes. We again
; use a map of adjacent node lists as the graph, but supplement each adjacent
; node with the index of the corresponding edge. Finally, here a node can be
; visited multiple times, and we terminates a path at a node only when all of
; its edges have already been visited.
; 91: Given a graph, determine whether the graph is connected. A connected
; graph is such that a path exists between any two given nodes.
; -Your function must return true if the graph is connected and false otherwise.
; -You will be given a set of tuples representing the edges of a graph. Each
; member of a tuple being a vertex/node in the graph.
; -Each edge is undirected (can be traversed either direction).
; (= false (__ #{[1 2] [2 3] [3 1] [4 5] [5 6] [6 4]}))
; (= true (__ #{[1 2] [2 3] [3 1][4 5] [5 6] [6 4] [3 4]}))
(fn [edge-list]
(let [graph (apply merge-with
#(into %1 %2)
(apply concat
(map (fn [[k v]] [{k #{v}} {v #{k}}]) edeg-list)))]
(if (some #(= (count %) (count graph))
(flatten
((fn paths [node seen]
(if (seen node)
seen
(for [x (graph node)]
(paths x (conj seen node)))))
(ffirst graph) #{})))
true false)))
; This graph traversal problem is simpler than both 82 and 89. We only need
; to start searching from any one of the nodes instead of all nodes. But the
; pattern of the code is similar.
; 92: Write a function to parse a Roman-numeral string and return the number it
; represents. You can assume that the input will be well-formed, in upper-case,
; and follow the subtractive principle. You don't need to handle any numbers
; greater than MMMCMXCIX (3999), the largest number representable with
; ordinary letters.
; (= 827 (__ "DCCCXXVII"))
; (= 48 (__ "XLVIII"))
(fn [s]
(let [snum {[\C \M] 900 [\C \D] 400 [\X \C] 90
[\X \L] 40 [\I \X] 9 [\I \V] 4}
nums {\I 1 \V 5 \X 10 \L 50 \C 100 \D 500 \M 1000}]
(letfn [(sum-snum [[f & r]]
(if f
(+ (if-let [n (snum [f (first r)])]
n 0)
(sum-snum r))
0))
(del-snum [[f & r]]
(when f
(if (snum [f (first r)])
(del-snum (rest r))
(cons f (del-snum r)))))]
(reduce + (sum-snum s) (map nums (del-snum s))))))
; We first find and sum the special numbers (4, 9, etc), remove them and sum
; the rest.
; 93: Write a function which flattens any nested combination of sequential
; things (lists, vectors, etc.), but maintains the lowest level sequential
; items. The result should be a sequence of sequences with only one level of
; nesting.
; (= (__ '((1 2)((3 4)((((5 6))))))) '((1 2)(3 4)(5 6)))
(fn pf [coll]
(let [l (first coll) r (next coll)]
(concat
(if (and (sequential? l) (not (sequential? (first l))))
[l]
(pf l))
(when (sequential? r)
(pf r)))))
; this is just a slight modification of the solution to problem 28.
; 94: The game of life is a cellular automaton devised by mathematician John
; Conway. The 'board' consists of both live (#) and dead ( ) cells. Each cell
; interacts with its eight neighbours (horizontal, vertical, diagonal), and its
; next state is dependent on the following rules: 1) Any live cell with fewer
; than two live neighbours dies, as if caused by under-population. 2) Any live
; cell with two or three live neighbours lives on to the next generation. 3)
; Any live cell with more than three live neighbours dies, as if by overcrowding
; . 4) Any dead cell with exactly three live neighbours becomes a live cell, as
; if by reproduction. Write a function that accepts a board, and returns a
; board representing the next generation of cells.
;(= (__ [" "
;" ## "
;" ## "
;" ## "
;" ## "
;" "])
;[" "
;" ## "
;" # "
;" # "
;" ## "
;" "])
(fn [board]
(let [offsets [[-1 -1] [-1 0] [-1 1]
[0 -1] [0 1]
[1 -1] [1 0] [1 1]]
height (count board)
width (count (first board))
get-state (fn [[x y] [dx dy]]
(let [c (+ x dx) r (+ y dy)]
(if (or (< c 0) (= c width) (< r 0) (= r height))
\space
(get-in board [r c]))))
count-lives (fn [p]
(reduce + (map #(if (= \# (get-state p %)) 1 0) offsets)))
next-state (fn [s p]
(let [n (count-lives p)]
(if (or (= n 3)
(and (= s \#) (= n 2)))
\#
\space)))]
(->> (for [y (range height) x (range width)]
(next-state (get-in board [y x]) [x y]))
(partition width)
(map #(apply str %))
vec)))
; This is straight-forward. The only tricky part is to remember that the order
; of paramaters for the get-in function and the x-y coordinates is opposite to
; each other.
; 95: Write a predicate which checks whether or not a given sequence represents
; a binary tree. Each node in the tree must have a value, a left child, and a
; right child.
; (= (__ '(:a (:b nil nil) nil)) true)
; (= (__ '(:a (:b nil nil))) false)
; (= (__ [1 nil [2 [3 nil nil] [4 nil nil]]]) true)
(fn bt? [t]
(if (or (not (sequential? t))
(and (= 3 (count t))
(bt? (second t))
(bt? (last t))))
true false))
; I think one of the unit tests of the problem is wrong:
; (= (__ [1 [2 [3 [4 false nil] nil] nil] nil]) false)
; why shouldn't "false" be a legal tree node, or why should leaf have to be nil?
; 96: Let us define a binary tree as "symmetric" if the left half of the tree
; is the mirror image of the right half of the tree. Write a predicate to
; determine whether or not a given binary tree is symmetric.
; (= (__ '(:a (:b nil nil) (:b nil nil))) true)
; (= (__ '(:a (:b nil nil) nil)) false)
; (= (__ [1 [2 nil [3 [4 [5 nil nil] [6 nil nil]] nil]]
;[2 [3 nil [4 [6 nil nil] [5 nil nil]]] nil]]) true)
(fn [t]
((fn mir? [l r]
(if (or (= nil l r)
(and (= (first l) (first r))
(mir? (second l) (last r))
(mir? (last l) (second r))))
true false))
(second t) (last t)))
; 97: Pascal's triangle is a triangle of numbers computed using the following
; rules:
; - The first row is 1.
; - Each successive row is computed by adding together adjacent numbers in the
; row above, and adding a 1 to the beginning and end of the row.
; Write a function which returns the nth row of Pascal's Triangle.
; (= (map __ (range 1 6))
;[ [1]
;[1 1]
;[1 2 1]
;[1 3 3 1]
;[1 4 6 4 1]])
(fn [n]
(nth (iterate
(fn [pre]
(vec
(concat
[1]
(map (fn [[f s]] (+ f s)) (partition 2 1 pre))
[1])))
[1])
(dec n)))
Comments
comments powered by Disqus