My solutions for problems No. 76-100 on 4clojure.com

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

Matt's picture

Problem #95

re: Your solution to #95, and pardon me if this is kind of a "data structures 101" question, implies that 'nil' is a binary tree. Why is this so?

Huahai's picture

Interesting point

I think it's up to the definition of a binary tree.  Wikipedia defines a binary tree as such: "In computer science, a binary tree is a tree data structure in which each node has at most two child nodes". If we take such a definition literally, which I am, a single nil can be a binary tree if it is passed in as a tree type. Unless the definition requires that the tree data structure must not be a single nil, but it is not defined in such way, and the question is not explicit about this either.

Post new comment

The content of this field is kept private and will not be shown publicly. If you have a Gravatar account associated with the e-mail address you provide, it will be used to display your avatar.
  • Allowed HTML tags: <a> <em> <strong> <cite> <blockquote> <code> <ul> <ol> <li> <dl> <dt> <dd> <div> <h1><h2><h3><sub><sup><b><i><u><font><img>
  • You may post code using <code>...</code> (generic) or <?php ... ?> (highlighted PHP) tags.
  • Lines and paragraphs break automatically.

More information about formatting options

To prevent automated spam submissions leave this field empty.
Nice place