Solutions to 4Clojure Problems

solutions_to_4clojure_problems.clj

;;
;; www.4clojure.com
;;


;; #19 last element
(comp first reverse)
;; (partial reduce (fn [_ x] x))
;; (fn [coll] (reduce (fn [_ x] x) coll))
;; (partial reduce #(identity %2))
;; (partial reduce #(second %&))


;; #20 penultimate element
(comp last butlast)
;; (fn [coll] (-> coll butlast last))


;; #21 nth elemenet
(fn [coll n] (->> coll (drop n) first))


;; #22 count a sequence
(fn [coll] (reduce (fn [item-count _] (inc item-count)) 0 coll))
;; (partial reduce (fn [item-count _] (inc item-count)) 0)


;; #23 reverse a sequence
(partial reduce conj ())
;; (fn [coll] (reduce (fn [reversed-coll x] (cons x reversed-coll)) () coll))
;; (partial reduce #(cons %2 %1) ())


;; #24 sum it all up
(partial reduce +)


;; #25 find odd numbers
(partial filter odd?)


;; #26 fibonacci sequence
(fn [n]
  (rest
    (reduce (fn [fibonacci-seq _]
              (let [last-item (last fibonacci-seq)
                    second-last-item (-> fibonacci-seq pop last)
                    new-item (+ last-item second-last-item)]
                (conj fibonacci-seq new-item)))
            [0 1]
            (range (dec n)))))

(fn [n]
  (->> [1 1]
       (iterate
         (fn [s]
           (conj s (+ (-> s butlast last) (last s)))))
       (take (dec n))
       last))


;; #27 palindrome detector
(fn [coll] (= (seq coll) (seq (reverse coll))))


;; #28 flatten a sequence
(fn flatten' [coll]
  (when-some [s (seq coll)]
    (reduce
      (fn [a x]
        (if (coll? x)
          (into a (flatten' x))
          (conj a x)))
      []
      s)))


;; #29 get the caps
(fn [s]
  (->> s
       (filter #(re-matches #"[A-Z]" %))
       (apply str)))

(comp clojure.string/join (partial filter #(Character/isUpperCase %)))


;; #30 compress a sequence
(fn [coll]
  (reduce (fn [compressed-coll x]
            (if (= x (peek compressed-coll))
              compressed-coll
              (conj compressed-coll x)))
          []
          coll))


;; #31 pack a sequence
(fn [coll]
  (reduce (fn [packed-coll x]
            (let [sublist (vec (peek packed-coll))]
              (if (contains? (set sublist) x)
                (conj (pop packed-coll) (conj sublist x))
                (conj packed-coll [x]))))
          []
          coll))


;; #32 duplicate a sequence
(partial mapcat #(repeat 2 %))

(fn [coll]
  (reduce (fn [duped-coll x] (conj duped-coll x x))
          []
          coll))


;; #33 replicate a sequence
(fn [coll n]
  (mapcat (partial repeat n) coll))

(fn [coll n]
  (reduce (fn [replicated-seq x]
            (apply conj replicated-seq (repeat n x)))
          []
          coll))


;; #34 implement range
(fn [lower upper]
  (take-while #(< % upper) (iterate inc lower)))


;; #38 maximum value
(fn [& xs] (reduce (fn [maximum x] (if (> maximum x) maximum x)) xs))


;; #39 interleave two sequences
(partial mapcat vector)

(fn [coll1 coll2] (mapcat vector coll1 coll2))


;; #40 interpose a sequence
(fn [x s]
  (butlast (mapcat vector s (repeat x))))

(fn [x coll] (butlast (mapcat #(vector % x) coll)))


;; #41 drop every nth item
(fn drop-nth [coll n]
  (when-some [s (seq coll)]
    (concat (take (dec n) s)
            (drop-nth (drop n s) n))))

(fn [coll n]
  (reduce (fn [result [index x]]
            (if (zero? (rem (inc index) n))
              result
              (conj result x)))
          []
          (map-indexed vector coll)))


;; #42 factorial fun
(fn [n] (reduce * (range 1 (inc n))))


;; #43 reverse interleave
(fn [coll n] (apply map vector (partition n coll)))


;; #44 rotate sequence
(fn [n coll]
  (let [n' (mod n (count coll))]
    (concat (drop n' coll) (take n' coll))))


;; #45 introduction to iterate
[1 4 7 10 13]


;; #46 flipping out
(fn [f] (fn [& xs] (apply f (reverse xs))))


;; #47 contain yourself
4


;; #48 introduction to some
6


;; #49 split a sequence
(fn [n coll] [(take n coll) (drop n coll)])


;; #50 split by type
(fn [xs] (vals (group-by type xs)))


;; #51 advanced destructuring
[1 2 3 4 5]


;; #52 introduction to destructuring
[c e]


;; #53 longest increasing subsequence
(fn [coll]
  (or (->> (reduce (fn [subseqs x]
                     (let [last-subseq (last subseqs)
                           last-x (last last-subseq)]
                       (if (> x last-x)
                         (conj (pop subseqs) (conj last-subseq x))
                         (conj subseqs [x]))))
                   [(subvec coll 0 1)]
                   (rest coll))
           (sort-by count >)
           (filter #(>= (count %) 2))
           first)
      []))

(fn [xs]
  (or (->> xs
       (reduce
         (fn [{:keys [last-subseq subseqs] :as a} x]
           (let [last-x (peek last-subseq)]
             (if (> x last-x)
               (update a :last-subseq conj x)
               (-> a
                 (assoc :last-subseq [x])
                 (update :subseqs conj last-subseq)))))
         {:last-subseq (subvec xs 0 1)
          :subseqs []})
       ((juxt :subseqs :last-subseq))
       (apply conj)
       (filterv #(>= (count %) 2))
       (sort-by count >)
       first)
      []))


;; #54 partition a sequence
(fn partition'
  [n coll]
  (lazy-seq
    (when-let [xs (seq coll)]
      (let [p (doall (take n xs))]
        (when (= (count p) n)
          (cons p (partition' n (nthrest xs n))))))))

(fn partition'
  [n coll]
  (if (< (count coll) n)
    nil
    (concat [(take n coll)] (partition' n (drop n coll)))))


;; #55 count occurrences
(fn [coll]
  (->> coll
       (group-by identity)
       (map (fn [[x v]] (vector x (count v))))
       (into {})))

(fn [coll]
  (reduce
    (fn [a x]
      (update a x (fnil inc 0)))
    {}
    coll))

(partial reduce (fn [a x] (update a x (fnil inc 0))) {})


;; #56 find distinct items
(fn [coll]
  (reduce (fn [a x]
            (if (contains? (set a) x)
              a
              (conj a x)))
          []
          coll))


;; #57 simple recursion
(list 5 4 3 2 1)


;; #58 function composition
(fn [& fs]
  (fn [& xs]
    (let [rfs (reverse fs)
          r (-> rfs (first) (apply xs))]
      (reduce (fn [a f] (f a))
              r
              (rest rfs)))))

(fn [& fns]
  (fn [& xs]
    (let [[f & more] (reverse fns)]
      (reduce
        (fn [a f] (f a))
        (apply f xs)
        more))))


;; #59 juxtaposition
(fn [& fs]
  (fn [& xs]
    (map #(apply % xs)
         fs)))


;; #60 sequence reductions
(fn f60
  ([f coll] (f60 f (first coll) (rest coll)))
  ([f init coll]
   (lazy-seq
     (cons init
           (when-some [s (seq coll)]
             (f60 f (f init (first s)) (rest coll)))))))


;; #61 map construction
(fn [v w] (into {} (map vector v w)))


;; #62 re-implement `iterate`
(fn f62 [f x]
  (lazy-seq (cons x (f62 f (f x)))))


;; #63 group a sequence
(fn [f coll]
  (reduce (fn [a x]
            (update a (f x) (fnil conj []) x))
          {}
          coll))


;; #64 intro to reduce
+


;; #65 black box testing
(fn [coll]
  (let [x [(rand-int 100) (rand-int 100)]
        y [(rand-int 100) (rand-int 100)]
        empty-coll (empty coll)
        new-coll (conj empty-coll x x y)]
    (if (= (count new-coll) 2)
      (if (contains? new-coll x)
        :set
        :map)
      (if (= (first new-coll) y)
        :list
        :vector))))


;; #66 greatest common divisor
;; euclidean algorithm
(fn [a b]
  (cond 
    (zero? b) a
    (> a b)   (recur b (rem a b))
    :else     (recur a (rem b a)))


;; #67 prime numbers
(fn [c]
  (letfn [(prime-number? [n]
            (let [n-sqrt (-> n (Math/sqrt) (Math/round))]
              (not (some #(zero? (rem n %))
                         (range 2 (inc n-sqrt))))))]
    (into []
          (comp (drop 2)
                (filter prime-number?)
                (take c))
          (range))))


;; #68 recurring theme
[7 6 5 4 3]


;; #69 merge with a function
(fn [f & ms]
  (reduce
    (fn [a m]
      (reduce-kv
        (fn [a' k v]
         (update a' k
                 (if (contains? a' k) f #(identity %2))
                 v))
        a
        m))
    ms))


;; #70 word sorting
(fn [s]
  (->> s
       (re-seq #"\w+")
       (sort String/.compareIgnoreCase)))

(fn [s]
  (sort-by
    clojure.string/lower-case
    (clojure.string/split s #"[^\w]")))

;; #71 re-arranging code: `->`
last


;; #72 re-arranging code: `->>`
reduce +


;; #73 analyze a tic-tac-toe board
(fn [board]
  (let [rows board
        columns (apply mapv vector rows)
        main-diagonal (map-indexed (fn [i row] (nth row i))
                                   rows)
        anti-diagonal (->> rows
                           (reverse)
                           (map-indexed (fn [i row] (nth row i)))
                           (reverse))
        scan (fn [coll]
               (let [a-set (set coll)]
                 (when (and (= (count a-set) 1)
                            (not= a-set #{:e}))
                   (first a-set))))]
    (reduce (fn [_ coll]
              (when-some [winner (scan coll)]
                (reduced winner)))
            nil
            (concat rows columns [main-diagonal anti-diagonal]))))


;; #74 filter perfect squares
(fn [s]
  (letfn [(perfect-square? [n]
            (let [sqrt (Math/round (Math/sqrt n))]
              (= n (* sqrt sqrt))))]
    (->> (clojure.string/split s #",")
         (map #(Long/parseLong % 10))
         (filter perfect-square?)
         (clojure.string/join ","))))


;; #75 Euler's totient function
(fn [n]
  (letfn [(gcd [a b]  ; Euclidean algorithm
            (cond
              (zero? b) a
              (> a b)   (recur b (rem a b))
              :else     (recur a (rem b a))))

          (co-prime? [a b]
            (= (gcd a b) 1))]
    (->> (range 1 (inc n))
         (filter #(co-prime? n %))
         (count))))


;; #76 introduction to trampoline
;; (fn trampoline [f & xs]
;;   (loop [r (apply f xs)]
;;     (if (fn? r)
;;       (recur (r))
;;       r)))
[1 3 5 7 9 11]


;; #77 anagram finder
(fn [coll]
  (->> coll
       (group-by set)
       (vals)
       (into #{}
             (comp (filter #(> (count %) 1))
                   (map set)))))


;; #78 reimplement trampoline
(fn [f & xs]
  (loop [r (apply f xs)]
    (if (fn? r)
      (recur (r))
      r)))


;; #79 triangle minimal path
(fn [tree]
  (letfn [(left-subtree [tree] (map butlast (rest tree)))
          (right-subtree [tree] (map rest (rest tree)))
          (minimal-path-sum [min-path-sum [[root] :as tree]]
            (if (= (count tree) 1) ;; count of nodes = 1
              root
              (+ min-path-sum
                 root
                 (min (minimal-path-sum 0 (left-subtree tree))
                      (minimal-path-sum 0 (right-subtree tree))))))]
    (minimal-path-sum 0 tree)))


;; #80 perfect numbers
(fn [n]
  (= n 
     (->> (range 1 n)
          (filter #(zero? (rem n %)))
          (apply +))))


;; #81 set intersection
;; A ∩ B = A \ (A \ B) where
;;   ∩: intersection
;;   \: difference
(fn [a b]
  (->> b
       (clojure.set/difference a)
       (clojure.set/difference a)))


;; #86 happy number
(fn [n]
  (loop [sum n
         seen #{}]
    (if (= sum 1)
      true
      (if (contains? seen sum)
        false
        (recur (->> (clojure.string/split (str sum) #"")
                    (map #(Long/parseLong %))
                    (map #(* % %))
                    (apply +))
               (conj seen sum))))))


;; #102 intoCamelCase
(fn [s]
  (let [ss (clojure.string/split s #"-")]
    (clojure.string/join
      (cons (first ss)
            (map clojure.string/capitalize (rest ss))))))

;; #115 balanced number
(fn [n]
  (let [digits (map #(Long/parseLong %) (clojure.string/split (str n) #""))
        c (count digits)
        left-half (take (quot c 2) digits)
        right-half (take-last (quot c 2) digits)]
    (= (apply + left-half)
       (apply + right-half))))


;; #177 balancing brackets 
(fn [s]
  (letfn [(match?
            [opening closing]
            (case opening
              \( (= \) closing)
              \[ (= \] closing)
              \{ (= \} closing)
              false))
            
          (balanced?
            [stack s]
            (if (empty? s)
              (empty? stack)
              (let [c (first s)
                    tail (rest s)]
                (if (#{\( \[ \{} c)
                  (balanced? (conj stack c) tail)
                  (and (match? (first stack) c)
                       (balanced? (rest stack) tail))))))]
    (balanced? () (filter #{\( \) \[ \] \{ \}} s))))