My solutions for problems No. 51-75 on 4clojure.com

This post continues the previous one, on my solutions for small clojure programming problems on 4clojure.com. Doing these problems seems to be addictive as I could not seem to stop myself. The site recently added a golf league feature, so one can see how short one's own solution compared with others. If a lot of people got a much shorter solution than yours, you know you are not thinking in the right way. This little competition makes the site even more attractive. Anyhow, the code is here:


; 53: Given a vector of integers, find the longest consecutive sub-sequence of
; increasing numbers.  If two sub-sequences have the same length, use the one
; that occurs first. An increasing sub-sequence must have a length of 2 or
; greater to qualify.
; (= (__ [1 0 1 2 3 0 4 5]) [0 1 2 3])
; (= (__ [7 6 5 4]) [])
(fn [coll]
  (->> (partition 2 1 coll) 
    (partition-by #(- (second %) (first %))) 
    (filter #(= 1 (- (second (first %)) (ffirst %)))) 
    (reduce #(if (< (count %1) (count %2)) %2 %1) [])
    flatten
    distinct))
; we first create a list of neighoring pairs, partition them by their pair
; differences, keep those with difference 1, finally return the longest one

; 54: Write a function which returns a sequence of lists of x items each.
; Lists of less than x items should not be returned.
; (= (__ 3 (range 8)) '((0 1 2) (3 4 5)))
; forbidden: partition, partition-all
(fn partition2 [n coll]
  (when (<= n (count coll))
    (cons (take n coll) (partition2 n (drop n coll)))))
; we recursively take n items till not enough items

; 55: Write a function that returns a map containing the number of occurences
; of each distinct item in a sequence.
; (= (__ [1 1 2 3 2 1 1]) {1 4, 2 2, 3 1})
; forbidden: frequencies
(fn [coll]
  (let [gp (group-by identity coll)] 
    (zipmap (keys gp) (map #(count (second %)) gp))))
; note a map entry is just a two item vector, first item is the key, the
; second item is the value

; 56: Write a function which removes the duplicates from a sequence. Order of
; the items must be maintained.
; (= (__ [1 2 1 3 1 2 4]) [1 2 3 4])
; forbidden: distinct
(fn [coll] 
  ((fn step [[x & xs] seen] 
     (when x
       (if (seen x) 
         (step xs seen)
         (cons x (step xs (conj seen x)))))) 
   coll #{}))
; we recursively go through the sequence, use a set to keep track of items
; we've seen, only return those we have not seen before.
  

; 58: Write a function which allows you to create function compositions. The
; parameter list should take a variable number of functions, and create a
; function applies them from right-to-left.
; (= [3 2 1] ((__ rest reverse) [1 2 3 4]))
; forbidden: comp
(fn [x & xs]
  (fn [& args]
    ((fn step [[f & fs] a]
       (if fs
         (f (step fs a))
         (apply f a)))
     (cons x xs) args)))
; step function takes the function list and the arguments, recursively builds
; an ever deeper call stack till at the end of the list, where the right most
; function is called with the given arguments.
    

; 59: Take a set of functions and return a new function that takes a variable
; number of arguments and returns sequence containing the result of applying
; each function left-to-right to the argument list.
; (= [21 6 1] ((__ + max min) 2 3 5 1 6 4))
; forbidden: juxt
(fn [x & xs]
  (fn [& args]
    (map #(apply % args) (cons x xs))))

; 60: Write a function which behaves like reduce, but returns each
; intermediate value of the reduction. Your function must accept either two
; or three arguments, and the return sequence must be lazy.
; (= (take 5 (__ + (range))) [0 1 3 6 10])
; (= (__ conj [1] [2 3 4]) [[1] [1 2] [1 2 3] [1 2 3 4]])
; forbidden: reductions
(fn reductions2
  ([f init [x & xs]] 
   (cons init (lazy-seq (when x (reductions2 f (f init x) xs))))) 
  ([f coll] 
   (reductions2 f (first coll) (rest coll))))

; 61: Write a function which takes a vector of keys and a vector of values
; and constructs a map from them.
; (= (__ [:a :b :c] [1 2 3]) {:a 1, :b 2, :c 3})
; forbidden: zipmap
#(into {} (map vector %1 %2))

; 62. Given a side-effect free function f and an initial value x
; write a function which returns an infinite lazy sequence of x,
; (f x), (f (f x)), (f (f (f x))), etc.  
; (= (take 5 (__ #(* 2 %) 1)) [1 2 4 8 16])
; forbidden: iterate
(fn iterate2 [f x]
  (cons x (lazy-seq (iterate2 f (f x)))))
; it turns out that clojure's own implmentation is the same

; 63. Given a function f and a sequence s, write a function which returns a
; map. The keys should be the values of f applied to each item in s. The value
; at each key should be a vector of corresponding items in the order they
; appear in s.
; (= (__ #(> % 5) #{1 3 6 8}) {false [1 3], true [6 8]})
; forbidden group-by
(fn [f s]
  ((fn step [ret f [x & xs]]
     (if x
       (let [k (f x)]
         (step (assoc ret k (conj (get ret k []) x)) f xs))
       ret))
    {} f (seq s)))
; the get function takes a default argument for when the key is not found,
; which is used to initialize a vector here. Note the use of seq for s, as
; the collection may be a set, where the [x & xs] destructering doesn't work.
; Intead of recursively going over a sequence, we can also use reduce:
(fn [f s]
  (reduce 
    (fn [ret x]
      (let [k (f x)]
        (assoc ret k (conj (get ret k []) x))))
    {} s))

; 65: Write a function which takes a collection and returns one of :map, :set,
; :list, or :vector - describing the type of collection it was given.
; (= :map (__ {:a 1, :b 2}))
; forbidden: class, type, Class, vector?, sequential?, list?, seq?, map?, set?
; instance? getClass
(fn [coll]
  (let [x (rand-int 100) y (rand-int 100) 
        p [x y] c (conj coll z)]
    (cond 
      (= y (get c x)) :map
      (= p (get c p)) :set
      (= x (last (conj c x))) :vector
      :else :list)))
; we conj a random two element vector into the collection, map will treat it
; as a new key value pair, others treat it as a single item; set is a map too,
; so we can get the vector back with itself as the key; vector and list are
; differentiated by the position of the conj.

; 67: Write a function which returns the first x number of prime numbers.
(fn [x]
  (take x
        (remove 
          (fn [n] 
            (some #(= 0 (mod n %)) (range 2 (inc (int (Math/sqrt n))))))
          (iterate inc 2))))
; we just test each number n, each divided by numbers from 2 up to sqrt(n)

; 69: Write a function which takes a function f and a variable number of maps.
; Your function should return a map that consists of the rest of the maps
; conj-ed onto the first. If a key occurs in more than one map, the mapping(s)
; from the latter (left-to-right) should be combined with the mapping in the
; result by calling (f val-in-result val-in-latter)
; (= (__ - {1 10, 2 20} {1 3, 2 10, 3 15}) {1 7, 2 10, 3 15})
; forbidden: merge-with
(fn [f m & ms]
  (reduce 
    (fn [ret x]
      (reduce 
        (fn [r k] 
          (conj r (if (r k) [k (f (r k) (x k))] (find x k)))) 
        ret (keys x))) 
    (cons m ms)))
; note a map is a function itself, so (r k) and (x k) works

; 70: Write a function which splits a sentence up into a sorted list of words.
; Capitalization should not affect sort order and punctuation should be ignored
; (= (__  "Have a nice day.") ["a" "day" "Have" "nice"])
(fn [s]
  (sort-by #(.toLowerCase %) (re-seq #"\w+" s)))

; 73: A tic-tac-toe board is represented by a two dimensional vector. X is
; represented by :x, O is represented by :o, and empty is represented by :e. A
; player wins by placing three Xs or three Os in a horizontal, vertical, or
; diagonal row. Write a function which analyzes a tic-tac-toe board and returns
; :x if X has won, :o if O has won, and nil if neither player has won.
; (= nil (__ [[:e :e :e]
            ;[:e :e :e]
            ;[:e :e :e]]))
;(= :x (__ [[:x :e :o]
           ;[:x :e :e]
           ;[:x :e :o]]))
(fn [board]
  (let [i [0 1 2]
        c (take 12 (cycle i))
        p (flatten (map #(repeat 3 %) i))
        zip #(map vector %1 %2)
        win? (fn [w] 
               (some 
                 (fn [x] (every? #(= w (get-in board %)) x)) 
                 (partition 
                   3 (into (zip (into i p) c) (zip c (into (reverse i) p))))))]
    (cond 
      (win? :x) :x
      (win? :o) :o)))
; we basically enumerate all possible winning positions, which fall into
; some regular patterns. I am sure there are better ways, but in the
; interest of time... Note the use of get-in to fetech value in a multiple
; dimensional vector: (get-in board [x y])

; 74: Given a string of comma separated integers, write a function which
; returns a new comma separated string that only contains the numbers
; which are perfect squares.
; (= (__ "4,5,6,7,8,9") "4,9")
(fn [s]
  (->> (re-seq #"\d+" s)
    (map #(Integer/parseInt %))
    (filter (fn [x]
              (let [r (int (Math/sqrt x))]
                (= x (* r r)))))
    (interpose ",")
    (apply str)))

; 75: Two numbers are coprime if their greatest common divisor equals 1.
; Euler's totient function f(x) is defined as the number of positive integers
; less than x which are coprime to x. The special case f(1) equals 1. Write a
; function which calculates Euler's totient function.
; (= (__ 10) (count '(1 3 7 9)) 4)
(fn [n]
  (->> (range 2 n)
    (filter (fn [x]
              (= 1 ((fn gcd [a b]
                      (if (= 0 b) a (gcd b (mod a b))))
                    x n))))
    count
    inc))

Comments

angel's picture

slution 69

Hi..sorry but I don't understand the solution 69...I've tried understand but its hard..would you explain it a bit more detailed..would be usefull for me..thanks a lot !!

Huahai's picture

merge-with

Hi angel,

Thank you for stopping by. Let's read the code outside-in.

The outer reduce runs through all the (variable numbers of) input maps to accumulate results, and it takes two arguments: The first is an anonymous function defined in place (explained below), that does the result calculation for each input map; and the second argument is just the list of input maps (cons together the first and the rest).

The outer anonymous function of the outer reduce takes two arguments: ret is the accumulated result map so far, x is the next input map to be processed. This function uses a reduce function to run through the keys of x to accumulate results, starting with ret as the initial value.

At each step (i.e., at different key of x), an inner anonymous function is used to calculate the new result map. This function take two arguments: r is the existing result map, k is the key currently being worked on. The work is very simple: if the key k already exists in the result map r, we use the given function f to calculate the new value of k using the combination of its value in r (existing map) and its value in x (input map), and conj the new key-value pair (a two-element vector) to the result map; if k does not exist in r, we simply conj the key-value pair in x (accessed by the find function) to the result map.

Thinking on a higher level, we start with the first input map, taking it as the initial value of the result map, run through the rest of the input maps, and keep merging their values to the result map. Reduce is the perfect function for such a result accumulation purpose.

As you know, this is an implementation of merge-with function. My implementation, though a bit shorter, is actually similar to Clojure's own implementation, you can (source merge-with) in REPL to read theirs, which might be more readable, I am not sure.

I hope this explanation helps. Please feel free to ask more questions.

angel's picture

thanks

Hi..thanks for the usefull answer..now it is clear for me...thanks again......

Huahai's picture

You are welcome

Clojure is a fun language to play with. Happy coding Cool

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