((fn [& xs] (reduce (fn [a b] (if (> a b) a b)) xs)) 5 2 9 0) (def lazy-fibo (iterate (fn [[a b]] [b (+ a b)]) [0 1])) #(reverse (take % (loop [m % fibs '(1 1)] (if (< m 3) fibs (recur (dec m) (cons (+ (first fibs) (-> fibs rest first)) fibs)))))) (fn [f & maps] (reduce (fn [merged m] (reduce (fn [merged [k v]] (if (merged k) (assoc merged k (f (merged k) v)) (assoc merged k v))) merged m)) {} maps)) (fn [m] (into {} (for [[k1 map1] m [k2 v2] map1] {[k1 k2] v2}))) ;; 147 - Pascal's trapezoid (fn [base] (iterate (fn [row] (if (= 1(count row)) [(first row) (last row)] (concat [(first row)] (map #(apply +' %) (partition 2 1 row)) [(last row)]))) base)) ;; 42 - Factorial fun (map last (iterate (fn [fact] (conj fact (* (last fact) (count fact)))) [1])) ;; 43 - reverse interleave (fn [coll n] (for [i (range n)] (map #(nth coll %) (map #(+ % i) (range 0 (count coll) n))))) ;; 44 - Rotate sequence (fn [n coll] (take (count coll) (drop (mod n (count coll)) (cycle coll)))) ;; 46 - Flipping out (fn [f] (fn [& args] (apply f (reverse args)))) ;; 50 - Split by type (fn [coll] (into #{} (map last (group-by class coll)))) ;; 53 - Longest increasing sub-seq (fn [[f & r]] (loop [[x & xs] r, current [f], longest [f]] (let [longer (fn [c1 c2] (if (> (count c1) (count c2)) c1 c2))] (if (nil? x) (if (> (count (longer current longest)) 1) (longer current longest) []) (if (> x (last current)) (recur xs (conj current x) longest) (recur xs [x] (longer current longest))))))) ;; 39 Interleave two seqs (fn [& colls] (apply mapcat #(list %1 %2) colls)) ;; 33 Replicate a sequence (fn [coll n] (mapcat #(repeat n %)) coll) ;; 40 Interpose a seq (fn [x coll] (butlast (mapcat #(vector %1 %2) coll (repeat x)))) ;; 41 Drop every Nth item (fn [coll n] (let [mask (apply concat (repeat (conj (vec (repeat (dec n) 1)) 0)))] ;; 54 Partition a sequence (fn [n coll] (loop [c coll partitioned []] (if (< (count c) n) partitioned (recur (drop n c) (conj partitioned (take n c)))))) ;; 55 Count Occurrences (fn [coll] (into {} (map #(vector (first %) (count %)) (partition-by identity (sort coll))))) ;; 56 Find Distinct Items (fn [coll] (reduce #(if (some #{%2} %) % (conj % %2)) [] coll)) ;; 58 Function composition (fn [& fs] (fn [& args] (reduce (fn [v f] (f v)) (apply (last fs) args) (reverse (butlast fs))))) ;; 59 Juxtaposition (fn [& fs] (fn [& args] (for [f fs] (apply f args)))) ;; 60 Sequence reductions ;; https://www.refheap.com/paste/5310 (fn reds ([f [x & xs]] (reds f x xs)) ([f red coll] (lazy-seq (cons red (when-let [s (seq coll)] (reds f (f red (first s)) (rest s))))))) ;; 61 Map construction (fn [ks vs] (apply hash-map (interleave ks vs))) ;; 62 Reimplement iterate (fn it [f x] (cons x (lazy-seq (it f (f x))))) ;; 63 Group a sequence (fn [f coll] (apply merge-with concat (for [x coll] {(f x) [x]}))) ;; 65 Black Box Testing (fn [c] (let [d (conj c {0 1} {0 2} {0 1})] (cond (= (+ 1 (count c)) (count d)) :map (= (+ 2 (count c)) (count d)) :set (= (cons {0 3} d) (conj d {0 3})) :list true :vector))) ;; 66 Greatest Common Divisor (fn [a b] (if (zero? (rem a b)) b (recur b (rem a b)))) ;; 67 Prime Numbers (fn [n] (letfn [(prime? [p] (or (= p 2) (every? #(> (rem p %) 0) (range 2 (inc (quot p 2))))))] (take n (filter prime? (iterate inc 2))))) ;; 70 Word Sorting (fn [s] (let [words (map #(clojure.string/replace % #"\W+" "") (clojure.string/split s #"\s+")) words-hash (into {} (for [w words] [(clojure.string/lower-case w) w]))] (for [sw (sort (keys words-hash))] (words-hash sw)))) ;; 73 Analyze a Tic-Tac-Toe game (fn [board] (let [row-wins (for [x (range 0 3)] (for [y (range 0 3)] [y x])) col-wins (for [x (range 0 3)] (for [y (range 0 3)] [x y])) diagonal-wins (vector (for [x (range 0 3) y (range 0 3) :when (= x y)] [x y]) (for [x (range 0 3) y (range 0 3) :when (= (+ x y) 2)] [x y])) wins (concat row-wins col-wins diagonal-wins) mark (fn [x y] (get-in board [x y])) has-winning-line (fn [pl] (some (fn [win] (every? (fn [[x y]] (= (mark x y) pl)) win)) wins))] (cond (has-winning-line :x) :x (has-winning-line :o) :o true nil))) ;; 74 Filter Perfect Squares (fn [xs] (apply str (interpose "," (filter #(let [n (Integer. %) sqrt (int (Math/sqrt n))] (= n (* sqrt sqrt))) (re-seq #"\d+" xs))))) ;; 75 Euler's totient function (fn [n] (letfn [(coprimes? [a b] (= 1 ((fn [a b] (if (zero? (rem a b)) b (recur b (rem a b)))) a b) ))] (if (= n 1) 1 (count (filter #(coprimes? n %) (range 1 n)))))) ;; 76 Intro To Trampoline ;; [1 3 5 7 9 11] ;; 77 Anagram Finder (fn [words] (let [letters (into {} (for [w words] [w (sort w)]))] (into #{} (filter #(> (count %) 1) (map #(set (map first (val %))) (group-by #(val %) letters)))))) ;; 78 Reimplement trampoline (fn [f & args] (loop [f f x (apply f args)] (if (fn? x) (recur f (x)) x))) ;; 79 Triangle Minimal path (defn path-indexes ([n] (path-indexes n 0)) ([n idx] (if (= n 1) [[idx]] (map #(cons idx %) (concat (path-indexes (dec n) idx) (path-indexes (dec n) (inc idx)))) ))) (defn tmp [tri] (first (sort (map #(apply + (map (fn [[level i]] (get level i)) (partition 2 (interleave tri %)))) (path-indexes (count tri)))))) ;; This is the one to be used in 4clojure-sandbox ;; Just the two parts composed (fn [tri] (letfn [(paths ([n] (paths n 0)) ([n idx] (if (= n 1) [[idx]] (map #(cons idx %) (concat (paths (dec n) idx) (paths (dec n) (inc idx)))) )))] (first (sort (map #(apply + (map (fn [[level i]] (get level i)) (partition 2 (interleave tri %)))) (paths (count tri))))))) ;; hypirion's solution: (defn tmp [g] (first (reduce #(map (fn [a [b c]] (+ a (min b c))) %2 (partition 2 1 %1)) (reverse g)))) ;; 80 Perfect Numbers (fn [n] (= n (apply + (filter #(zero? (rem n %)) (range 1 (max 2 (inc (quot n 2)))))))) ;; 81 Set Intersection (fn [s1 s2] (into #{} (filter #(s2 %) s1))) ;; 82 Word Chains (defn chainable? [w1 w2] (let [lw (if (>= (count w1) (count w2)) w1 w2) sw (if (>= (count w1) (count w2)) w2 w1) clw (count lw) csw (count sw) letters (partial re-seq #"\w") diff (fn [c1 c2 d] (cond (nil? c1) (+ (count c2) d) (nil? c2) (+ (count c1) d) (not= (first c1) (first c2)) (recur (next c1) c2 (inc d)) :else (recur (next c1) (next c2) d)))] (cond (= clw csw) (= 1 (apply + (map #(if (= %1 %2) 0 1) (letters w1) (letters w2)))) (= 1 (- clw csw)) (= 1 (diff (letters lw) (letters sw) 0)) :else false))) (defn word-chain ([words] (word-chain words [] (seq words))) ([words chain [w & rnwords :as next-words]] (if-not (seq words) chain (when (seq next-words) (let [[nw & rninchain :as next-in-chain] (filter #(chainable? w %) words)] (or (word-chain (disj words w) (cons w chain) next-in-chain) (word-chain words chain rnwords))))))) (fn [words] (let [chainable? (fn [w1 w2] (let [lw (if (>= (count w1) (count w2)) w1 w2) sw (if (>= (count w1) (count w2)) w2 w1) clw (count lw) csw (count sw) letters (partial re-seq #"\w") diff (fn [c1 c2 d] (cond (nil? c1) (+ (count c2) d) (nil? c2) (+ (count c1) d) (not= (first c1) (first c2)) (recur (next c1) c2 (inc d)) :else (recur (next c1) (next c2) d)))] (cond (= clw csw) (= 1 (apply + (map #(if (= %1 %2) 0 1) (letters w1) (letters w2)))) (= 1 (- clw csw)) (= 1 (diff (letters lw) (letters sw) 0)) :else false)))] (letfn [(word-chain ([words] (word-chain words [] (seq words))) ([words chain [w & rnwords :as next-words]] (if-not (seq words) chain (when (seq next-words) (let [[nw & rninchain :as next-in-chain] (filter #(chainable? w %) words)] (or (word-chain (disj words w) (cons w chain) next-in-chain) (word-chain words chain rnwords)))))))] (if (word-chain words) true false) ))) (word-chain #{"hat" "coat" "dog" "cat" "oat" "cot" "hot" "hog"}) (word-chain #{"cot" "hot" "bat" "fat"}) (word-chain #{"spout" "do" "pot" "pout" "spot" "dot"}) (word-chain #{"cart" "bat" "cat"}) ;; hypirion's solution: (letfn [(leven [[fa & ra :as a] [fb & rb :as b]] (cond (nil? a) (count b) (nil? b) (count a) (= fa fb) (leven ra rb) :else (+ 1 (min (leven ra rb) (leven a rb) (leven ra b))))) (rem-disj [ht e] [(dissoc ht e) (ht e)]) (walkable? [[ht elts]] (if (empty? ht) true (let [walks (for [n-e elts :when (ht n-e)] (walkable? (rem-disj ht n-e)))] (some true? walks))))] (fn [st] (let [ht (apply merge-with concat (for [a st, b st :when (= 1 (leven a b))] {a [b]}))] (or (some #(walkable? (rem-disj ht %)) st) false)))) ;; chouser's solution (fn [s] (or (some (fn [w] ((fn f [a s] (or (empty? s) (some #(if (loop [[a & b :as c] (seq a) [d & e :as g] (seq %)] (if (= a d) (recur b e) (or (= b e) (= b g) (= c e)))) (f % (disj s %))) s))) w (disj s w))) s) false) ;; Sons and Daughters ;; If parents stop after their first daughter what's the proportion ;; of girls/boys in the population? (fn [n] (let [children (take n (repeatedly (fn [] (conj (take-while #(= 0 %) (repeatedly #(rand-int 2))) 1)))) sons_daughters (group-by identity (apply concat children))] [(count (sons_daughters 0)) (count (sons_daughters 1))] )) ;; 83 Half Truth (fn [& bs] (let [trues (count (filter true? bs))] (and (not (zero? trues)) (< trues (count bs))))) ;; 84 Transitive Closure (fn tc ([rels] (tc (seq rels) rels)) ([[rel & rrels] clos] (if (nil? rel) clos (let [[lrel rrel] rel new-pairs (for [[l r] clos :when (= rrel l)] [lrel r])] (recur rrels (into clos new-pairs)))))) (let [more-legs #{["cat" "man"] ["man" "snake"] ["spider" "cat"]}] (tc more-legs)) ;; 85 Power Set (fn power-set [s] (if (empty? s) #{#{}} (let [without-fs (power-set (rest s))] (into #{} (concat without-fs (map #(set (cons (first s) %)) without-fs)))))) ;; jafingerhut's solution (fn [s] (reduce (fn [power-set x] (into power-set (map #(conj % x) power-set))) #{#{}} s)) ;; 86 Happy numbers (fn [n] (loop [n n, nums #{}] (cond (= n 1) true (some #(= n %) (rest nums)) false :else (recur (reduce (fn [acc d] (let [i (read-string d)] (+ acc (* i i)))) 0 (re-seq #"\d" (str n))) (conj nums n))))) ;; 88 Symmetric difference ;; The symmetric difference is the union - intersection of the two sets (fn [s1 s2] (clojure.set/union (clojure.set/difference s1 s2) (clojure.set/difference s2 s1))) ;; 89 Graph Tour ;; A graph has an Eulerian path if it's connected ;; and at most have two nodes with odd degree (fn [g] ;; gt (letfn [(degrees [h] (reduce (fn [nodes [e1 e2]] (let [c1 (or (nodes e1) 0) c2 (or (nodes e2) 0)] (if (= e1 e2) nodes (assoc nodes e1 (inc c1) e2 (inc c2))))) {} h))] (let [d (degrees g)] (and (not (empty? d)) (->> (vals d) (filter odd?) count (>= 2)))))) (gt [[:a :b] [:a :b] [:a :c] [:c :a] [:a :d] [:b :d] [:c :d]]) (gt [[1 2] [2 3] [3 4] [4 1]]) (gt [[:a :b] [:a :c] [:c :b] [:a :e] [:b :e] [:a :d] [:b :d] [:c :e] [:d :e] [:c :f] [:d :f]]) ;; 90 Cartesian product (fn [s1 s2] (set (for [a s1 b s2] [a b]))) ;; 156 Map Defaults (fn [k vs] (into {} (for [v vs] [v k]))) ;; 99 Product Digits (fn [a b] (map read-string (re-seq #"\d" (str (* a b))))) ;; 91 Graph connectivity ;; Take any node (so, the first, e.g) and collect ;; all the nodes that are available from it (fn [g] (let [nodes (reduce (fn [vs [u v]] (conj vs u v)) #{} g)] (loop [us [(first nodes)] reached #{(first nodes)}] (let [newly-reached (for [u us [a b] g :let [x (cond (= u a) b (= u b) a)] :when (and x (not (reached x)))] x)] (if (empty? newly-reached) (= reached nodes) (recur newly-reached (into reached newly-reached))))))) ;; 92 Roman Numerals (fn [rom] (let [abc [["CM" 900] ["CD" 400], ["XC" 90], ["XL" 40], ["IX" 9], ["IV" 4], ["M" 1000], ["D" 500], ["C" 100], ["L" 50], ["X" 10], ["V" 5], ["I" 1]] starts-with? (fn [s t] (and (>= (count s) (count t)) (= (subs s 0 (count t)) t)))] (loop [rom rom, a 0] (if (empty? rom) a (let [[r v] (some (fn [[rl _ :as rp]] (and (starts-with? rom rl) rp)) abc)] (recur (apply str (drop (count r) rom)) (+ a v))))))) (rn "DCCCXXVII") ;; 93 Partially Flatten a Sequence (fn f [[fsq & rsq :as sq]] (cond (not (seq sq)) nil (and (sequential? sq) (not (sequential? fsq))) [sq] :else (concat (f fsq) (f rsq)))) ;; jafingerhut's solution: (fn [c] (filter #(and (sequential? %) (not (sequential? (first %)))) (tree-seq sequential? seq c))) ;; chouser's solution: ;; i is going to be the first of x (fn f [[i :as x]] (if (coll? i) (mapcat f x) [x])) (pfs [[[[:a :b]]] [[:c :d]] [:e :f]]) (pfs '((1 2)((3 4)((((5 6))))))) ;; 94 Game of Life (fn [board] (letfn [(to-living [brd] (into #{} (for [x (range) :while (< x (count brd)) y (range) :while (< y (count (brd x))) :when (= \# (get (brd x) y))] [x y]))) (to-board [n living] (for [r (range n)] (apply str (for [c (range n)] (if (living [r c]) \# \space))))) ;; neighbors and step are copied verbatim from C. Legrand's solution ;; http://clj-me.cgrand.net/2011/08/19/conways-game-of-life/ (neighbours [[x y]] (for [dx [-1 0 1] dy (if (zero? dx) [-1 1] [-1 0 1])] [(+ dx x) (+ dy y)])) (step [cells] (set (for [[loc n] (frequencies (mapcat neighbours cells)) :when (or (= n 3) (and (= n 2) (cells loc)))] loc)))] (to-board (count board) (step (to-living board))))) (gol [" " " ## " " ## " " ## " " ## " " "]) ;; 95 To Tree, or not to Tree (fn t? [[v l r :as t]] (and (= (count t) 3) (every? #(or (nil? %) (and (coll? %) (t? %))) [l r]))) ;; 96 Beauty is Symmetry (fn [[_ left right]] (letfn [(symm? [[lv ll lr :as l] [rv rl rr :as r]] (or (and (nil? l) (nil? r)) (and (= lv rv) (symm? ll rr) (symm? lr rl))))] (symm? left right))) ;; 97 Pascal's Triangle (fn [n] (letfn [(pt [] (iterate (fn [r] (map #(apply + %) (partition 2 1 (concat [0] r [0])))) [1]))] (->> (pt) (take n) (last)))) ;; 98 Equivalence classes (fn [f d] (set (map set (vals (group-by f d))))) ;; 100 Least Common Multiple (fn [& ys] (letfn [(gcd1 [a b] (if (zero? (rem a b)) b (gcd1 b (rem a b)))) (gcd [xs] (reduce gcd1 xs))] (/ (apply * ys) (gcd ys)))) ;; 101 Levenshtein Distance (fn lev [[ha & ra :as a] [hb & rb :as b]] (cond (> (count a) (count b)) (lev b a) (nil? ha) (count b) (= ha hb) (lev ra rb) :else (inc (min (lev ra rb) (lev a rb))))) (defn rand-char [] (char (+ (rand-int 26) 97))) (defn rand-word [n] (reduce str (repeatedly n rand-char))) ;; Stack Overflow (leven (rand-word 10000) (rand-word 10000)) ;; 102 intoCamelCase (fn [w] (let [[h & r] (clojure.string/split w #"-")] (clojure.string/join "" (cons h (map clojure.string/capitalize r))))) ;; 103 Generating k-combinations (defn k-comb [k S] (if (zero? k) #{#{}} (set (mapcat (fn [e] (map (fn [t] (conj t e)) (k-comb (dec k) (disj S e)))) S)))) ;; hypirion's solution ;; Ingenious! In the i. loop takes out all the possible elements of the ;; original set (elt init in the for loop) produced ;; from all the possible sets of i+1 n-1 elements (def k-comb (fn ([n init] (let [i (- (count init) n)] (if (neg? i) #{} (loop [sets [init], i i] (println (str "i: " i)) (if (pos? i) (recur (for [elt init, set sets :when (contains? set elt)] (do (println set elt) (disj set elt))) (dec i)) (into #{} sets)))))))) ;; 104 Write Roman Numerals (fn [a] (let [abc { 1 ["I" "X" "C" "M"] 2 ["II" "XX" "CC" "MM"] 3 ["III" "XXX" "CCC" "MMM"] 4 ["IV" "XL" "CD"] 5 ["V" "L" "D"] 6 ["VI" "LX" "DC"] 7 ["VII" "LXX" "DCC"] 8 ["VIII" "LXXX" "DCCC"] 9 ["IX" "XC" "CM"] 0 ["" "" "" ""] } digits (reverse (map read-string (re-seq #"." (str a))))] (->> digits (map-indexed (fn [i d] (get-in abc [d i]))) (reverse) (clojure.string/join "")))) ; 105. Identify keys and values (fn [c] (loop [[f & r] c, kvm {}] (if (nil? f) kvm (let [[vs l] (split-with (complement keyword?) r)] (recur l (assoc kvm f vs)))))) ; 106 Number Maze (fn [a b] (-> (some #(some (fn [p] (and (= (last p) b) p)) %) (iterate (fn [paths] (mapcat #(let [next-paths (vector (conj % (* 2 (last %))) (conj % (+ 2 (last %))))] (if (zero? (rem (last %) 2)) (conj next-paths (conj % (/ (last %) 2))) next-paths)) paths)) [[a]])) count)) ;; hypirion's solution (fn [start goal] (loop [hs #{start} i 1] (if (hs goal) i (recur (into #{} (mapcat (juxt #(+ % %) #(if (odd? %) (+ % %) (/ % 2)) #(+ % 2)) hs)) (+ i 1))))) ; chouser's solution #((fn r [i w] (if ((set w) %2) i (r (+ i 1) (for [i w f [* + /] :when (or (even? i) (not= f /))] (f i 2))))) 1 [%]) ; 108 Lazy Searching (fn [& colls] (letfn [(lazy-has [[f & r :as c] x] ; we know c is a lazy-seq that is increasing (if (< x f) false (or (= x f) (lazy-has r x)))) (all-has? [cs x] (reduce (fn [has c] (and has (lazy-has c x))) true cs))] (first (filter #(all-has? (rest colls) %) (first colls)) ))) ;(ls [1 2 3 4 5 6 7] [0.5 3/2 4 19]) ;(ls (range) (range 0 100 7/6) [2 3 5 7 11 13]) ;(ls (map #(* % % %) (range)) ;; perfect cubes ; (filter #(zero? (bit-and % (dec %))) (range)) ;; powers of 2 ; (iterate inc 20)) ; 110 Sequence of pronunciations (fn [s] (next (iterate #(mapcat (juxt count first) (partition-by identity %)) s))) ; 111 Crossword puzzle (def crwpzzl (fn [w board] (let [spots (mapcat #(clojure.string/split % #"#") (remove empty? (map #(clojure.string/replace % #"\s" "") (concat board (apply map str board)))))] (or (some #(and (= (count w) (count %)) (every? (fn [[box l]] (or (= box \_) (= box l))) (map vector % w))) spots) false)))) (crwpzzl "joy" ["c _ _ _" "d _ # e" "r y _ _"]) (crwpzzl "the" ["c _ _ _" "d _ # e" "r y _ _"]) ;; 112 Sequs Horribilis (fn sh [n coll] (loop [n n, [f & r :as c] coll, out []] (cond (coll? f) (conj out (sh n f)) (or (nil? f) (> f n)) out :else (recur (- n f) r (conj out f))))) (sh 10 [1 2 [3 [4 5] 6] 7]) (sh 30 [1 2 [3 [4 [5 [6 [7 8]] 9]] 10] 11]) (sh 9 (range)) (sh 1 [[[[[1]]]]]) ;;; 113 Making Data Dance (fn [& xs] (reify CharSequence (toString [this] (apply str (interpose ", " (sort xs)))) clojure.lang.Seqable (seq [this] (if (empty? xs) nil (distinct xs))))) (fn [n p s] (loop [n n, p p, [fs & rs] s, q []] (if (or (nil? s) (and (p fs) (= n 1))) q (recur (if (p fs) (dec n) n) p rs (conj q fs))))) (gtw 4 #(= 2 (mod % 3)) [2 3 5 7 11 13 17 19 23]) (gtw 3 #(some #{\i} %) ["this" "is" "a" "sentence" "i" "wrote"]) (gtw 1 #{"a"} ["this" "is" "a" "sentence" "i" "wrote"]) ;jafingerhut's solution: (fn take-while [n p s] (lazy-seq (when-let [[x & xs] (seq s)] (let [n (- n (if (p x) 1 0))] (if (pos? n) (cons x (take-while n p xs))))))) ;; 115 Balance of N (fn [n] (let [digits (re-seq #"." (str n)) cnt (count digits) fh (take (quot cnt 2) digits) sh (drop (if (even? cnt) (quot cnt 2) (inc (quot cnt 2))) digits) sum (fn [ds] (apply + (map read-string ds)))] (= (sum fh) (sum sh)))) ;; 116 Prime Sandwich (fn [n] (letfn [(prime? [p] (and (>= p 2) (or (= p 2) (every? #(> (rem p %) 0) (range 2 (inc (quot p 2)))))))] (and (> n 2) (prime? n) (let [p1 (first (filter prime? (iterate dec (dec n)))) p2 (first (filter prime? (iterate inc (inc n))))] (== n (/ (+ p1 p2) 2)))))) (psnd 563) (nth (filter psnd (range)) 15) ;; chouser's solution: #(first (for [o (range 1 (- % 2)) [a b c] [(for [x [(- % o) (+ % o) %]] (every? (fn [b] (> (rem x b) 0)) (range 2 x)))] :when (or a b)] ;; the 'when' is here so that it is only emitted if either(?) is prime, otherwise the 'first' at the beginning would run the whole thing (and a b c))) ;; 117 For Science! ;; Find all possible spaces where mouse can move ;; If no new cells can be reached, the poor mouse starves (fn [mz] (let [cols (count (first mz)) rows (count mz) maze-cell-indexes (for [y (range rows) x (range cols)] [y x]) find (fn [elt] (first (filter (fn [[x y]] (= (get-in mz [x y]) elt)) maze-cell-indexes))) mouse (find \M) cheese (find \C) neighbors (memoize (fn [[x y]] (for [[dx dy] [[0 -1] [-1 0] [1 0] [0 1]] :let [nx (+ x dx) ny (+ y dy)] :when (and (< -1 nx rows) (< -1 ny cols) (not= (get-in mz [nx ny]) \#))] [nx ny])))] (loop [reached #{mouse}] (if (reached cheese) true (let [newly-reached (into reached (mapcat neighbors reached))] (if (= newly-reached reached) false (recur newly-reached))))))) ;; 118 Reimplement map (fn collect [f [fs & rs]] (lazy-seq (if (nil? fs) nil (cons (f fs) (collect f rs))))) ;; 119 Win at Tic-Tac-Toe (fn [elt b] (let [win-lines (map #(into #{} %) (mapcat #(partition 3 %) (concat ((juxt (partial map first) (partial map last)) (for [x (range 3) y (range 3)] [[x y] [y x]])) [[[0 0] [1 1] [2 2]] [[0 2] [1 1] [2 0]]]) )) win? (fn [e brd] (some #(every? (fn [f] (= e f)) (map (fn [cell] (get-in brd cell)) %)) win-lines) )] (set (filter #(and (= :e (get-in b %)) (win? elt (assoc-in b % elt))) (for [x (range 3) y (range 3)] [x y]))))) (ttt ::x [[:o :e :e] [:o :x :o] [:x :x :e]]) ;; hypirion's solution: (fn [p board] (let [win? #(let [b (concat % (apply map list %) ; columns [(map nth % (range)) (map nth (map reverse %) (range))])] ; lt-rb diagonal, rt-lb diagonal (some #{[p p p]} b))] (set (for [y (range 3) x (range 3) :when (and (= :e (get-in board [y x])) (win? (assoc-in board [y x] p)))] [y x])))) ;; 120 Sum of square of digits (fn [is] (-> (filter #(let [sumsq (reduce + (map (fn [d] (* (read-string d) (read-string d))) (re-seq #"." (str %))))] (< % sumsq)) is) count)) ;; 121 Universal Computation Engine (defn tur [form] (fn [values] (let [ops-vars (merge {'+ + '- - '* * '/ /} values)] ((fn eval- [f] (if (seq? f) (let [[f & args] f] (apply (ops-vars f) (map eval- args))) (get ops-vars f f))) form) ))) ((tur '(/ a b '{b 8 a 16}))) ((tur '(* (+ 2 a) (- 10 b))) '{a 1 b 8}) ;; 122 Read a binary number #(Integer/parseInt % 2) ;; 124 Analyze Reversi (fn [board p] (let [directions (for [x (range -1 2) y (range -1 2) :when (not (= 0 x y))] [x y]) crawl (fn [[sx sy :as s]] (iterate (fn [[x y]] (vector (+ x sx) (+ y sy))) s)) lines-from (fn [c] (for [d directions] (take-while (fn [[x y]] (and (< -1 x (count (first board))) (< -1 y (count board)))) (map (fn [[cx cy] [x y]] (vector (+ cx x) (+ cy y))) (repeat c) (crawl d)))))] (into {} (mapcat #(for [l (lines-from %) :let [firstp (get-in board (first l)) lastp (get-in board (last l))] :when (and (> (count l) 1) (= 'e lastp) (= (if (= p 'w) 'b 'w) firstp))] (vector (last l) (set (butlast l)))) (filter #(= p (get-in board %)) (for [y (range 4) x (range 4)] [x y]))) ))) (def board1 '[[e e e e] [e w b e] [e b w e] [e e e e]]) (reversi board1 'w) ;; 125 Gus' Quinundrum ; (40 115 116 114 32 34 40 102 110 42 32 91 93 32 40 108 101 116 32 91 99 111 100 101 32 91 34 32) ; (32 40 114 101 100 117 99 101 32 115 116 114 32 40 105 110 116 101 114 112 111 115 101 32 34 32 34 32 99 111 100 101 41 41 32) ; (34 93 34 32 40 97 112 112 108 121 32 115 116 114 32 40 102 111 114 32 91 105 32 99 111 100 101 93 32 40 99 104 97 114 32 105 41 41 41 41 41 41) (fn* [] (let [code [32 40 115 116 114 32 34 40 102 110 42 32 91 93 32 40 108 101 116 32 91 99 111 100 101 32 91 34 32 40 114 101 100 117 99 101 32 115 116 114 32 40 105 110 116 101 114 112 111 115 101 32 34 32 34 32 99 111 100 101 41 41 32 34 93 93 34 32 40 97 112 112 108 121 32 115 116 114 32 40 102 111 114 32 91 105 32 99 111 100 101 93 32 40 99 104 97 114 32 105 41 41 41 41 41 41]] (str "(fn* [] (let [code [" (reduce str (interpose " " code)) "]]" (apply str (for [i code] (char i)))))) ; dacquiri's solution: :) (fn [x] (str x x)) "(fn [x] (str x x))" ; 126 Through the Looking Glass java.lang.Class ; 127 Love Triangle ; Find the biggest mineral (isosceles triangle of just 1s) by attempting to draw ; triangles from each point as the vertex, in all 8 possible directions. ; This solution is quite similar to jafingerhut's, see his comments (fn ltr [t] (let [to-binary (fn [t l] (vec (for [r t] (->> (seq (Integer/toString r 2)) (iterate #(cons \0 %)) (drop-while #(< (count %) l)) first vec)))) mineral-in-dir (fn [rock a d s growth] (let [draw-line (fn [p slope length] (loop [p p, l length, line #{p}] (if (zero? l) line (recur (map + p slope) (dec l) (conj line p)))))] (loop [a a, l 1, mineral #{a}] (let [new-side (draw-line a s l)] (if (every? #(= \1 (get-in rock %)) new-side) (recur (map + a d) (+ l growth) (into mineral new-side)) (count mineral)))))) extract-mineral (fn [rock p] (apply max (map (fn [[d s g]] (mineral-in-dir rock p d s g)) [ [[1 0] [-1 1] 1], [[-1 0] [1 -1] 1], [[-1 0] [1 1] 1], [[1 0] [-1 -1] 1], [[-1 -1] [0 1] 2], [[1 1] [0 -1] 2], [[-1 -1] [1 0] 2], [[1 1] [-1 0] 2] ] )))] (let [cols (count (Integer/toString (apply max t) 2)) mineral-max-size (apply max (for [y (range (count t)) x (range cols)] (extract-mineral (to-binary t cols) [y x])))] (when (>= mineral-max-size 3) mineral-max-size)))) (ltr [18 7 14 14 6 3]) ; 128 Recognize Playing Cards (defn pc [card] (let [[s r] (re-seq #"." card)] {:suit ({"C" :club "D" :diamond "H" :heart "S" :spade} s), :rank ((into (reduce #(assoc % (str %2) (- %2 2)) {} (range 10)) {"T" 8, "J" 9, "Q" 10, "K" 11, "A" 12}) r) })) ; 130 Tree reparenting (fn reparen [x t] (letfn [(subtree [e [f & r :as tree]] (if (= f e) tree (some #(subtree e %) r))) (prune [e [f & r]] (if (= f e) nil (cons f (for [u r :let [st (prune e u)] :when st] st) ))) (parent [e [f & r]] (if (some #(= e (first %)) r) f (some #(parent e %) r)))] (if (= x (first t)) t (let [[subt pruned] ((juxt subtree prune) x t)] (concat subt [(reparen (parent x t) pruned)])) ))) ; 131 Sum Some Set Subsets ; reused my solution to the power-set problem (85) (fn ssss [& sets] (letfn [(power-set [s] (if (empty? s) #{#{}} (let [without-fs (power-set (rest s))] (into #{} (concat without-fs (map #(set (cons (first s) %)) without-fs))))))] (not (empty? (reduce clojure.set/intersection (map (fn [s] (into #{} (map #(apply + %) (filter seq (power-set s))))) sets))) ))) ; chouser's solution (fn [& s] (< 0 (count (reduce #(keep %2 %) (map (fn f [[x & s]] (into #{x} (if s (into (f s) (map #(+ x %) (f s))))))) (map seq n))))) ; 132 Insert between two items (fn [p v coll] (if (empty? coll) [] (cons (first coll) (mapcat (fn [[a b]] (if (p a b) [v b] [b])) (partition 2 1 coll))))) ; chouser's solution (fn [f t s] (mapcat #(cond (= %2 -) [%] (f % %2) [% t] 1 [%]) s (concat (next s) [-]))) ; 135 Infix calculator (fn [& tokens] (let [[[a o b] t] (split-at 3 tokens)] (reduce (fn [r [op x]] (op r x)) (o a b) (partition 2 t)))) ; 136 Squares squared (fn [p q] (let [dirs (mapcat #(repeat %2 %) (cycle [[1 1] [1 -1] [-1 -1] [-1 1]]) (cons 1 (mapcat #(repeat % %) (iterate inc 1)))) digits (apply str (take-while #(<= % q) (iterate #(* % %) p))) [max-digits sq-size] (first (drop-while (fn [[d s]] (> (count digits) d)) (map #(vector %1 %2) (map #(* % %) (iterate inc 2)) (iterate #(+ % 2) 3)))) spiral ((fn [digits dirs] (let [digits-in-center (inc (quot sq-size 2)) center-piece (if (zero? (rem digits-in-center 2)) (dec (quot sq-size 2)) (quot sq-size 2)) first-pos [center-piece (quot sq-size 2)]] (loop [[fdig & ndig] (next digits), [fd & nd] dirs, pos first-pos, sp {first-pos (first digits)}] (if (nil? fdig) sp (recur ndig nd (map + pos fd) (assoc sp (map + pos fd) fdig)) )))) (concat digits (repeat (- max-digits (count digits)) "*")) dirs)] (if (= 1 (count digits)) [digits] (into [] (for [y (range 0 sq-size)] (reduce str (for [x (range 0 sq-size)] (get spiral [y x] \space)))))))) ; I like jafingerhut's solution where he maps the coordinates (spiral above) ; starting from (0 0) and runs the for loops between (min-coords-x..max-coords-y) ; and likewise for y. This way there is no fiddling with getting the right coords ; as I did with center-piece, digits-in-center, etc. above ; ; 140 Veitch, please! ; My solution below is way too complicated. ; I first look for all possible covering minterms then I drop those that are included in a bigger one. ; I then take all possible combinations taking 1,2,3... of them and stop at the first one that covers ; all the original minterms. ; ; Converting back and forth between 0s, 1s and xs and letters is not needed, either and adds largely ; to code size. See austintaylor's elegant and concise solution after mine. (fn [table] (let [size (count (first table)) pow-2 (fn [n] (first (drop n (iterate #(* % 2) 1)))) to-letter-codes (fn [minterm] (for [i (range 0 size) :when (not= ((vec minterm) i) 'x)] (get-in [['a 'A] ['b 'B] ['c 'C] ['d 'D]] [i ((vec minterm) i)]))) values (into {} (map (fn [l n] (vector l n)) '(A B C D) (->> (iterate #(* % 2) 1) (take size) reverse))) val (fn [f] (reduce + (keep values f))) masks (fn masks [n k] ; n-long masks where k bits are set (cond (zero? k) [(repeat n 'x)] (= 1 n) [[0] [1]] :else (let [m' (masks (dec n) (dec k))] (concat (map #(cons 0 %) m') (map #(cons 1 %) m') (when (> n k) (map #(cons 'x %) (masks (dec n) k))))))) k-comb (fn k-comb [k S] (if (zero? k) #{#{}} (set (mapcat (fn [e] (map (fn [t] (conj t e)) (k-comb (dec k) (disj S e)))) S)))) to-bindigits (fn bd [x n] (let [pow2 (first (drop (dec n) (iterate #(* % 2) 1))) ; why (dec n)? d (quot x pow2)] (cond (zero? n) '() (= d 0) (cons 0 (bd x (dec n))) :else (cons 1 (bd (- x pow2) (dec n)))))) ones (map #(to-bindigits % size) (map val table)) matches? (fn [t mask] (every? identity (map (fn [bit mask-bit] (or (= 'x mask-bit) (= mask-bit bit))) t mask))) covers-less? (fn [m1 m2] (and (< (->> m1 (filter #(= % 'x)) count) (->> m2 (filter #(= % 'x)) count)) (reduce (fn [res [b1 b2]] (and res (if (not= 'x b2) (= b1 b2) true))) true (partition 2 (interleave m1 m2))))) eligible-masks (for [k (range 1 (inc size)) mask (masks size k) :let [matching-ones (filter #(matches? % mask) ones)] :when (= (count matching-ones) (pow-2 (- size k)))] [k mask (set matching-ones)]) final-masks (reduce (fn [ms [k m matching]] (let [k-masks (get ms k {})] (assoc ms k (assoc k-masks m (set matching))))) {} (remove (fn [[_ m1 _]] (some (fn [[_ m2 _]] (covers-less? m1 m2)) eligible-masks)) eligible-masks)) masks-with-at-most-k-fixed (fn [masks k] (reduce (fn [h k-masks] (reduce merge h k-masks)) {} (keep (fn [[n v]] (when (<= n k) v)) masks)))] (->> (mapcat #(let [possible-masks (masks-with-at-most-k-fixed final-masks %)] (for [l (range 1 (inc (count possible-masks))) chosen-masks (k-comb l (set (keys possible-masks))) :let [covered-minterms (reduce into (map possible-masks chosen-masks))]] [chosen-masks covered-minterms])) (range 1 (inc size))) (filter (fn [[masks covered-minterms]] (= covered-minterms (set ones)))) first first (map #(set (to-letter-codes %))) (into #{})))) ; austintaylor's solution (fn [sets] (let [ converge (fn [f x] (loop [x0 x x1 (f x)] (println x0 x1) (if (= x0 x1) x1 (recur x1 (f x1))))) opposite (fn [a b] (and (not= a b) (= (.toUpperCase (str a)) (.toUpperCase (str b))))) adjacent (fn [s0 s1] (let [d0 (apply disj s0 s1) d1 (apply disj s1 s0)] (and (= 1 (count d0)) (= 1 (count d1)) (opposite (first d0) (first d1))))) combine (fn [s0 s1] (disj s0 (first (apply disj s0 s1)))) covers (fn [ss] (every? (fn [s] (some #(empty? (apply disj % s)) ss)) sets)) remove-redundency (fn [ss] (let [options (for [s ss :let [new-ss (disj ss s)] :when (covers new-ss)] new-ss)] (if (empty? options) ss (first options)))) simplify (fn [sets] (let [segments (for [ s0 sets s1 sets :when (= (count s0) (count s1)) :when (adjacent s0 s1)] [s0 s1 (combine s0 s1)])] (reduce (fn [sets [s0 s1 sc]] ;(println [s0 s1 sc]) (disj (conj sets sc) s0)) sets segments)))] (remove-redundency (converge simplify sets)))) ; 164 Language of a DFA (fn [dfa-def] (for [paths-at-step (iterate (fn [paths] (mapcat (fn [[current-state path]] (map (fn [[letter new-state]] [new-state (str path letter)]) (get (:transitions dfa-def) current-state []))) paths)) [[(:start dfa-def) ""]]) :while (some #(seq %) paths-at-step) [s path] paths-at-step :when (get (:accepts dfa-def) s)] path)) ; 152 Latin Square Slicing (fn [V] (letfn [(latin-square [n r c] (let [elts (subvec (vec (V r)) c (+ c n)) max-length (apply max (map count V)) super-permutations? (fn [v1 v2] (and (= (set v1) (set v2)) (every? #(not= (nth v1 %) (nth v2 %)) (range 0 (count v1))))) ] (loop [row-index (inc r), square [elts]] (if (= n (count square)) square (let [row (V row-index)] (when-let [square-row (first (for [shift (range (max (- (count (V (dec row-index))) max-length) (- (count row) max-length)) (inc (- max-length (count row)))) :let [elts-in-row (when (and (contains? row (- c shift)) (contains? row (dec (+ n (- c shift))))) (subvec row (- c shift) (+ (- c shift) n)))] :when (and elts-in-row (every? #(super-permutations? elts-in-row %) square))] elts-in-row))] (recur (inc row-index) (conj square square-row)))))))) ] (->> (for [r (range 0 (dec (count V))) c (range 0 (dec (count (V r)))) n (range 2 (min (inc (- (count V) r)) (inc (- (count (V r)) c)))) :let [square (latin-square n r c)] :when square] {(count square) #{square}}) (apply merge-with (fn [squares-by-order squares-from-point] (apply conj squares-by-order squares-from-point))) (reduce (fn [squares [n squares-of-n]] (assoc squares n (count squares-of-n))) {}) ))) ; 137 Digits and Bases (fn [x r] (if (zero? x) [0] (loop [x x, digits []] (if (zero? x) (reverse digits) (let [[res rm] ((juxt #(quot % r) #(rem % r)) x)] (recur res (conj digits rm))))))) ; 141 Tricky card games (fn [trump] (fn [trick] (let [suit-order (if trump [(:suit (first trick)) trump] [(:suit (first trick))]) ] (reduce (fn [highest card] (cond (> (.indexOf suit-order (:suit card)) (.indexOf suit-order (:suit highest))) card (and (= (:suit highest) (:suit card)) (> (:rank card) (:rank highest))) card :else highest)) trick)))) ; 144 Oscilrate (fn oscilrate [v & fns] (map first (iterate (fn [[x i]] (let [next-x ((nth fns (rem i (count fns))) x)] [next-x (inc i)])) [v 0]))) ; chouser's solution #(reductions (fn [x f] (f x)) % (cycle %&)) ; 158 Decurry #(partial (fn decur [f & args] (let [a (first args), rargs (rest args)] (if (nil? a) f (apply decur (f a) rargs)))) %) ; hypirion's solution (fn [f] (fn [& args] (reduce #(%1 %2) f args))) ; 148 The Big Divide (fn [n a b] (let [sum-of-divisors (fn [c] (let [q (quot (dec n) c)] (/ (*' c q (inc q)) 2)))] (+ (sum-of-divisors a) (sum-of-divisors b) (- (sum-of-divisors (* a b)))))) ; 150 Palindromic Numbers ; Really ugly solution, for a nice one, see jafingerhut's (fn [n] (letfn [(parts [a] (let [s (vec (re-seq #"\d" (str a))) c (count s)] (vector (subvec s 0 (quot c 2)) (subvec s (quot c 2) (quot (inc c) 2))))) (to-number [half mirror] (let [h (if (zero? half) "" half)] (BigInteger. (str h mirror (reduce str (reverse (str h))))))) (digits [n] (count (str n))) (ten-power? [n] (re-find #"^10*$" (str n))) (pow-10 [n] (first (drop n (iterate #(* % 10) 1)))) (palindromes [half mirror] (lazy-seq (cond (= mirror 10) (if (ten-power? (inc half)) (palindromes (inc half) nil) (palindromes (inc half) 0)) (and mirror (not= mirror :no-mirror)) (cons (to-number half mirror) (palindromes half (inc mirror))) (ten-power? half) (if (nil? mirror) (cons (to-number half nil) (palindromes (inc half) :no-mirror)) (palindromes (quot half 10) 0)) :else (cons (to-number half nil) (palindromes (inc half) mirror)))))] (let [half (quot n (pow-10 (quot (digits n) 2))) ps (if (odd? (digits n)) (palindromes (quot half 10) (rem half 10)) (palindromes half nil)) ] (if (< (first ps) n) (drop 1 ps) ps)))) ; 171 Intervals (fn [args] ((fn make-interval [c] (let [adj (take-while (fn [[a b]] (= (inc a) b)) (partition 2 1 c))] (cond (empty? c) [] (empty? adj) (cons [(first c) (first c)] (make-interval (next c))) :else (cons [(ffirst adj) (last (last adj))] (make-interval (drop (inc (count adj)) c)))))) (sort (set args)))) ; 168 Infinite Matrix (fn infinite-matrix ([f] (lazy-seq ((fn g [i] (lazy-seq (cons ((fn h [j] (lazy-seq (cons (f i j) (h (inc j))))) 0) (g (inc i))))) 0) )) ([f m n] ; Yes, you caught me, this is copied verbatim from clojure.core (let [dr (fn [n coll] (let [step (fn [n coll] (let [s (seq coll)] (if (and (pos? n) s) (recur (dec n) (rest s)) s)))] (lazy-seq (step n coll))))] (map #(dr n %) (dr m (infinite-matrix f))))) ([f m n s t] (map #(take t %) (take s (infinite-matrix f m n)))) ) ; 153 Pairwise Disjoint Sets (fn [sets] (loop [[fs & rs] (seq sets), elts #{}] (if (nil? fs) true (if (some #(some (fn [e] (= % e)) elts) fs) false (recur rs (clojure.set/union elts (set fs))))))) ; chouser's solution: #(let [s (for [x % i x] i)] (= (count s) (count (set s))))