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  [2 3 4]) [ [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

comments powered by Disqus