· 9 years ago · Oct 10, 2016, 12:52 AM
1;; gorilla-repl.fileformat = 1
2
3;; **
4;;; # Gorilla REPL
5;;;
6;;; Welcome to gorilla :-)
7;;;
8;;; Shift + enter evaluates code. Hit alt+g twice in quick succession or click the menu icon (upper-right corner) for more commands ...
9;;;
10;;; It's a good habit to run each worksheet in its own namespace: feel free to use the declaration we've provided below if you'd like.
11;; **
12
13;; @@
14(ns affectionate-smokescreen
15 (:require [gorilla-plot.core :as plot]))
16;; @@
17;; =>
18;;; {"type":"html","content":"<span class='clj-nil'>nil</span>","value":"nil"}
19;; <=
20
21;; @@
22;;Difficulty: Easy
23;;Topics: seqs
24
25(defn pen [coll] ((comp first rest reverse) coll))
26
27;;Write a function which returns the second to last element from a sequence.
28(= (pen (list 1 2 3 4 5)) 4)
29(= (pen ["a" "b" "c"]) "b")
30(= (pen [[1 2] [3 4]]) [1 2])
31;; @@
32;; =>
33;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
34;; <=
35
36;; @@
37;;Difficulty: Easy
38;;Topics: seqs core-functions
39
40(defn nth* [coll n]
41 (if (= n 0) (first coll) (recur (rest coll) (dec n))))
42
43;; Write a function which returns the Nth element from a sequence.
44(= (nth* '(4 5 6 7) 2) 6)
45(= (nth* [:a :b :c] 0) :a)
46(= (nth* [1 2 3 4] 1) 2)
47(= (nth* '([1 2] [3 4] [5 6]) 2) [5 6])
48(= (nth* '([1 2] [3 4] [5 6]) 2) [5 6])
49;; @@
50;; =>
51;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
52;; <=
53
54;; @@
55;; Difficulty: Easy
56;; Topics: seqs core-functions
57
58(defn cnt [coll]
59 (letfn [(mycount [coll cnt]
60 (if (empty? coll)
61 cnt
62 (recur (rest coll) (inc cnt))))]
63 (mycount coll 0)))
64
65;; Write a function which returns the total number of elements in a sequence.
66(= (cnt '(1 2 3 3 1)) 5)
67(= (cnt "Hello World") 11)
68(= (cnt [[1 2] [3 4] [5 6]]) 3)
69(= (cnt '(13)) 1)
70(= (cnt '(:a :b :c)) 3)
71;; @@
72;; =>
73;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
74;; <=
75
76;; @@
77
78;;Difficulty: Easy
79;; Topics: seqs
80
81(def sum (partial reduce +))
82
83;;Write a function which returns the sum of a sequence of numbers.
84(= (sum [1 2 3]) 6)
85(= (sum (list 0 -2 5 5)) 8)
86(= (sum #{4 2 1}) 7)
87(= (sum '(0 0 -1)) -1)
88(= (sum '(1 10 3)) 14)
89;; @@
90;; =>
91;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
92;; <=
93
94;; @@
95;; Difficulty: Easy
96;; Topics: seqs
97
98(def odd (partial filter odd?))
99
100;; Write a function which returns only the odd numbers from a sequence.
101(= (odd #{1 2 3 4 5}) '(1 3 5))
102(= (odd [4 2 1 6]) '(1))
103(= (odd [2 2 4 6]) '())
104(= (odd [1 1 1 3]) '(1 1 1 3))
105;; @@
106;; =>
107;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
108;; <=
109
110;; @@
111;;Reverse a Sequence
112;;Difficulty: Easy
113;;Topics: seqs core-functions
114
115(defn rev [coll]
116 (apply conj nil coll))
117
118;;Write a function which reverses a sequence.
119(= (rev [1 2 3 4 5]) [5 4 3 2 1])
120(= (rev (sorted-set 5 7 2 7)) '(7 5 2))
121(= (rev [[1 2][3 4][5 6]]) [[5 6][3 4][1 2]])
122;; @@
123;; =>
124;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
125;; <=
126
127;; @@
128;;Palindrome Detector
129;;Difficulty: Easy
130;;Topics: seqs
131
132;;Write a function which returns true if the given sequence is a palindrome.
133
134;;Hint: "racecar" does not equal '(\r \a \c \e \c \a \r)
135
136(def pal #(= (seq %1) (reverse %1)))
137
138(false? (pal '(1 2 3 4 5)))
139(true? (pal "racecar"))
140(true? (pal [:foo :bar :foo]))
141(true? (pal '(1 1 3 3 1 1)))
142(false? (pal '(:a :b :c)))
143
144;; @@
145;; =>
146;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
147;; <=
148
149;; @@
150;;Fibonacci Sequence
151;;Difficulty: Easy
152;;Topics: Fibonacci seqs
153
154(defn fib [n]
155 (letfn [(fibs []
156 ((fn next-fib [a b]
157 (cons a (lazy-seq (next-fib b (+ a b)))))
158 0 1))]
159 (take n (rest (fibs)))))
160
161;;Write a function which returns the first X fibonacci numbers.
162(= (fib 3) '(1 1 2))
163(= (fib 6) '(1 1 2 3 5 8))
164(= (fib 8) '(1 1 2 3 5 8 13 21))
165;; @@
166;; =>
167;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
168;; <=
169
170;; @@
171;; Maximum value
172;;Difficulty: Easy
173;;Topics: core-functions
174
175
176;;Write a function which takes a variable number of parameters and returns the maximum value.
177
178(defn max* [& coll]
179 (reduce (fn [res x]
180 (if (> x res)
181 x
182 res))
183 (first coll)
184 (rest coll)))
185
186
187(= (max* 1 8 3 4) 8)
188(= (max* 30 20) 30)
189(= (max* 45 67 11) 67)
190(= (max* 45 67 11) 67)
191;; @@
192;; =>
193;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
194;; <=
195
196;; @@
197;; Get the Caps
198;; Difficulty: Easy
199;; Topics: strings
200
201;; Write a function which takes a string and returns a new string containing only the capital letters.
202
203(defn caps [s] (apply str (filter #(Character/isUpperCase %) s)))
204
205
206(= (caps "HeLlO, WoRlD!") "HLOWRD")
207(empty? (caps "nothing"))
208(= (caps "$#A(*&987Zf") "AZ")
209;; @@
210;; =>
211;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
212;; <=
213
214;; @@
215;; Duplicate a Sequence
216;; Difficulty: Easy
217;; Topics: seqs
218
219;; Write a function which duplicates each element of a sequence.
220
221(defn dup [coll] (apply concat (map (fn [a b] (list a b)) coll coll)))
222
223
224(= (dup [1 2 3]) '(1 1 2 2 3 3))
225(= (dup [:a :a :b :b]) '(:a :a :a :a :b :b :b :b))
226(= (dup [[1 2] [3 4]]) '([1 2] [1 2] [3 4] [3 4]))
227(= (dup [[1 2] [3 4]]) '([1 2] [1 2] [3 4] [3 4]))
228
229
230;; @@
231;; =>
232;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
233;; <=
234
235;; @@
236;; Intro to some
237;; Difficulty: Easy
238;; Topics:
239
240
241;; The some function takes a predicate function and a collection. It returns the first logical true value of (predicate x) where x is an item in the collection.
242
243(= 6 (some #{2 7 6} [5 6 7 8]))
244(= 6 (some #(when (even? %) %) [5 6 7 8]))
245;; @@
246;; =>
247;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
248;; <=
249
250;; @@
251;; Implement range
252;; Difficulty: Easy
253;; Topics: seqs core-functions
254
255(defn range* [start end]
256 (lazy-seq
257 (if (>= start end) nil
258 (cons start (range* (inc start) end)))))
259
260;; Write a function which creates a list of all integers in a given range.
261
262
263(= (range* 1 4) '(1 2 3))
264(= (range* -2 2) '(-2 -1 0 1))
265(= (range* 5 8) '(5 6 7))
266;; @@
267;; =>
268;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
269;; <=
270
271;; @@
272;; Compress a Sequence
273;; Difficulty: Easy
274;; Topics: seqs
275
276;;Write a function which removes consecutive duplicates from a sequence.
277
278(defn compress [coll]
279 (reduce (fn [res x]
280 (if (= (peek res) x)
281 res
282 (conj res x)))
283 []
284 coll))
285
286(= (apply str (compress "Leeeeeerrroyyy")) "Leroy")
287(= (compress [1 1 2 3 3 2 2 3]) '(1 2 3 2 3))
288(= (compress [[1 2] [1 2] [3 4] [1 2]]) '([1 2] [3 4] [1 2]))
289
290;; @@
291;; =>
292;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
293;; <=
294
295;; @@
296;; Factorial FunSolutions
297;; Difficulty: Easy
298;; Topics: math
299
300;; Write a function which calculates factorials.
301
302(defn fac [n]
303 (reduce * (range 1 (inc n))))
304
305(= (fac 1) 1)
306(= (fac 3) 6)
307(= (fac 5) 120)
308(= (fac 8) 40320)
309;; @@
310;; =>
311;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
312;; <=
313
314;; @@
315;; Interleave Two Seqs
316;; Difficulty: Easy
317;; Topics: seqs core-functions
318
319;;Write a function which takes two sequences and returns the first item from each, then the second item from each, then the third, etc.
320
321(defn interleave* [coll1 coll2]
322 (apply concat
323 (map (fn [a b] (list a b))
324 coll1 coll2)))
325
326(= (interleave* [1 2 3] [:a :b :c]) '(1 :a 2 :b 3 :c))
327(= (interleave* [1 2] [3 4 5 6]) '(1 3 2 4))
328(= (interleave* [1 2 3 4] [5]) [1 5])
329(= (interleave* [30 20] [25 15]) [30 25 20 15])
330;; @@
331;; =>
332;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
333;; <=
334
335;; @@
336;; Flatten a SequenceSolutions
337;; Difficulty: Easy
338;; Topics: seqs core-functions
339
340;; Write a function which flattens a sequence.
341
342(defn flat [coll]
343 (lazy-seq
344 (if (sequential? coll)
345 (apply concat (map flat coll))
346 (list coll))))
347
348(= (flat '((1 2) 3 [4 [5 6]])) '(1 2 3 4 5 6))
349(= (flat ["a" ["b"] "c"]) '("a" "b" "c"))
350(= (flat '((((:a))))) '(:a))
351;; @@
352;; =>
353;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
354;; <=
355
356;; @@
357;; Replicate a Sequence
358;; Difficulty: Easy
359;; Topics: seqs
360
361;; Write a function which replicates each element of a sequence a variable number of times.
362
363(defn rep [coll n]
364 (apply concat (map (fn [x] (repeat n x)) coll)))
365
366(= (rep [1 2 3] 2) '(1 1 2 2 3 3))
367(= (rep [:a :b] 4) '(:a :a :a :a :b :b :b :b))
368(= (rep [4 5 6] 1) '(4 5 6))
369(= (rep [[1 2] [3 4]] 2) '([1 2] [1 2] [3 4] [3 4]))
370(= (rep [44 33] 2) [44 44 33 33])
371
372;; @@
373;; =>
374;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
375;; <=
376
377;; @@
378;; Difficulty: Easy
379;; Topics: seqs
380
381
382;; The iterate function can be used to produce an infinite lazy sequence.
383(= '(1 4 7 10 13) (take 5 (iterate #(+ 3 %) 1)))
384
385;; @@
386;; =>
387;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
388;; <=
389
390;; @@
391;; Contain Yourself
392;; Difficulty: Easy
393;; Topics:
394
395(def sol 4)
396
397;;The contains? function checks if a KEY is present in a given collection. This often leads beginner clojurians to use it incorrectly with numerically indexed collections like vectors and lists.
398
399
400(contains? #{4 5 6} sol)
401(contains? [1 1 1 1 1] sol)
402(contains? {4 :a 2 :b} sol)
403(not (contains? [1 2 4] sol))
404
405
406
407;; @@
408;; =>
409;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
410;; <=
411
412;; @@
413;; Interpose a Seq
414;; Difficulty: Easy
415;; Topics: seqs core-functions
416
417
418;; Write a function which separates the items of a sequence by an arbitrary value.
419
420(defn ipose [x coll]
421 (lazy-seq
422 (if (empty? (rest coll))
423 (if (first coll) (list (first coll)) nil)
424 (cons (first coll) (cons x (ipose x (rest coll)))))))
425
426(= (ipose 0 [1 2 3]) [1 0 2 0 3])
427(= (apply str (ipose ", " ["one" "two" "three"])) "one, two, three")
428(= (ipose :z [:a :b :c :d]) [:a :z :b :z :c :z :d])
429(= (ipose :z [:a :b :c :d]) [:a :z :b :z :c :z :d])
430;; @@
431;; =>
432;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
433;; <=
434
435;; @@
436;; Pack a Sequence
437;; Difficulty: Easy
438;; Topics: seqs
439
440;; Write a function which packs consecutive duplicates into sub-lists.
441
442(def pack (partial partition-by identity))
443
444(= (pack [1 1 2 1 1 1 3 3]) '((1 1) (2) (1 1 1) (3 3)))
445(= (pack [:a :a :b :b :c]) '((:a :a) (:b :b) (:c)))
446(= (pack [[1 2] [1 2] [3 4]]) '(([1 2] [1 2]) ([3 4])))
447;; @@
448;; =>
449;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
450;; <=
451
452;; @@
453;; Drop Every Nth Item
454;; Difficulty: Easy
455;; Topics: seqs
456
457;;Write a function which drops every Nth item from a sequence.
458
459(defn drop-nth [coll n]
460 (apply concat (partition (dec n) n [] coll)))
461
462(= (drop-nth [1 2 3 4 5 6 7 8] 3) [1 2 4 5 7 8])
463(= (drop-nth [:a :b :c :d :e :f] 2) [:a :c :e])
464(= (drop-nth [1 2 3 4 5 6] 4) [1 2 3 5 6])
465
466
467
468;; @@
469;; =>
470;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
471;; <=
472
473;; @@
474;;Split a sequence
475;; Difficulty: Easy
476;; Topics: seqs core-functions
477
478(defn split [n coll]
479 (list (take n coll) (drop n coll)))
480
481;;Write a function which will split a sequence into two parts.
482(= (split 3 [1 2 3 4 5 6]) [[1 2 3] [4 5 6]])
483(= (split 1 [:a :b :c :d]) [[:a] [:b :c :d]])
484(= (split 2 [[1 2] [3 4] [5 6]]) [[[1 2] [3 4]] [[5 6]]])
485
486;; @@
487;; =>
488;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
489;; <=
490
491;; @@
492;; Advanced Destructuring
493;; Difficulty: Easy
494;; Topics: destructuring
495
496;; Here is an example of some more sophisticated destructuring.
497
498(def sol [1 2 3 4 5])
499
500(= [1 2 [3 4 5] [1 2 3 4 5]] (let [[a b & c :as d] sol] [a b c d]))
501;; @@
502;; =>
503;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
504;; <=
505
506;; @@
507;;Map Construction
508;;Difficulty: Easy
509;;Topics: core-functions
510
511;; Write a function which takes a vector of keys and a vector of values and constructs a map from them.
512
513(defn to-map [ks vs]
514 (into {} (map (fn [a b] [a b]) ks vs)))
515
516(= (to-map [:a :b :c] [1 2 3]) {:a 1, :b 2, :c 3})
517(= (to-map [1 2 3 4] ["one" "two" "three"]) {1 "one", 2 "two", 3 "three"})
518(= (to-map [:foo :bar] ["foo" "bar" "baz"]) {:foo "foo", :bar "bar"})
519;; @@
520;; =>
521;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
522;; <=
523
524;; @@
525;;Greatest Common Divisor
526;;;Difficulty: Easy
527;;Topics:
528
529;;Given two integers, write a function which returns the greatest common divisor.
530
531(defn gcd [x y]
532 (reduce (fn [gcd n]
533 (if (and (zero? (mod x n))
534 (zero? (mod y n)))
535 n
536 gcd))
537 (range 1 (inc (min x y)))))
538
539(= (gcd 2 4) 2)
540(= (gcd 10 5) 5)
541(= (gcd 5 7) 1)
542(= (gcd 1023 858) 33)
543;; @@
544;; =>
545;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
546;; <=
547
548;; @@
549;; Set Intersection
550;; Difficulty: Easy
551;; Topics: set-theory
552
553
554;; Write a function which returns the intersection of two sets. The intersection is the sub-set of items that each set has in common.
555
556(defn intersection [set1 set2]
557 (into #{} (filter #(set1 %) set2)))
558
559(= (intersection #{0 1 2 3} #{2 3 4 5}) #{2 3})
560(= (intersection #{0 1 2} #{3 4 5}) #{})
561(= (intersection #{:a :b :c :d} #{:c :e :a :f :d}) #{:a :c :d})
562;; @@
563;; =>
564;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
565;; <=
566
567;; @@
568;; Comparisons
569;; Difficulty: Easy
570;; Topics:
571
572;; For any orderable data type it's possible to derive all of the basic comparison operations (<, ≤, =, ≠, ≥, and >) from a single operation (any operator but = or ≠will work). Write a function that takes three arguments, a less than operator for the data and two items to compare. The function should return a keyword describing the relationship between the two items. The keywords for the relationship between x and y are as follows:
573;; x = y → :eq
574;; x > y → :gt
575;l x < y → :lt
576
577
578(defn cmp [cmp x y]
579 (cond (and (not (cmp x y))
580 (not (cmp y x)))
581
582 :eq
583
584 (cmp y x)
585 :gt
586
587 :else
588 :lt))
589
590(= :gt (cmp < 5 1))
591(= :eq (cmp (fn [x y] (< (count x) (count y))) "pear" "plum"))
592(= :lt (cmp (fn [x y] (< (mod x 5) (mod y 5))) 21 3))
593(= :gt (cmp > 0 2))
594
595;; @@
596;; =>
597;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
598;; <=
599
600;; @@
601;; Re-implement IterateSolutions
602;; Difficulty: Easy
603;; Topics: seqs core-functions
604
605
606;; 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.
607
608(defn iter [f x]
609 (lazy-seq
610 (cons x (iter f (f x)))))
611
612(= (take 5 (iter #(* 2 %) 1)) [1 2 4 8 16])
613(= (take 100 (iter inc 0)) (take 100 (range)))
614(= (take 9 (iter #(inc (mod % 3)) 1)) (take 9 (cycle [1 2 3])))
615
616;; @@
617;; =>
618;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
619;; <=
620
621;; @@
622;; Simple closures
623;; Difficulty: Easy
624;; Topics: higher-order-functions math
625
626
627;; Lexical scope and first-class functions are two of the most basic building blocks of a functional language like Clojure. When you combine the two together, you get something very powerful called lexical closures. With these, you can exercise a great deal of control over the lifetime of your local bindings, saving their values for use later, long after the code you're running now has finished.
628
629;; It can be hard to follow in the abstract, so let's build a simple closure. Given a positive integer n, return a function (f x) which computes xn. Observe that the effect of this is to preserve the value of n for use outside the scope in which it is defined.
630
631(def closure
632 (fn [n]
633 (fn [x]
634 (reduce * (repeat n x)))))
635
636
637(= 256 ((closure 2) 16),
638 ((closure 8) 2))
639(= [1 8 27 64] (map (closure 3) [1 2 3 4]))
640(= [1 2 4 8 16] (map #((closure %) 2) [0 1 2 3 4]))
641;; @@
642;; =>
643;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
644;; <=
645
646;; @@
647;; Cartesian Product
648;; Difficulty: Easy
649;; Topics: set-theory
650
651;;Write a function which calculates the Cartesian product of two sets.
652
653(defn cp [a b]
654 (into #{}
655 (for [x a
656 y b]
657 [x y])))
658
659
660(= (cp #{"ace" "king" "queen"} #{"♠" "♥" "♦" "♣"})
661 #{["ace" "♠"] ["ace" "♥"] ["ace" "♦"] ["ace" "♣"]
662 ["king" "♠"] ["king" "♥"] ["king" "♦"] ["king" "♣"]
663 ["queen" "♠"] ["queen" "♥"] ["queen" "♦"] ["queen" "♣"]})
664
665(= (cp #{1 2 3} #{4 5})
666 #{[1 4] [2 4] [3 4] [1 5] [2 5] [3 5]})
667
668(= 300 (count (cp (into #{} (range 10))
669 (into #{} (range 30)))))
670
671(= 300 (count (cp (into #{} (range 10))
672 (into #{} (range 30)))))
673;; @@
674;; =>
675;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
676;; <=
677
678;; @@
679;; Group a Sequence
680;; Difficulty: Easy
681;; Topics: core-functions
682
683
684;; 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.
685
686
687(defn group-by* [f coll]
688 (reduce (fn [ret x]
689 (update ret (f x) #(conj (or % []) x)))
690 {}
691 coll))
692
693(= (group-by* #(> % 5) [1 3 6 8]) {false [1 3], true [6 8]})
694(= (group-by* #(apply / %) [[1 2] [2 4] [4 6] [3 6]])
695 {1/2 [[1 2] [2 4] [3 6]], 2/3 [[4 6]]})
696(= (group-by* count [[1] [1 2] [3] [1 2 3] [2 3]])
697 {1 [[1] [3]], 2 [[1 2] [2 3]], 3 [[1 2 3]]})
698;; @@
699;; =>
700;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
701;; <=
702
703;; @@
704;;Symmetric Difference
705;;Difficulty: Easy
706;;Topics: set-theory
707
708;; 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.
709
710(defn sym-diff [s1 s2]
711 (clojure.set/union
712 (clojure.set/difference s1 s2)
713 (clojure.set/difference s2 s1)))
714
715(= (sym-diff #{1 2 3 4 5 6} #{1 3 5 7}) #{2 4 6 7})
716(= (sym-diff #{:a :b :c} #{}) #{:a :b :c})
717(= (sym-diff #{} #{4 5 6}) #{4 5 6})
718(= (sym-diff #{[1 2] [2 3]} #{[2 3] [3 4]}) #{[1 2] [3 4]})
719;; @@
720;; =>
721;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
722;; <=
723
724;; @@
725;;Read a binary number
726;;Difficulty: Easy
727;;Topics:
728
729;;Convert a binary number, provided in the form of a string, to its numerical value.
730
731;; TODO: make non-shitty.
732(defn read-binary [s]
733 (loop [ret 0 s s]
734 (cond
735 (empty? s) ret
736 (= (first s) \1)
737 (recur (+ ret (reduce * (repeat (dec (count s)) 2)))
738 (next s))
739 :else
740 (recur ret (next s)))))
741
742
743(= 0 (read-binary "0"))
744(= 7 (read-binary "111"))
745(= 8 (read-binary "1000"))
746(= 9 (read-binary "1001"))
747(= 255 (read-binary "11111111"))
748(= 1365 (read-binary "10101010101"))
749(= 65535 (read-binary "1111111111111111"))
750;; @@
751;; =>
752;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
753;; <=
754
755;; @@
756;; Infix Calculator
757;; Difficulty: Easy
758;; Topics: higher-order-functions math
759
760
761;; Your friend Joe is always whining about Lisps using the prefix notation for math. Show him how you could easily write a function that does math using the infix notation. Is your favorite language that flexible, Joe? Write a function that accepts a variable length mathematical expression consisting of numbers and the operations +, -, *, and /. Assume a simple calculator that does not do precedence and instead just calculates left to right.
762
763(defn f
764 ([x] x)
765 ([x o y & expr]
766 (apply f (o x y) expr)))
767
768(= 7 (f 2 + 5))
769(= 42 (f 38 + 48 - 2 / 2))
770(= 8 (f 10 / 2 - 1 * 2))
771(= 72 (f 20 / 2 + 2 + 4 + 8 - 6 - 10 * 9))
772;; @@
773;; =>
774;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
775;; <=
776
777;; @@
778;; Indexing Sequences
779;; Difficulty: Easy
780;; Topics: seqs
781
782
783;; Transform a sequence into a sequence of pairs containing the original elements along with their index.
784
785(defn indexed [coll]
786 (map vector coll (range)))
787
788(= (indexed [:a :b :c]) [[:a 0] [:b 1] [:c 2]])
789(= (indexed [0 1 3]) '((0 0) (1 1) (3 2)))
790(= (indexed [[:foo] {:bar :baz}]) [[[:foo] 0] [{:bar :baz} 1]])
791
792;; @@
793;; =>
794;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
795;; <=
796
797;; @@
798;; Re-implement MapSolutions
799;; Difficulty: Easy
800;; Topics: core-seqs
801
802
803;; Map is one of the core elements of a functional programming language. Given a function f and an input sequence s, return a lazy sequence of (f x) for each element x in s.
804
805(defn map* [f coll]
806 (lazy-seq
807 (when-not (empty? coll)
808 (cons (f (first coll)) (map* f (rest coll))))))
809
810(= [3 4 5 6 7]
811 (map* inc [2 3 4 5 6]))
812(= (repeat 10 nil)
813 (map* (fn [_] nil) (range 10)))
814(= [1000000 1000001]
815 (->> (map* inc (range))
816 (drop (dec 1000000))
817 (take 2)))
818;; @@
819;; =>
820;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
821;; <=
822
823;; @@
824;; Sum of square of digits
825;; Difficulty: Easy
826;; Topics: math
827
828
829;; Write a function which takes a collection of integers as an argument. Return the count of how many elements are smaller than the sum of their squared component digits. For example: 10 is larger than 1 squared plus 0 squared; whereas 15 is smaller than 1 squared plus 5 squared.
830
831(defn sum-of-squares [coll]
832 (letfn [(ss
833 ([n] (ss n 0))
834 ([n ret]
835 (let [r (rem n 10)
836 ret (+ ret (* r r))]
837 (if (< n 10) ret
838 (recur (quot n 10) ret)))))]
839 (count (filter (fn [n] (< n (ss n))) coll))))
840
841
842(= 8 (sum-of-squares (range 10)))
843(= 19 (sum-of-squares (range 30)))
844(= 50 (sum-of-squares (range 100)))
845(= 50 (sum-of-squares (range 1000)))
846;; @@
847;; =>
848;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
849;; <=
850
851;; @@
852;; Intro to Destructuring 2
853;; Difficulty: Easy
854;; Topics: Destructuring
855
856
857;; Sequential destructuring allows you to bind symbols to parts of sequential things (vectors, lists, seqs, etc.): (let [bindings* ] exprs*) Complete the bindings so all let-parts evaluate to 3.
858
859(= 3
860 (let [[f xs] [+ (range 3)]] (apply f xs))
861 (let [[[f xs] b] [[+ 1] 2]] (f xs b))
862 (let [[f xs] [inc 2]] (f xs)))
863;; @@
864;; =>
865;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
866;; <=
867
868;; @@
869;; Trees into tables
870;; Difficulty: Easy
871;; Topics: seqs maps
872
873
874;; Because Clojure's for macro allows you to "walk" over multiple sequences in a nested fashion, it is excellent for transforming all sorts of sequences. If you don't want a sequence as your final output (say you want a map), you are often still best-off using for, because you can produce a sequence and feed it into a map, for example.
875
876;; For this problem, your goal is to "flatten" a map of hashmaps. Each key in your output map should be the "path"1 that you would have to take in the original map to get to a value, so for example {1 {2 3}} should result in {[1 2] 3}. You only need to flatten one level of maps: if one of the values is a map, just leave it alone.
877
878;;1 That is, (get-in original [k1 k2]) should be the same as (get result [k1 k2])
879
880(defn tree-to-table [m]
881 (into {}
882 (for [[k v] m
883 [k2 v2] v]
884 [[k k2] v2])))
885
886
887(= (tree-to-table
888 '{a {p 1, q 2}
889 b {m 3, n 4}})
890 '{[a p] 1, [a q] 2
891 [b m] 3, [b n] 4})
892(= (tree-to-table
893 '{[1] {a b c d}
894 [2] {q r s t u v w x}})
895 '{[[1] a] b, [[1] c] d,
896 [[2] q] r, [[2] s] t,
897 [[2] u] v, [[2] w] x})
898(= (tree-to-table
899 '{m {1 [a b c] 3 nil}})
900 '{[m 1] [a b c], [m 3] nil})
901;; @@
902;; =>
903;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
904;; <=
905
906;; @@
907;; Difficulty: Medium
908;; Topics:
909
910
911;; A function f defined on a domain D induces an equivalence relation on D, as follows: a is equivalent to b with respect to f if and only if (f a) is equal to (f b). Write a function with arguments f and D that computes the equivalence classes of D with respect to f.
912
913(def eq-classes (comp set #(map set %) vals group-by*))
914
915(= (eq-classes #(* % %) #{-2 -1 0 1 2})
916 #{#{0} #{1 -1} #{2 -2}})
917(= (eq-classes #(rem % 3) #{0 1 2 3 4 5 })
918 #{#{0 3} #{1 4} #{2 5}})
919(= (eq-classes identity #{0 1 2 3 4})
920 #{#{0} #{1} #{2} #{3} #{4}})
921(= (eq-classes (constantly true) #{0 1 2 3 4})
922 #{#{0 1 2 3 4}})
923(= (eq-classes (constantly true) #{0 1 2 3 4})
924 #{#{0 1 2 3 4}})
925;; @@
926;; =>
927;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
928;; <=
929
930;; @@
931(defn oscilrate [init & fs]
932 (lazy-seq
933 (when fs
934 (cons init (apply oscilrate
935 ((first fs) init)
936 (rest fs))))))
937;; @@
938;; =>
939;;; {"type":"html","content":"<span class='clj-var'>#'user/oscilrate</span>","value":"#'user/oscilrate"}
940;; <=
941
942;; @@
943;; Oscilrate
944;; Difficulty: Medium
945;; Topics: sequences
946
947;; Write an oscillating iterate: a function that takes an initial value and a variable number of functions. It should return a lazy sequence of the functions applied to the value in order, restarting from the first function after it hits the end.
948
949(defn oscilrate [init & fs]
950 (letfn [(step
951 [init & fs]
952 (lazy-seq
953 (cons init
954 (when fs
955 (apply oscilrate
956 ((first fs) init)
957 (rest fs))))))]
958 (apply step
959 init
960 (apply concat
961 (repeat fs)))))
962
963;; Better solution is:
964(fn [init & fs]
965 (reductions (fn [a f] (reduced (f a))) init (cycle fs)))
966
967;; Reductions takes
968
969
970(= (take 3 (oscilrate 3.14 int double)) [3.14 3 3.0])
971(= (take 5 (oscilrate 3 #(- % 3) #(+ 5 %))) [3 0 5 2 7])
972(= (take 12 (oscilrate 0 inc dec inc dec inc)) [0 1 0 1 0 1 2 1 2 1 2 3])
973
974;; @@
975;; =>
976;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
977;; <=
978
979;; @@
980(sort #{-1 1 99})
981;; @@
982;; =>
983;;; {"type":"list-like","open":"<span class='clj-list'>(</span>","close":"<span class='clj-list'>)</span>","separator":" ","items":[{"type":"html","content":"<span class='clj-long'>-1</span>","value":"-1"},{"type":"html","content":"<span class='clj-long'>1</span>","value":"1"},{"type":"html","content":"<span class='clj-long'>99</span>","value":"99"}],"value":"(-1 1 99)"}
984;; <=
985
986;; @@
987(apply = (list 1 1 1))
988;; @@
989;; =>
990;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
991;; <=
992
993;; @@
994;;Sum Some Set Subsets
995;;Difficulty: Medium
996;;Topics: math
997
998
999;;Given a variable number of sets of integers, create a function which returns true iff all of the sets have a non-empty subset with an equivalent summation.
1000
1001(defn [& sets]
1002 (let [sorted (map sort sets)]
1003 (boolean (some (fn [& sums]
1004 (apply = sums))
1005 (for []))))
1006
1007
1008(= true (__ #{-1 1 99}
1009 #{-2 2 888}
1010 #{-3 3 7777})) ; ex. all sets have a subset which sums to zero
1011
1012(= false (__ #{1}
1013 #{2}
1014 #{3}
1015 #{4}))
1016
1017(= true (__ #{1}))
1018
1019(= false (__ #{1 -3 51 9}
1020 #{0}
1021 #{9 2 81 33}))
1022
1023(= true (__ #{1 3 5}
1024 #{9 11 4}
1025 #{-3 12 3}
1026 #{-3 4 -2 10}))
1027
1028(= false (__ #{-1 -2 -3 -4 -5 -6}
1029 #{1 2 3 4 5 6 7 8 9}))
1030
1031(= true (__ #{1 3 5 7}
1032 #{2 4 6 8}))
1033
1034(= true (__ #{-1 3 -5 7 -9 11 -13 15}
1035 #{1 -3 5 -7 9 -11 13 -15}
1036 #{1 -1 2 -2 4 -4 8 -8}))
1037
1038(= true (__ #{-10 9 -8 7 -6 5 -4 3 -2 1}
1039 #{10 -9 8 -7 6 -5 4 -3 2 -1}))
1040;; @@
1041
1042;; @@
1043(defn winner [trump]
1044 (let [ranks {:club 0
1045 :diamond 14
1046 :heart 28
1047 :spade 32}]
1048 (fn [cards]
1049 (->> cards
1050 (apply sorted-set-by
1051 (fn [a b]
1052 (> (+ (:rank a)
1053 (ranks (:suit a))
1054 (if (= (:suit a) trump) 44 0))
1055 (+ (:rank b)
1056 (ranks (:suit b))
1057 (if (= (:suit b) trump) 44 0)))))
1058 first))))
1059;; @@
1060;; =>
1061;;; {"type":"html","content":"<span class='clj-var'>#'user/winner</span>","value":"#'user/winner"}
1062;; <=
1063
1064;; @@
1065(sort [1 2 3 2])
1066;; @@
1067;; =>
1068;;; {"type":"list-like","open":"<span class='clj-list'>(</span>","close":"<span class='clj-list'>)</span>","separator":" ","items":[{"type":"html","content":"<span class='clj-long'>1</span>","value":"1"},{"type":"html","content":"<span class='clj-long'>2</span>","value":"2"},{"type":"html","content":"<span class='clj-long'>2</span>","value":"2"},{"type":"html","content":"<span class='clj-long'>3</span>","value":"3"}],"value":"(1 2 2 3)"}
1069;; <=
1070
1071;; @@
1072;; Tricky card games
1073;; Difficulty: Medium
1074;; Topics: game cards
1075
1076
1077;; In trick-taking card games such as bridge, spades, or hearts, cards are played in groups known as "tricks" - each player plays a single card, in order; the first player is said to "lead" to the trick. After all players have played, one card is said to have "won" the trick. How the winner is determined will vary by game, but generally the winner is the highest card played in the suit that was led. Sometimes (again varying by game), a particular suit will be designated "trump", meaning that its cards are more powerful than any others: if there is a trump suit, and any trumps are played, then the highest trump wins regardless of what was led.
1078
1079;;Your goal is to devise a function that can determine which of a number of cards has won a trick. You should accept a trump suit, and return a function winner. Winner will be called on a sequence of cards, and should return the one which wins the trick. Cards will be represented in the format returned by Problem 128, Recognize Playing Cards: a hash-map of :suit and a numeric :rank. Cards with a larger rank are stronger.
1080
1081
1082(defn winner [trump]
1083 (fn [[{lead-suit :suit} :as cards]]
1084 (println lead-suit)
1085 (->> cards
1086 (apply sorted-set-by
1087 (fn [a b]
1088 (> (+ (:rank a)
1089 (if (= (:suit a) lead-suit) 14 0)
1090 (if (= (:suit a) trump) 26 0))
1091 (+ (:rank b)
1092 (if (= (:suit b) lead-suit) 14 0)
1093 (if (= (:suit b) trump) 26 0)))))
1094 first)))
1095
1096
1097(let [notrump (winner nil)]
1098 (and (= {:suit :club :rank 9} (notrump [{:suit :club :rank 4}
1099 {:suit :club :rank 9}]))
1100 (= {:suit :spade :rank 2} (notrump [{:suit :spade :rank 2}
1101 {:suit :club :rank 10}]))))
1102
1103(= {:suit :club :rank 10} ((winner :club) [{:suit :spade :rank 2}
1104 {:suit :club :rank 10}]))
1105
1106(= {:suit :heart :rank 8}
1107 ((winner :heart) [{:suit :heart :rank 6} {:suit :heart :rank 8}
1108 {:suit :diamond :rank 10} {:suit :heart :rank 4}]))
1109;; @@
1110;; ->
1111;;; :club
1112;;; :spade
1113;;; :spade
1114;;; :heart
1115;;;
1116;; <-
1117;; =>
1118;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1119;; <=
1120
1121;; @@
1122;; Palindromic Numbers
1123;; Difficulty: Medium
1124;;; Topics: seqs math
1125
1126
1127;;A palindromic number is a number that is the same when written forwards or backwards (e.g., 3, 99, 14341).
1128
1129;; Write a function which takes an integer n, as its only argument, and returns an increasing lazy sequence of all palindromic numbers that are not less than n.
1130
1131;; The most simple solution will exceed the time limit!
1132
1133
1134;; My solution is below. Don't konw why its timing out
1135#_(defn pals [n]
1136 (let [even-digits? #(even? (count %))
1137 left-middle #(if (even-digits? %)
1138 (subs % 0 (quot (count % ) 2) )
1139 (subs % 0 (inc (quot (count % ) 2))))
1140 mirror (fn [[num dig]]
1141 (loop [a num r (if (= dig :even) num (quot num 10))]
1142 (if (= 0 r)
1143 a
1144 (recur (+ (* a 10) (mod r 10)) (quot r 10)))))
1145 init #(let [s (left-middle %)]
1146 (vector (Long/parseLong s)
1147 (if (even-digits? %) :even :odd)
1148 (long (Math/pow 10 (count s)))))
1149 nextp (fn [[num even goal]]
1150 (let [m (inc num)]
1151 (if (= m goal)
1152 (if (= even :even)
1153 [goal :odd (* 10 goal)]
1154 [(/ goal 10) :even goal])
1155 [m even goal] )))
1156 i (init (str n))
1157 palindromes (iterate nextp i) ]
1158 (filter (partial <= n ) (map mirror palindromes))))
1159
1160;; finishes on my machine in 300ms... idk
1161(defn pals [n]
1162 (letfn [(n->start [n]
1163 (loop [ret n mlt 10]
1164 (if (< ret mlt) ret
1165 (recur (/ (- ret (mod ret 10)) 10)
1166 (* mlt 10)))))
1167 (inc-order [n]
1168 (loop [ret 1 n n]
1169 (if (== n 0) ret
1170 (recur (* 10 ret) (quot n 10)))))
1171 (even-pal [n]
1172 (loop [ret n n n]
1173 (if (== n 0) ret
1174 (recur (+ (* 10 ret) (mod n 10)) (quot n 10)))))
1175 (odd-pal [n]
1176 (loop [ret n n (quot n 10)]
1177 (if (== n 0) ret
1178 (recur (+ (* 10 ret) (mod n 10)) (quot n 10)))))
1179 (even-pals [n]
1180 (for [x (range n (inc-order n))]
1181 (even-pal x)))
1182 (odd-pals [n]
1183 (for [x (range n (inc-order n))]
1184 (odd-pal x)))]
1185 (let [start (n->start n)
1186 digits (str n)]
1187 (drop-while #(< % n)
1188 (if (even? (count digits))
1189 (apply concat
1190 (for [x (iterate inc-order start)]
1191 (concat (even-pals x) (odd-pals x))))
1192 (apply concat
1193 (if (= start 0) (list 0) nil)
1194 (for [x (iterate inc-order (if (= start 0) 1 start))]
1195 (concat (odd-pals x) (even-pals x)))))))))
1196
1197(= (take 26 (pals 0))
1198 [0 1 2 3 4 5 6 7 8 9
1199 11 22 33 44 55 66 77 88 99
1200 101 111 121 131 141 151 161])
1201
1202(= (take 16 (pals 162))
1203 [171 181 191 202
1204 212 222 232 242
1205 252 262 272 282
1206 292 303 313 323])
1207
1208(= (take 6 (pals 1234550000))
1209 [1234554321 1234664321 1234774321
1210 1234884321 1234994321 1235005321])
1211
1212(= (first (pals (* 111111111 111111111)))
1213 (* 111111111 111111111))
1214
1215(= (set (take 199 (pals 0)))
1216 (set (map #(first (pals %)) (range 0 10000))))
1217
1218(= true
1219 (apply < (take 6666 (pals 9999999))))
1220
1221(= (nth (pals 0) 10101)
1222 9102019)
1223;; @@
1224;; =>
1225;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1226;; <=
1227
1228;; @@
1229;;Infinite Matrix
1230;;Difficulty: Medium
1231;;Topics: seqs recursion math
1232
1233
1234;;In what follows, m, n, s, t denote nonnegative integers, f denotes a function that accepts two arguments and is defined for all nonnegative integers in both arguments.
1235
1236;;In mathematics, the function f can be interpreted as an infinite matrix with infinitely many rows and columns that, when written, looks like an ordinary matrix but its rows and columns cannot be written down completely, so are terminated with ellipses. In Clojure, such infinite matrix can be represented as an infinite lazy sequence of infinite lazy sequences, where the inner sequences represent rows.
1237
1238;;Write a function that accepts 1, 3 and 5 arguments
1239
1240;; - with the argument f, it returns the infinite matrix A that has the entry in the i-th row and the j-th column equal to f(i,j) for i,j = 0,1,2,...;
1241;; - with the arguments f, m, n, it returns the infinite matrix B that equals the remainder of the matrix A after the removal of the first m rows and the first n columns;
1242;; - with the arguments f, m, n, s, t, it returns the finite s-by-t matrix that consists of the first t entries of each of the first s rows of the matrix B or, equivalently, that consists of the first s entries of each of the first t columns of the matrix B.
1243
1244
1245(defn infinite-matrix
1246 ([f] (letfn [(inf-range
1247 ([idx]
1248 (lazy-seq
1249 (cons idx (inf-range (inc idx)))))
1250 ([]
1251 (inf-range 0)))]
1252 (map (fn [column]
1253 (map (fn [row] (f column row))
1254 (inf-range)))
1255 (inf-range))))
1256 ([f m n]
1257 (let [mat (infinite-matrix f)
1258 my-drop
1259 (fn [n coll]
1260 (if (pos? n)
1261 (recur (dec n) (rest coll))
1262 coll))]
1263 (lazy-seq (my-drop m (map #(my-drop n %) mat)))))
1264 ([f m n s t]
1265 (let [mat (infinite-matrix f m n)]
1266 (take s (map #(take t %) mat)))))
1267
1268
1269(= (take 6 (map #(take 5 %) (infinite-matrix str 3 2)))
1270 [["32" "33" "34" "35" "36"]
1271 ["42" "43" "44" "45" "46"]
1272 ["52" "53" "54" "55" "56"]
1273 ["62" "63" "64" "65" "66"]
1274 ["72" "73" "74" "75" "76"]
1275 ["82" "83" "84" "85" "86"]])
1276
1277(= (infinite-matrix * 3 5 5 7)
1278 [[15 18 21 24 27 30 33]
1279 [20 24 28 32 36 40 44]
1280 [25 30 35 40 45 50 55]
1281 [30 36 42 48 54 60 66]
1282 [35 42 49 56 63 70 77]])
1283
1284(= (infinite-matrix #(/ % (inc %2)) 1 0 6 4)
1285 [[1/1 1/2 1/3 1/4]
1286 [2/1 2/2 2/3 1/2]
1287 [3/1 3/2 3/3 3/4]
1288 [4/1 4/2 4/3 4/4]
1289 [5/1 5/2 5/3 5/4]
1290 [6/1 6/2 6/3 6/4]])
1291
1292(= (class (infinite-matrix (juxt bit-or bit-xor)))
1293 (class (infinite-matrix (juxt quot mod) 13 21))
1294 (class (lazy-seq)))
1295
1296(= (class (nth (infinite-matrix (constantly 10946)) 34))
1297 (class (nth (infinite-matrix (constantly 0) 5 8) 55))
1298 (class (lazy-seq)))
1299
1300(= (let [m 377 n 610 w 987
1301 check (fn [f s] (every? true? (map-indexed f s)))
1302 row (take w (nth (infinite-matrix vector) m))
1303 column (take w (map first (infinite-matrix vector m n)))
1304 diagonal (map-indexed #(nth %2 %)
1305 (infinite-matrix vector m n w w))]
1306 (and (check #(= %2 [m %]) row)
1307 (check #(= %2 [(+ m %) n]) column)
1308 (check #(= %2 [(+ m %) (+ n %)]) diagonal)))
1309 true)
1310;; @@
1311;; =>
1312;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1313;; <=
1314
1315;; @@
1316;; Parentheses... Again
1317;; Difficulty: Medium
1318;; Topics: math combinatorics
1319
1320
1321;; In a family of languages like Lisp, having balanced parentheses is a defining feature of the language. Luckily, Lisp has almost no syntax, except for these "delimiters" -- and that hardly qualifies as "syntax", at least in any useful computer programming sense.
1322
1323;; It is not a difficult exercise to find all the combinations of well-formed parentheses if we only have N pairs to work with. For instance, if we only have 2 pairs, we only have two possible combinations: "()()" and "(())". Any other combination of length 4 is ill-formed. Can you see why?
1324
1325;; Generate all possible combinations of well-formed parentheses of length 2n (n pairs of parentheses). For this problem, we only consider '(' and ')', but the answer is similar if you work with only {} or only [].
1326
1327;;There is an interesting pattern in the numbers!
1328
1329
1330(defn parens
1331 ([n]
1332 (set (parens n n [])))
1333 ([l r ret]
1334 (cond (= r 0) (list (apply str ret))
1335 (> l 0) (concat (parens (dec l) r (conj ret \())
1336 (when (> r l)
1337 (parens l (dec r) (conj ret \)))))
1338 :else (parens l (dec r) (conj ret \))))))
1339
1340
1341(= [#{""} #{"()"} #{"()()" "(())"}] (map (fn [n] (parens n)) [0 1 2]))
1342
1343(= #{"((()))" "()()()" "()(())" "(())()" "(()())"} (parens 3))
1344
1345(= 16796 (count (parens 10)))
1346
1347(= (nth (sort (filter #(.contains ^String % "(()()()())") (parens 9))) 6) "(((()()()())(())))")
1348
1349(= (nth (sort (parens 12)) 5000) "(((((()()()()()))))(()))")
1350
1351
1352
1353;; @@
1354;; =>
1355;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1356;; <=
1357
1358;; @@
1359;; Longest Increasing Sub-Seq
1360;; Difficulty: Hard
1361;; Topics: seqs
1362
1363
1364;; 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.
1365
1366(defn lis [coll]
1367 (letfn [(rf [[current longest] e]
1368 (if (= (dec e) (peek current))
1369 (let [current (conj current e)]
1370 [current (if (> (count current) (count longest))
1371 current
1372 longest)])
1373 [[e] longest]))]
1374 (get (reduce rf [[] []] coll) 1)))
1375
1376
1377(= (lis [1 0 1 2 3 0 4 5]) [0 1 2 3])
1378
1379(= (lis [5 6 1 3 2 7]) [5 6])
1380
1381(= (lis [2 3 3 4 5]) [3 4 5])
1382
1383(= (lis [7 6 5 4]) [])
1384;; @@
1385;; =>
1386;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1387;; <=
1388
1389;; @@
1390;; Analyze a Tic-Tac-Toe Board
1391;; Difficulty: Hard
1392;; Topics: game
1393
1394
1395;; 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.
1396
1397(defn solve [board]
1398 (letfn [(transpose [matrix]
1399 (apply mapv vector matrix))
1400 (trace [matrix]
1401 (mapv (fn [coll idx] (nth coll idx))
1402 matrix (range)))
1403 (rotate [coll]
1404 (conj (subvec coll 1) (first coll)))
1405 (rotate-n [coll n]
1406 ((apply comp (repeat n rotate)) coll))
1407 (symmetric-trace [matrix]
1408 (->>
1409 (trace
1410 [(rotate-n (first matrix) 2)
1411 (second matrix)
1412 (rotate-n (last matrix) 1)])
1413 (conj [] (trace matrix))))]
1414 (let [x-win [:x :x :x]
1415 o-win [:o :o :o]]
1416 (if (or (contains? (set board) x-win)
1417 (contains? (set (transpose board)) x-win)
1418 (contains? (set (symmetric-trace board)) x-win))
1419 :x
1420 (if (or (contains? (set board) o-win)
1421 (contains? (set (transpose board)) o-win)
1422 (contains? (set (symmetric-trace board)) o-win))
1423 :o
1424 nil)))))
1425
1426(= nil (solve [[:e :e :e]
1427 [:e :e :e]
1428 [:e :e :e]]))
1429
1430(= :x (solve [[:x :e :o]
1431 [:x :e :e]
1432 [:x :e :o]]))
1433
1434(= :o (solve [[:e :x :e]
1435 [:o :o :o]
1436 [:x :e :x]]))
1437
1438(= nil (solve [[:x :e :o]
1439 [:x :x :e]
1440 [:o :x :o]]))
1441
1442(= :x (solve [[:x :e :e]
1443 [:o :x :e]
1444 [:o :e :x]]))
1445
1446(= :o (solve [[:x :e :o]
1447 [:x :o :e]
1448 [:o :e :x]]))
1449
1450(= nil (solve [[:x :o :x]
1451 [:x :o :x]
1452 [:o :x :o]]))
1453;; @@
1454;; =>
1455;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1456;; <=
1457
1458;; @@
1459;; Read Roman numerals
1460;; Difficulty: Hard
1461;; Topics: strings math
1462
1463
1464;; Roman numerals are easy to recognize, but not everyone knows all the rules necessary to work with them. Write a function to parse a Roman-numeral string and return the number it represents.
1465
1466;; 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.
1467
1468(defn roman-numeral [s]
1469 (let [table {\I 1 \V 5
1470 \X 10 \L 50
1471 \C 100 \D 500
1472 \M 1000}]
1473 (loop [s s ret 0]
1474 (if (empty? s) ret
1475 (let [x1 (first s)
1476 x2 (second s)]
1477 (cond (nil? x2)
1478 (+ ret (table x1))
1479
1480 (< (table x1) (table x2))
1481 (recur (next s)
1482 (- ret (table x1)))
1483
1484 :else
1485 (recur (next s)
1486 (+ ret (table x1)))))))))
1487
1488(= 14 (roman-numeral "XIV"))
1489
1490(= 827 (roman-numeral "DCCCXXVII"))
1491
1492(= 3999 (roman-numeral "MMMCMXCIX"))
1493
1494(= 48 (roman-numeral "XLVIII"))
1495;; @@
1496;; =>
1497;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1498;; <=
1499
1500;; @@
1501;; Triangle Minimal Path
1502;; Difficulty: Hard
1503;; Topics: graph-theory
1504
1505
1506;; Write a function which calculates the sum of the minimal path through a triangle. The triangle is represented as a collection 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.
1507
1508(defn min-path [triangle]
1509 (letfn [(walk
1510 [g i j]
1511 (if (= (inc i) (count g))
1512 ((g i) j)
1513 (+ ((g i) j) (min (walk g (inc i) j)
1514 (walk g (inc i) (inc j))))))]
1515 (walk (vec triangle) 0 0)))
1516
1517(= 7 (min-path '([1]
1518 [2 4]
1519 [5 1 4]
1520 [2 3 4 5]))) ; 1->2->1->3
1521
1522(= 20 (min-path '([3]
1523 [2 4]
1524 [1 9 3]
1525 [9 9 2 4]
1526 [4 6 6 7 8]
1527 [5 7 3 5 1 4]))) ; 3->4->3->2->7->1
1528;; @@
1529;; =>
1530;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1531;; <=
1532
1533;; @@
1534;; Transitive Closure
1535;; Difficulty: Hard
1536;; Topics: set-theory
1537
1538
1539;; Write a function which generates the transitive closure of a binary relation. The relation will be represented as a set of 2 item vectors.
1540
1541(defn transitive-closure [rel]
1542 (let [nxt (into #{}
1543 (for [[x y1 :as r] rel
1544 [y2 z] rel]
1545 (if (= y1 y2) [x z] r)))]
1546 (if (= nxt rel) rel
1547 (recur nxt))))
1548
1549
1550(let [divides #{[8 4] [9 3] [4 2] [27 9]}]
1551 (= (transitive-closure divides)
1552 #{[4 2] [8 4] [8 2] [9 3] [27 9] [27 3]}))
1553
1554(let [more-legs
1555 #{["cat" "man"] ["man" "snake"] ["spider" "cat"]}]
1556 (= (transitive-closure more-legs)
1557 #{["cat" "man"] ["cat" "snake"] ["man" "snake"]
1558 ["spider" "cat"] ["spider" "man"] ["spider" "snake"]}))
1559
1560(let [progeny
1561 #{["father" "son"] ["uncle" "cousin"] ["son" "grandson"]}]
1562 (= (transitive-closure progeny)
1563 #{["father" "son"] ["father" "grandson"]
1564 ["uncle" "cousin"] ["son" "grandson"]}))
1565;; @@
1566;; =>
1567;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1568;; <=
1569
1570;; @@
1571;; Word Chains
1572;; Difficulty: Hard
1573;; Topics: seqs
1574
1575
1576;; 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:
1577
1578;; cat -> cot -> coat -> oat -> hat -> hot -> hog -> dog
1579
1580;; 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.
1581
1582(defn word-chain? [words]
1583 (letfn [(adjacent?
1584 ([a b] (adjacent? a b 0))
1585 ([a b dist]
1586 (cond (> dist 1) false
1587 (and (nil? a) (nil? b)) true
1588
1589 (= (first a) (first b))
1590 (adjacent? (next a) (next b) dist)
1591
1592 :else
1593 (or (adjacent? (next a) (next b) (inc dist))
1594 (adjacent? a (next b) (inc dist))
1595 (adjacent? (next a) b (inc dist))))))
1596
1597 (connected?
1598 [mat node]
1599 (letfn [(walk
1600 [node visits]
1601 (let [tgts (mat node)
1602 visits (conj visits node)
1603 unvisited (clojure.set/difference
1604 tgts visits)]
1605 (if (== (count words) (count visits)) true
1606 (some true? (map #(walk % visits)
1607 unvisited)))))]
1608 (walk node #{})))
1609
1610 (adjacency-mat
1611 [words]
1612 (reduce (fn [ret [a b]]
1613 (-> (update-in ret [a] conj b)
1614 (update-in [b] conj a)))
1615 (into {} (map #(vector % #{}) words))
1616 (for [i (range (count words))
1617 j (range (inc i) (count words))
1618 :let [a (words i)
1619 b (words j)]
1620 :when (adjacent? a b)]
1621 [a b])))]
1622 (let [words-vec (vec words)
1623 mat (adjacency-mat words-vec)]
1624 (boolean (some (partial connected? mat) words)))))
1625
1626
1627(= true (word-chain?
1628 #{"hat" "coat" "dog" "cat" "oat" "cot" "hot" "hog"}))
1629
1630(= false (word-chain? #{"cot" "hot" "bat" "fat"}))
1631
1632(= false (word-chain? #{"to" "top" "stop" "tops" "toss"}))
1633
1634(= true (word-chain? #{"spout" "do" "pot" "pout" "spot" "dot"}))
1635
1636(= true (word-chain? #{"share" "hares" "shares" "hare" "are"}))
1637
1638(= false (word-chain? #{"share" "hares" "hare" "are"}))
1639;; @@
1640;; =>
1641;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1642;; <=
1643
1644;; @@
1645;; Graph Connectivity
1646;; Difficulty: Hard
1647;; Topics: graph-theory
1648
1649
1650;; Given a graph, determine whether the graph is connected. A connected graph is such that a path exists between any two given nodes.
1651
1652;; -Your function must return true if the graph is connected and false otherwise.
1653
1654;; -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.
1655
1656;; -Each edge is undirected (can be traversed either direction).
1657
1658(defn connected? [edges]
1659 (let [nodes (set (apply concat edges))
1660 num-nodes (count nodes)
1661 adjacency-mat
1662 (reduce (fn [ret [x y :as edge]]
1663 (-> (update-in ret [x] conj y)
1664 (update-in [y] conj x)))
1665 (into {} (map vector nodes (repeat #{})))
1666 edges)
1667 walk
1668 (fn walk [visited node]
1669 (lazy-seq
1670 (let [neighbors (adjacency-mat node)
1671 visited (conj visited node)
1672 unvisited (clojure.set/difference neighbors visited)]
1673 (cond (= num-nodes (count visited)) (list true)
1674 (empty? unvisited) (list nil)
1675 :else
1676 (mapcat (partial walk visited) unvisited)))))]
1677 (boolean (some true? (walk #{} (first nodes))))))
1678
1679
1680(= true (connected? #{[:a :a]}))
1681
1682(= true (connected? #{[:a :b]}))
1683
1684(= false (connected? #{[1 2] [2 3] [3 1]
1685 [4 5] [5 6] [6 4]}))
1686
1687(= true (connected? #{[1 2] [2 3] [3 1]
1688 [4 5] [5 6] [6 4] [3 4]}))
1689
1690(= false (connected? #{[:a :b] [:b :c] [:c :d]
1691 [:x :y] [:d :a] [:b :e]}))
1692
1693(= true (connected? #{[:a :b] [:b :c] [:c :d]
1694 [:x :y] [:d :a] [:b :e] [:x :a]}))
1695;; @@
1696;; =>
1697;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1698;; <=
1699
1700;; @@
1701;; Game of Life
1702;; Difficulty: Hard
1703;; Topics: game
1704
1705
1706;; The game of life is a cellular automaton devised by mathematician John Conway.
1707
1708;; 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:
1709
1710;; 1) Any live cell with fewer than two live neighbours dies, as if caused by under-population.
1711;; 2) Any live cell with two or three live neighbours lives on to the next generation.
1712;; 3) Any live cell with more than three live neighbours dies, as if by overcrowding.
1713;; 4) Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.
1714
1715;; Write a function that accepts a board, and returns a board representing the next generation of cells.
1716
1717(defn game-of-life [world]
1718 (let [living (for [i (range (count world))
1719 j (range (count (world i)))
1720 :when (= (get-in world [i j]) \#)]
1721 [i j])
1722
1723 dead? (fn [cell]
1724 (= (get-in world cell) \space))
1725
1726 living? (fn [cell]
1727 (= (get-in world cell) \#))
1728
1729 neighbors (for [[i j] living
1730 k (range -1 2)
1731 l (range -1 2)
1732 :when (not (= k l 0))]
1733 [(+ i k) (+ j l)])
1734
1735 counts (reduce (fn [ret cell]
1736 (update-in ret [cell] #(inc (or % 0))))
1737 {}
1738 neighbors)
1739
1740 births (reduce (fn [world cell]
1741 (assoc-in world cell \#))
1742 (mapv vec world)
1743 (for [[cell cnt] counts
1744 :when (and (dead? cell) (= cnt 3))]
1745 cell))
1746
1747 deaths (reduce (fn [world cell]
1748 (assoc-in world cell \space))
1749 births
1750 (for [[cell cnt] counts
1751 :when (and (living? cell)
1752 (or (> cnt 3) (< cnt 2)))]
1753 cell))]
1754 (mapv #(apply str %) deaths)))
1755
1756(= (game-of-life
1757 [" "
1758 " ## "
1759 " ## "
1760 " ## "
1761 " ## "
1762 " "])
1763 [" "
1764 " ## "
1765 " # "
1766 " # "
1767 " ## "
1768 " "])
1769
1770(= (game-of-life
1771 [" "
1772 " "
1773 " ### "
1774 " "
1775 " "])
1776 [" "
1777 " # "
1778 " # "
1779 " # "
1780 " "])
1781
1782(= (game-of-life
1783 [" "
1784 " "
1785 " ### "
1786 " ### "
1787 " "
1788 " "])
1789 [" "
1790 " # "
1791 " # # "
1792 " # # "
1793 " # "
1794 " "])
1795
1796;; @@
1797;; =>
1798;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1799;; <=
1800
1801;; @@
1802;; Number Maze
1803;; Difficulty: Hard
1804;; Topics: numbers
1805
1806
1807;; Given a pair of numbers, the start and end point, find a path between the two using only three possible operations:
1808;; double
1809;; halve (odd numbers cannot be halved)
1810;; add 2
1811
1812;; Find the shortest path through the "maze". Because there are multiple shortest paths, you must return the length of the shortest path, not the path itself.
1813
1814(defn number-maze [x y]
1815 (letfn [(walk [n ret depth]
1816 (cond (== depth 0) Double/POSITIVE_INFINITY
1817 (== n y) (inc (count ret))
1818 :else
1819 (min (walk (* n 2)
1820 (conj ret n)
1821 (dec depth))
1822 (if (even? n)
1823 (walk (/ n 2)
1824 (conj ret n)
1825 (dec depth))
1826 Double/POSITIVE_INFINITY)
1827 (walk (+ n 2)
1828 (conj ret n)
1829 (dec depth)))))]
1830 (loop [i 1
1831 ret (walk x [] i)]
1832 (if (< ret Double/POSITIVE_INFINITY)
1833 ret
1834 (recur (inc i)
1835 (walk x [] (inc i)))))))
1836
1837(= 1 (number-maze 1 1)) ; 1
1838
1839(= 3 (number-maze 3 12)) ; 3 6 12
1840
1841(= 3 (number-maze 12 3)) ; 12 6 3
1842
1843(= 3 (number-maze 5 9)) ; 5 7 9
1844
1845(= 9 (number-maze 9 2)) ; 9 18 20 10 12 6 8 4 2
1846
1847(= 5 (number-maze 9 12)) ; 9 11 22 24 12
1848
1849;; @@
1850;; =>
1851;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1852;; <=
1853
1854;; @@
1855;; Levenshtein Distance
1856;; Difficulty: Hard
1857;; Topics: seqs
1858
1859
1860;; Given two sequences x and y, calculate the Levenshtein distance of x and y, i. e. the minimum number of edits needed to transform x into y. The allowed edits are:
1861
1862;; - insert a single item
1863;; - delete a single item
1864;; - replace a single item with another item
1865
1866;; WARNING: Some of the test cases may timeout if you write an inefficient solution!
1867
1868(defn distance [a b]
1869 (letfn [(walk
1870 [f a b]
1871 (cond
1872 (or (nil? a) (nil? b))
1873 (+ (count a) (count b))
1874
1875 (= (first a) (first b))
1876 (f f (next a) (next b))
1877
1878 :else
1879 (inc (min (f f (next a) (next b))
1880 (f f (next a) b)
1881 (f f a (next b))))))]
1882 (walk (memoize walk) a b)))
1883
1884(= (distance "kitten" "sitting") 3)
1885
1886(= (distance "closure" "clojure") (distance "clojure" "closure") 1)
1887
1888(= (distance "xyx" "xyyyx") 2)
1889
1890(= (distance "" "123456") 6)
1891
1892(= (distance "Clojure" "Clojure") (distance "" "") (distance [] []) 0)
1893
1894(= (distance [1 2 3 4] [0 2 3 4 5]) 2)
1895
1896(= (distance '(:a :b :c :d) '(:a :d)) 2)
1897
1898(= (distance "ttttattttctg" "tcaaccctaccat") 10)
1899
1900(= (distance "gaattctaatctc" "caaacaaaaaattt") 9)
1901;; @@
1902;; =>
1903;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1904;; <=
1905
1906;; @@
1907;; Graph Tour
1908;; Difficulty: Hard
1909;; Topics: graph-theory
1910
1911
1912;; 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.
1913
1914;; The graph is represented by a vector of tuples, where each tuple represents a single edge.
1915
1916;; The rules are:
1917
1918;; - You can start at any node.
1919;; - You must visit each edge exactly once.
1920;; - All edges are undirected.
1921
1922(defn graph-tour [edges]
1923 (let [nodes (into #{} (apply concat edges))
1924 num-edges (count edges)
1925 adjacency-mat
1926 (reduce (fn [mat [a b :as edge]]
1927 (-> (update-in mat [a] conj (set edge))
1928 (update-in [b] conj (set edge))))
1929 (into {} (map vector nodes (repeat #{})))
1930 edges)
1931 walk
1932 (fn walk [visited node]
1933 (lazy-seq
1934 (let [edges (adjacency-mat node)
1935 unvisited (clojure.set/difference edges visited)]
1936 (cond
1937 (= (count visited) num-edges) (list true)
1938 (empty? unvisited) (list nil)
1939 :else
1940 (mapcat #(walk (conj visited %)
1941 (first (disj % node))) unvisited)))))]
1942 (boolean (some true? (walk #{} (ffirst edges))))))
1943
1944(= true (graph-tour [[:a :b]]))
1945
1946(= false (graph-tour [[:a :a] [:b :b]]))
1947
1948(= false (graph-tour [[:a :b] [:a :b] [:a :c] [:c :a]
1949 [:a :d] [:b :d] [:c :d]]))
1950
1951(= true (graph-tour [[1 2] [2 3] [3 4] [4 1]]))
1952
1953(= true (graph-tour [[:a :b] [:a :c] [:c :b] [:a :e]
1954 [:b :e] [:a :d] [:b :d] [:c :e]
1955 [:d :e] [:c :f] [:d :f]]))
1956
1957(= false (graph-tour [[1 2] [2 3] [2 4] [2 5]]))
1958(= false (graph-tour [[1 2] [2 3] [2 4] [2 5]]))
1959;; @@
1960;; =>
1961;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
1962;; <=
1963
1964;; @@
1965;; Win at Tic-Tac-Toe
1966;; Difficulty: Hard
1967;; Topics: game
1968
1969
1970;; As in Problem 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. Create a function that accepts a game piece and board as arguments, and returns a set (possibly empty) of all valid board placements of the game piece which would result in an immediate win.
1971
1972;; Board coordinates should be as in calls to get-in. For example, [0 1] is the topmost row, center position.
1973
1974(defn winning-moves [player board]
1975 (letfn [(column-indices
1976 [rows]
1977 (partition (count rows)
1978 (for [row (range (count rows))
1979 column (range (count rows))]
1980 [column row])))
1981 (row-indices [rows]
1982 (partition (count rows)
1983 (for [row (range (count rows))
1984 column (range (count rows))]
1985 [row column])))
1986 (diagonal-indices [rows]
1987 (->> (for [row (range (count rows))]
1988 [[row row]
1989 [(- (count rows) row 1) row]])
1990 (apply map vector)))]
1991 (let [rows (row-indices board)
1992 columns (column-indices board)
1993 diagonals (diagonal-indices board)]
1994 (->> (concat rows columns diagonals)
1995 (filter (fn [indices]
1996 (let [elems (map #(get-in board %) indices)
1997 freqs (frequencies elems)]
1998 (and (= (player freqs) 2)
1999 (= (:e freqs) 1)))))
2000 (apply concat)
2001 (filter #(= (get-in board %) :e))
2002 set))))
2003
2004
2005(= (winning-moves :x [[:o :e :e]
2006 [:o :x :o]
2007 [:x :x :e]])
2008 #{[2 2] [0 1] [0 2]})
2009
2010(= (winning-moves :x [[:x :o :o]
2011 [:x :x :e]
2012 [:e :o :e]])
2013 #{[2 2] [1 2] [2 0]})
2014
2015(= (winning-moves :x [[:x :e :x]
2016 [:o :x :o]
2017 [:e :o :e]])
2018 #{[2 2] [0 1] [2 0]})
2019
2020(= (winning-moves :x [[:x :x :o]
2021 [:e :e :e]
2022 [:e :e :e]])
2023 #{})
2024
2025(= (winning-moves :o [[:x :x :o]
2026 [:o :e :o]
2027 [:x :e :e]])
2028 #{[2 2] [1 1]})
2029(= (winning-moves :o [[:x :x :o]
2030 [:o :e :o]
2031 [:x :e :e]])
2032 #{[2 2] [1 1]})
2033
2034;; @@
2035;; =>
2036;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2037;; <=
2038
2039;; @@
2040;; For Science!
2041;; Difficulty: Hard
2042;; Topics: game
2043
2044
2045;; A mad scientist with tenure has created an experiment tracking mice in a maze. Several mazes have been randomly generated, and you've been tasked with writing a program to determine the mazes in which it's possible for the mouse to reach the cheesy endpoint. Write a function which accepts a maze in the form of a collection of rows, each row is a string where:
2046;; -spaces represent areas where the mouse can walk freely
2047;; -hashes (#) represent walls where the mouse can not walk
2048;; -M represents the mouse's starting point
2049;; -C represents the cheese which the mouse must reach
2050
2051;; The mouse is not allowed to travel diagonally in the maze (only up/down/left/right), nor can he escape the edge of the maze. Your function must return true iff the maze is solvable by the mouse.
2052
2053(defn for-science! [maze-data]
2054 (letfn [(build-maze
2055 [maze-data]
2056 (let [side-length (+ (count (first maze-data)) 2)]
2057 (conj (into [(vec (repeat side-length \#))]
2058 (for [row (mapv vec maze-data)]
2059 (into [\#] (conj row \#))))
2060 (vec (repeat side-length \#)))))
2061
2062 (locate-cell [maze value]
2063 (first (filter #(= (get-in maze %) value)
2064 (for [i (range (count maze))
2065 j (range (count (maze i)))]
2066 [i j]))))
2067
2068
2069 (distance
2070 [p1 p2]
2071 (let [dx (- (first p1) (first p2))
2072 dy (- (second p1) (second p2))]
2073 (Math/sqrt (+ (* dx dx) (* dy dy)))))
2074
2075 (actions
2076 [[x y] goal-point]
2077 (into (sorted-map)
2078 (group-by (partial distance goal-point)
2079 [[(inc x) y]
2080 [x (inc y)]
2081 [x (dec y)]
2082 [(dec x) y]])))
2083
2084 (legal-action? [maze point]
2085 (not= (get-in maze point) \#))
2086
2087 (rank-actions
2088 [maze my-pos goal-pos]
2089 (let [possible-actions (actions my-pos goal-pos)
2090 legal-action?* (partial legal-action? maze)]
2091 (->> possible-actions
2092 (mapcat (fn [[dist actions]] actions))
2093 (filter legal-action?*)
2094 (into []))))
2095
2096 (walk
2097 ([maze]
2098 (let [my-pos (locate-cell maze \M)
2099 goal-pos (locate-cell maze \C)]
2100 (walk maze my-pos goal-pos #{})))
2101 ([maze my-pos goal-pos visited]
2102 (if (= my-pos goal-pos) :muhahaha
2103 (let [action-seq (rank-actions maze my-pos goal-pos)
2104 visited (conj visited my-pos)
2105 next-steps (remove visited action-seq)]
2106 (if (empty? next-steps) visited
2107 ;; No fold-right????
2108 (loop [visited visited next-steps next-steps]
2109 (cond (= visited :muhahaha) visited
2110 (empty? next-steps) visited
2111 :else
2112 (recur (walk maze
2113 (first next-steps)
2114 goal-pos
2115 visited)
2116 (next next-steps)))))))))]
2117
2118 (= (walk (build-maze maze-data)) :muhahaha)))
2119
2120(= true (for-science! ["M C"]))
2121
2122(= false (for-science! ["M # C"]))
2123
2124(= true (for-science! ["#######"
2125 "# #"
2126 "# # #"
2127 "#M # C#"
2128 "#######"]))
2129
2130(= false (for-science!
2131 ["########"
2132 "#M # #"
2133 "# # #"
2134 "# # # #"
2135 "# # #"
2136 "# # #"
2137 "# # # #"
2138 "# # #"
2139 "# # C#"
2140 "########"]))
2141
2142(= false (for-science!
2143 ["M "
2144 " "
2145 " "
2146 " "
2147 " ##"
2148 " #C"]))
2149
2150(= true (for-science!
2151 ["C######"
2152 " # "
2153 " # # "
2154 " # #M"
2155 " # "]))
2156
2157(= true (for-science!
2158 ["C# # # #"
2159 " "
2160 "# # # # "
2161 " "
2162 " # # # #"
2163 " "
2164 "# # # #M"]))
2165;; @@
2166;; =>
2167;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2168;; <=
2169
2170;; @@
2171;; Making Data Dance
2172;; Difficulty: Hard
2173;; Topics: types
2174
2175
2176;; Write a function that takes a variable number of integer arguments. If the output is coerced into a string, it should return a comma (and space) separated list of the inputs sorted smallest to largest. If the output is coerced into a sequence, it should return a seq of unique input elements in the same order as they were entered.
2177
2178;; don't understand the question...
2179(defn dance! [& coll]
2180 (reify
2181 clojure.lang.Seqable
2182 (seq [this]
2183 (seq (distinct coll)))
2184 Object
2185 (toString [this] (apply str (interpose ", " (sort coll))))))
2186
2187
2188(= "1, 2, 3" (str (dance! 2 1 3)))
2189
2190(= '(2 1 3) (seq (dance! 2 1 3)))
2191
2192(= '(2 1 3) (seq (dance! 2 1 3 3 1 2)))
2193
2194(= '(1) (seq (apply dance! (repeat 5 1))))
2195
2196(= "1, 1, 1, 1, 1" (str (apply dance! (repeat 5 1))))
2197
2198(and (= nil (seq (dance!)))
2199 (= "" (str (dance!))))
2200;; @@
2201;; =>
2202;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2203;; <=
2204
2205;; @@
2206;; Crossword puzzle
2207;; Difficulty: Hard
2208;; Topics: game
2209
2210
2211;; Write a function that takes a string and a partially-filled crossword puzzle board, and determines if the input string can be legally placed onto the board.
2212
2213;; The crossword puzzle board consists of a collection of partially-filled rows. Empty spaces are denoted with an underscore (_), unusable spaces are denoted with a hash symbol (#), and pre-filled spaces have a character in place; the whitespace characters are for legibility and should be ignored.
2214
2215;; For a word to be legally placed on the board:
2216;; - It may use empty spaces (underscores)
2217;; - It may use but must not conflict with any pre-filled characters.
2218;; - It must not use any unusable spaces (hashes).
2219;; - There must be no empty spaces (underscores) or extra characters before or after the word (the word may be bound by unusable spaces though).
2220;; - Characters are not case-sensitive.
2221;; - Words may be placed vertically (proceeding top-down only), or horizontally (proceeding left-right only).
2222
2223(defn crossword-puzzle [word puzzle]
2224 (letfn [(solve-puzzle
2225 [puzzle]
2226 (->> puzzle
2227 (concat (apply mapv str puzzle))
2228 (mapcat #(clojure.string/split % #"#"))
2229 (some (comp #(if (= % word) word nil)
2230 #(re-find % word)
2231 re-pattern
2232 #(clojure.string/replace % "_" ".{1}")
2233 #(clojure.string/replace % " " "")))
2234 boolean))]
2235 (solve-puzzle puzzle)))
2236
2237(= true (crossword-puzzle "the" ["_ # _ _ e"]))
2238
2239(= false (crossword-puzzle
2240 "the" ["c _ _ _"
2241 "d _ # e"
2242 "r y _ _"]))
2243
2244(= true (crossword-puzzle
2245 "joy" ["c _ _ _"
2246 "d _ # e"
2247 "r y _ _"]))
2248
2249(= false (crossword-puzzle
2250 "joy" ["c o n j"
2251 "_ _ y _"
2252 "r _ _ #"]))
2253
2254(= true (crossword-puzzle
2255 "clojure" ["_ _ _ # j o y"
2256 "_ _ o _ _ _ _"
2257 "_ _ f _ # _ _"]))
2258;; @@
2259;; =>
2260;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2261;; <=
2262
2263;; @@
2264;; Gus' Quinundrum
2265;; Difficulty: Hard
2266;; Topics: logic fun brain-teaser
2267
2268
2269;; Create a function of no arguments which returns a string that is an exact copy of the function itself.
2270
2271;; Hint: read this if you get stuck (this question is harder than it first appears); but it's worth the effort to solve it independently if you can!
2272
2273;; Fun fact: Gus is the name of the 4Clojure dragon.
2274
2275(fn [] ((fn [x] (str (list (quote fn) []
2276 (list x (list (quote quote) x)))))
2277 (quote (fn [x] (str (list (quote fn) []
2278 (list x (list (quote quote) x))))))))
2279
2280
2281
2282(= (str '(fn [] ((fn [x] (str (list (quote fn) []
2283 (list x (list (quote quote) x)))))
2284 (quote (fn [x] (str (list (quote fn) []
2285 (list x (list (quote quote) x))))))))) ((fn [] ((fn [x] (str (list (quote fn) []
2286 (list x (list (quote quote) x)))))
2287 (quote (fn [x] (str (list (quote fn) []
2288 (list x (list (quote quote) x))))))))))
2289
2290
2291;; @@
2292;; =>
2293;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2294;; <=
2295
2296;; @@
2297;; Best Hand
2298;; Difficulty: Hard
2299;; Topics: strings game
2300
2301
2302;; Following on from Recognize Playing Cards, determine the best poker hand that can be made with five cards. The hand rankings are listed below for your convenience.
2303
2304;; Straight flush: All cards in the same suit, and in sequence
2305;; Four of a kind: Four of the cards have the same rank
2306;; Full House: Three cards of one rank, the other two of another rank
2307;; Flush: All cards in the same suit
2308;; Straight: All cards in sequence (aces can be high or low, but not both at once)
2309;; Three of a kind: Three of the cards have the same rank
2310;; Two pair: Two pairs of cards have the same rank
2311;; Pair: Two cards have the same rank
2312;; High card: None of the above conditions are met
2313
2314(defn best-hand [hand-data]
2315 (let [parse-hand
2316 (fn [hand-data]
2317 (let [split-cards (map vec hand-data)
2318 suits (mapv first split-cards)
2319 ranks (->> split-cards
2320 (map (comp #({\J 11 \Q 12
2321 \K 13 \A 14
2322 \T 10 \9 9
2323 \8 8 \7 7
2324 \6 6 \5 5
2325 \4 4 \3 3
2326 \2 2} % %)
2327 second))
2328 sort
2329 vec)]
2330 {:suits suits
2331 :ranks ranks}))
2332
2333 in-sequence?
2334 (fn [{:keys [ranks]}]
2335 (let [comparison
2336 (= ranks (range (first ranks)
2337 (+ (first ranks)
2338 (count ranks))))]
2339 (if (= (last ranks) 14)
2340 (or (= (butlast ranks) (range 2 (inc (count ranks))))
2341 comparison)
2342 comparison)))
2343
2344 same-suit?
2345 (fn [{:keys [suits]}]
2346 (println suits)
2347 (= (count (set suits)) 1))
2348
2349 order
2350 {:straight-flush 0
2351 :four-of-a-kind 1
2352 :full-house 2
2353 :flush 3
2354 :straight 4
2355 :three-of-a-kind 5
2356 :two-pair 6
2357 :pair 7
2358 :high-card 8}
2359
2360
2361 classifier
2362 (sorted-map-by (fn [a b]
2363 (< (order a) (order b)))
2364 :straight-flush
2365 (fn [hand] (and (same-suit? hand)
2366 (in-sequence? hand)))
2367 :four-of-a-kind
2368 (fn [{:keys [ranks]}]
2369 (some (fn [[k v]] (>= (count v) 4))
2370 (group-by identity ranks)))
2371
2372 :full-house
2373 (fn [{:keys [ranks]}]
2374 (let [[a b & xs] (vals (group-by identity ranks))]
2375 (and a b (not xs)
2376 (or (= (count a) 2)
2377 (= (count b) 2)))))
2378
2379 :flush
2380 (fn [hand]
2381 (same-suit? hand))
2382
2383 :straight
2384 (fn [hand]
2385 (in-sequence? hand))
2386
2387 :three-of-a-kind
2388 (fn [{:keys [ranks]}]
2389 (contains? (->> ranks
2390 (group-by identity)
2391 vals
2392 (map count)
2393 set)
2394 3))
2395
2396 :two-pair
2397 (fn [{:keys [ranks]}]
2398 (= (->> ranks
2399 (group-by identity)
2400 vals
2401 (map count)
2402 (filter #(= % 2))
2403 count)
2404 2))
2405
2406 :pair
2407 (fn [{:keys [ranks]}]
2408 (= (->> ranks
2409 (group-by identity)
2410 vals
2411 (map count)
2412 (filter #(= % 2))
2413 count)
2414 1))
2415
2416 :high-card (fn [hand] true))
2417
2418 parsed-hand (parse-hand hand-data)]
2419 (loop [classifier (seq classifier)]
2420 (let [[type* pred] (first classifier)]
2421 (if (pred parsed-hand)
2422 type*
2423 (recur (next classifier)))))))
2424
2425
2426(= :high-card (best-hand ["HA" "D2" "H3" "C9" "DJ"]))
2427
2428(= :pair (best-hand ["HA" "HQ" "SJ" "DA" "HT"]))
2429
2430(= :two-pair (best-hand ["HA" "DA" "HQ" "SQ" "HT"]))
2431
2432(= :three-of-a-kind (best-hand ["HA" "DA" "CA" "HJ" "HT"]))
2433
2434(= :straight (best-hand ["HA" "DK" "HQ" "HJ" "HT"]))
2435
2436(= :straight (best-hand ["HA" "H2" "S3" "D4" "C5"]))
2437
2438(= :flush (best-hand ["HA" "HK" "H2" "H4" "HT"]))
2439
2440(= :full-house (best-hand ["HA" "DA" "CA" "HJ" "DJ"]))
2441
2442(= :four-of-a-kind (best-hand ["HA" "DA" "CA" "SA" "DJ"]))
2443
2444(= :straight-flush (best-hand ["HA" "HK" "HQ" "HJ" "HT"]))
2445;; @@
2446;; ->
2447;;; [H D H C D]
2448;;; [H D H C D]
2449;;; [H H S D H]
2450;;; [H H S D H]
2451;;; [H D H S H]
2452;;; [H D H S H]
2453;;; [H D C H H]
2454;;; [H D C H H]
2455;;; [H D H H H]
2456;;; [H D H H H]
2457;;; [H H S D C]
2458;;; [H H S D C]
2459;;; [H H H H H]
2460;;; [H H H H H]
2461;;; [H D C H D]
2462;;; [H D C S D]
2463;;; [H H H H H]
2464;;;
2465;; <-
2466;; =>
2467;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2468;; <=
2469
2470;; @@
2471;; Analyze Reversi
2472;; Difficulty: Hard
2473;; Topics: game
2474
2475
2476;; Reversi is normally played on an 8 by 8 board. In this problem, a 4 by 4 board is represented as a two-dimensional vector with black, white, and empty pieces represented by 'b, 'w, and 'e, respectively. Create a function that accepts a game board and color as arguments, and returns a map of legal moves for that color. Each key should be the coordinates of a legal move, and its value a set of the coordinates of the pieces flipped by that move.
2477
2478;; Board coordinates should be as in calls to get-in. For example, [0 1] is the topmost row, second column from the left.
2479
2480
2481;; Not the prettiest....
2482(defn analyze-reversi [board player]
2483 (letfn [(diagonals
2484 [board]
2485 (->> (for [i (range (count board))]
2486 (for [j (range (inc i))]
2487 (let [k (- i j)
2488 n (dec (count board))
2489 l (- n i)]
2490 [[(get-in board [k j]) k j]
2491 [(get-in board [(- n k) (- n j)]) (- n k) (- n j)]
2492 [(get-in board [j l]) j l]
2493 [(get-in board [(+ l j) j]) (+ l j) j]])))
2494 (mapcat #(apply mapv vector %))))
2495 (rows
2496 [board]
2497 (for [i (range (count board))]
2498 (for [j (range (count board))]
2499 [(get-in board [i j]) i j])))
2500
2501 (columns
2502 [board]
2503 (for [i (range (count board))]
2504 (for [j (range (count board))]
2505 [(get-in board [j i]) j i])))
2506
2507 (legal-moves
2508 [player opponent string]
2509 (->> (re-seq
2510 (re-pattern
2511 (str player "\\d+" \( opponent "\\d+" \) \+ 'e "\\d+"))
2512 string)
2513 (map first)))
2514
2515 (opponent [player]
2516 (if (= player 'w) 'b 'w))]
2517 (->> (concat (diagonals board)
2518 (rows board)
2519 (columns board))
2520 (map (comp (partial legal-moves player (opponent player))
2521 #(apply str %)
2522 #(apply concat %)
2523 #(apply concat %)
2524 #(vector % (reverse %))))
2525 (remove empty?)
2526 (apply concat)
2527 (map (comp (fn [coll] [(vec (peek coll))
2528 (set (map vec (pop coll)))])
2529 vec
2530 next
2531 #(partition 2 %)
2532 #(remove nil? %)
2533 #(map {\0 0 \1 1 \2 2 \3 3} %)
2534 #(next %)))
2535
2536 (into {}))))
2537
2538(= {[1 3] #{[1 2]}, [0 2] #{[1 2]}, [3 1] #{[2 1]}, [2 0] #{[2 1]}}
2539 (analyze-reversi '[[e e e e]
2540 [e w b e]
2541 [e b w e]
2542 [e e e e]] 'w))
2543
2544(= {[3 2] #{[2 2]}, [3 0] #{[2 1]}, [1 0] #{[1 1]}}
2545 (analyze-reversi '[[e e e e]
2546 [e w b e]
2547 [w w w e]
2548 [e e e e]] 'b))
2549
2550(= {[0 3] #{[1 2]}, [1 3] #{[1 2]}, [3 3] #{[2 2]}, [2 3] #{[2 2]}}
2551 (analyze-reversi '[[e e e e]
2552 [e w b e]
2553 [w w b e]
2554 [e e b e]] 'w))
2555
2556(= {[0 3] #{[2 1] [1 2]}, [1 3] #{[1 2]}, [2 3] #{[2 1] [2 2]}}
2557 (analyze-reversi '[[e e w e]
2558 [b b w e]
2559 [b w w e]
2560 [b w w w]] 'b))
2561
2562(= {[0 3] #{[2 1] [1 2]}, [1 3] #{[1 2]}, [2 3] #{[2 1] [2 2]}}
2563 (analyze-reversi '[[e e w e]
2564 [b b w e]
2565 [b w w e]
2566 [b w w w]] 'b))
2567;; @@
2568;; =>
2569;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2570;; <=
2571
2572;; @@
2573;; Tree reparenting
2574;; Difficulty: Hard
2575;; Topics: tree
2576
2577
2578;; Every node of a tree is connected to each of its children as well as its parent. One can imagine grabbing one node of a tree and dragging it up to the root position, leaving all connections intact. For example, below on the left is a binary tree. By pulling the "c" node up to the root, we obtain the tree on the right.
2579
2580;; Note it is no longer binary as "c" had three connections total -- two children and one parent. Each node is represented as a vector, which always has at least one element giving the name of the node as a symbol. Subsequent items in the vector represent the children of the node. Because the children are ordered it's important that the tree you return keeps the children of each node in order and that the old parent node, if any, is appended on the right. Your function will be given two args -- the name of the node that should become the new root, and the tree to transform.
2581
2582
2583(defn reparent [new-root tree]
2584 (letfn [(reverse-arrow [parent child]
2585 (let [[a b] (split-with #(not (identical? % child)) parent)]
2586 (concat (first b) (list (concat a (rest b))))))
2587 (walk [parent]
2588 (lazy-seq
2589 (cons parent
2590 (mapcat (fn [child]
2591 (if (= (count child) 1)
2592 (list (reverse-arrow parent child))
2593 (walk (reverse-arrow parent child))))
2594 (rest parent)))))]
2595 (first (filter #(= (first %) new-root) (walk tree)))))
2596
2597(= '(n)
2598 (reparent 'n '(n)))
2599
2600(= '(a (t (e)))
2601 (reparent 'a '(t (e) (a))))
2602
2603(= '(e (t (a)))
2604 (reparent 'e '(a (t (e)))))
2605
2606(= '(a (b (c)))
2607 (reparent 'a '(c (b (a)))))
2608
2609(= '(d
2610 (b
2611 (c)
2612 (e)
2613 (a
2614 (f
2615 (g)
2616 (h)))))
2617 (reparent
2618 'd '(a
2619 (b
2620 (c)
2621 (d)
2622 (e))
2623 (f
2624 (g)
2625 (h)))))
2626
2627(= '(c
2628 (d)
2629 (e)
2630 (b
2631 (f
2632 (g)
2633 (h))
2634 (a
2635 (i
2636 (j
2637 (k)
2638 (l))
2639 (m
2640 (n)
2641 (o))))))
2642 (reparent
2643 'c '(a
2644 (b
2645 (c
2646 (d)
2647 (e))
2648 (f
2649 (g)
2650 (h)))
2651 (i
2652 (j
2653 (k)
2654 (l))
2655 (m
2656 (n)
2657 (o))))))
2658
2659;; @@
2660;; =>
2661;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2662;; <=
2663
2664;; @@
2665;; Squares Squared
2666;; Difficulty: Hard
2667;; Topics: data-juggling
2668
2669
2670;; Create a function of two integer arguments: the start and end, respectively. You must create a vector of strings which renders a 45° rotated square of integers which are successive squares from the start point up to and including the end point. If a number comprises multiple digits, wrap them around the shape individually. If there are not enough digits to complete the shape, fill in the rest with asterisk characters. The direction of the drawing should be clockwise, starting from the center of the shape and working outwards, with the initial direction being down and to the right.
2671
2672(defn data-juggle [start end]
2673 (letfn [(left [[pos & stack]]
2674 (conj stack (update-in pos [1] dec)))
2675
2676 (right [[pos & stack]]
2677 (conj stack (update-in pos [1] inc)))
2678
2679 (up [[pos & stack]]
2680 (conj stack (update-in pos [0] dec)))
2681
2682 (down [[pos & stack]]
2683 (conj stack (update-in pos [0] inc)))
2684
2685 (dup [[pos :as stack]]
2686 (conj stack pos))
2687
2688 (move [f n positions]
2689 ((apply comp
2690 (interleave (repeat n f)
2691 (repeat n dup)))
2692 positions))
2693
2694 (out-of-bounds? [n [x y]]
2695 (or (>= x n) (< x 0)
2696 (>= y n) (< y 0)))
2697
2698 (run [action-sequence n]
2699 (loop [[action arg & acs :as as] action-sequence
2700 stack '()
2701 positions '()]
2702 (if (and (not (empty? stack))
2703 (or (out-of-bounds? n (peek positions))
2704 (empty? as)))
2705
2706 (reverse (drop-while (partial out-of-bounds? n)
2707 positions))
2708
2709 (case action
2710 :up (recur acs
2711 (conj stack arg action)
2712 (move (comp up right) arg positions))
2713
2714 :down (recur acs
2715 (conj stack arg action)
2716 (move (comp down left) arg positions))
2717
2718 :left (recur acs
2719 (conj stack arg action)
2720 (move (comp left up) arg positions))
2721
2722 :right (recur acs
2723 (conj stack arg action)
2724 (move (comp right down) arg
2725 positions))
2726
2727 :recur (recur (conj (apply arg (take 2 stack))
2728 action arg)
2729 (-> stack pop pop)
2730 positions)
2731
2732 :start (recur acs
2733 (conj stack arg action)
2734 (conj positions arg))))))
2735
2736 (empty-grid [n] (vec (repeat n (vec (repeat n \space)))))
2737
2738 (squares [start end]
2739 (loop [n start
2740 squares []]
2741 (if (> n end) squares
2742 (recur (* n n)
2743 (conj squares n)))))
2744
2745 (rotated-grid-size [n] (- (* 2 n) 1))
2746
2747 (square-container-size
2748 [m]
2749 (loop [n 1]
2750 (if (>= (* n n) m) n
2751 (recur (inc n)))))
2752
2753 (nav-expression
2754 [start-pos]
2755 [:start start-pos
2756 :right 1
2757 :down 1
2758 :recur (fn [t n]
2759 (case t
2760 :down [:left (inc n) :up (inc n)]
2761 :up [:right (inc n) :down (inc n)]))])]
2762
2763 (let [squares (apply str (squares start end))
2764 grid-size (square-container-size (count squares))
2765 n (rotated-grid-size grid-size)
2766 grid (empty-grid n)
2767 start-pos [(if (odd? (/ (- n 1) 2))
2768 (dec (/ (- n 1) 2))
2769 (/ (- n 1) 2))
2770 (/ (- n 1) 2)]
2771 expr (nav-expression start-pos)
2772 indices (run expr n)]
2773 (->> (reduce (fn [grid [pos elem]]
2774 (assoc-in grid pos elem))
2775 grid
2776 (map vector indices
2777 (concat squares (repeat \*))))
2778 (map (fn [coll]
2779 (apply str coll)))
2780 vec))))
2781
2782(= (data-juggle 2 2) ["2"])
2783
2784(= (data-juggle 2 4) [" 2 "
2785 "* 4"
2786 " * "])
2787
2788(= (data-juggle 3 81) [" 3 "
2789 "1 9"
2790 " 8 "])
2791
2792(= (data-juggle 4 20) [" 4 "
2793 "* 1"
2794 " 6 "])
2795
2796(= (data-juggle 2 256) [" 6 "
2797 " 5 * "
2798 "2 2 *"
2799 " 6 4 "
2800 " 1 "])
2801
2802(= (data-juggle 10 10000) [" 0 "
2803 " 1 0 "
2804 " 0 1 0 "
2805 "* 0 0 0"
2806 " * 1 * "
2807 " * * "
2808 " * "])
2809
2810
2811;; @@
2812;; =>
2813;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2814;; <=
2815
2816;; @@
2817;; Language of a DFA
2818;; Difficulty: Hard
2819;; Topics: automata seqs
2820
2821
2822;; A deterministic finite automaton (DFA) is an abstract machine that recognizes a regular language. Usually a DFA is defined by a 5-tuple, but instead we'll use a map with 5 keys:
2823;; :states is the set of states for the DFA.
2824;; :alphabet is the set of symbols included in the language recognized by the DFA.
2825;; :start is the start state of the DFA.
2826;; :accepts is the set of accept states in the DFA.
2827;; :transitions is the transition function for the DFA, mapping :states ⨯ :alphabet onto :states.
2828;;
2829;;Write a function that takes as input a DFA definition (as described above) and returns a sequence enumerating all strings in the language recognized by the DFA. Note: Although the DFA itself is finite and only recognizes finite-length strings it can still recognize an infinite set of finite-length strings. And because stack space is finite, make sure you don't get stuck in an infinite loop that's not producing results every so often!
2830
2831(defn state-machine [machine]
2832 (letfn [(gen-strings
2833 [{:keys [transitions accepts start]}]
2834 (letfn [(step [paths]
2835 (lazy-seq
2836 (when-not (empty? paths)
2837 (let [accepted (filter (comp accepts peek) paths)
2838 accepted-strings (map (comp #(apply str %) pop) accepted)]
2839 (concat accepted-strings
2840 (step (for [path paths
2841 [letter nxt] (transitions (peek path))]
2842 (conj (pop path) letter nxt))))))))]
2843 (step [[start]])))]
2844 (gen-strings machine)))
2845
2846(= #{"a" "ab" "abc"}
2847 (set (state-machine '{:states #{q0 q1 q2 q3}
2848 :alphabet #{a b c}
2849 :start q0
2850 :accepts #{q1 q2 q3}
2851 :transitions {q0 {a q1}
2852 q1 {b q2}
2853 q2 {c q3}}})))
2854
2855(= #{"hi" "hey" "hello"}
2856 (set (state-machine '{:states #{q0 q1 q2 q3 q4 q5 q6 q7}
2857 :alphabet #{e h i l o y}
2858 :start q0
2859 :accepts #{q2 q4 q7}
2860 :transitions {q0 {h q1}
2861 q1 {i q2, e q3}
2862 q3 {l q5, y q4}
2863 q5 {l q6}
2864 q6 {o q7}}})))
2865
2866(= (set (let [ss "vwxyz"] (for [i ss, j ss, k ss, l ss] (str i j k l))))
2867 (set (state-machine '{:states #{q0 q1 q2 q3 q4}
2868 :alphabet #{v w x y z}
2869 :start q0
2870 :accepts #{q4}
2871 :transitions {q0 {v q1, w q1, x q1, y q1, z q1}
2872 q1 {v q2, w q2, x q2, y q2, z q2}
2873 q2 {v q3, w q3, x q3, y q3, z q3}
2874 q3 {v q4, w q4, x q4, y q4, z q4}}})))
2875
2876(let [res (take 2000 (state-machine '{:states #{q0 q1}
2877 :alphabet #{0 1}
2878 :start q0
2879 :accepts #{q0}
2880 :transitions {q0 {0 q0, 1 q1}
2881 q1 {0 q1, 1 q0}}}))]
2882 (and (every? (partial re-matches #"0*(?:10*10*)*") res)
2883 (= res (distinct res)))
2884
2885 (let [res (take 2000 (state-machine '{:states #{q0 q1}
2886 :alphabet #{n m}
2887 :start q0
2888 :accepts #{q1}
2889 :transitions {q0 {n q0, m q1}}}))]
2890 (and (every? (partial re-matches #"n*m") res)
2891 (= res (distinct res)))))
2892
2893(let [res (take 2000 (state-machine '{:states #{q0 q1 q2 q3 q4 q5 q6 q7 q8 q9}
2894 :alphabet #{i l o m p t}
2895 :start q0
2896 :accepts #{q5 q8}
2897 :transitions {q0 {l q1}
2898 q1 {i q2, o q6}
2899 q2 {m q3}
2900 q3 {i q4}
2901 q4 {t q5}
2902 q6 {o q7}
2903 q7 {p q8}
2904 q8 {l q9}
2905 q9 {o q6}}}))]
2906 (and (every? (partial re-matches #"limit|(?:loop)+") res)
2907 (= res (distinct res))))
2908;; @@
2909;; =>
2910;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
2911;; <=
2912
2913;; @@
2914;; Love Triangle
2915;; Difficulty: Hard
2916;; Topics: search data-juggling
2917
2918
2919;; Everyone loves triangles, and it's easy to understand why—they're so wonderfully symmetric (except scalenes, they suck).
2920
2921;; Your passion for triangles has led you to become a miner (and part-time Clojure programmer) where you work all day to chip out isosceles-shaped minerals from rocks gathered in a nearby open-pit mine. There are too many rocks coming from the mine to harvest them all so you've been tasked with writing a program to analyze the mineral patterns of each rock, and determine which rocks have the biggest minerals.
2922
2923;; Someone has already written a computer-vision system for the mine. It images each rock as it comes into the processing centre and creates a cross-sectional bitmap of mineral (1) and rock (0) concentrations for each one.
2924
2925;; You must now create a function which accepts a collection of integers, each integer when read in base-2 gives the bit-representation of the rock (again, 1s are mineral and 0s are worthless scalene-like rock). You must return the cross-sectional area of the largest harvestable mineral from the input rock, as follows:
2926;; The minerals only have smooth faces when sheared vertically or horizontally from the rock's cross-section
2927;; The mine is only concerned with harvesting isosceles triangles (such that one or two sides can be sheared)
2928;; If only one face of the mineral is sheared, its opposing vertex must be a point (ie. the smooth face must be of odd length), and its two equal-length sides must intersect the shear face at 45° (ie. those sides must cut even-diagonally)
2929;; The harvested mineral may not contain any traces of rock
2930;; The mineral may lie in any orientation in the plane
2931;; Area should be calculated as the sum of 1s that comprise the mineral
2932;; Minerals must have a minimum of three measures of area to be harvested
2933;; If no minerals can be harvested from the rock, your function should return nil
2934
2935(defn love-triangle [nums]
2936 (letfn [(to-binary [n]
2937 (loop [ret () n n]
2938 (if (zero? n) ret
2939 (recur (conj ret (rem n 2))
2940 (quot n 2)))))
2941 (pad [colls]
2942 (let [row-size (apply max (map count colls))]
2943 (mapv (fn [coll]
2944 (vec (concat (repeat (- row-size (count coll)) 0) coll)))
2945 colls)))
2946
2947 (mine-one [mine [row column :as pos]]
2948 {pos (count (for [i (range)
2949 :while (and (< (+ row i) (count mine))
2950 (< (+ column i) (count (mine (+ row i)))))
2951 :let [mineral-slice (subvec (mine (+ row i))
2952 column
2953 (+ column (inc i)))]
2954 :while (apply = 1 mineral-slice)]
2955 mineral-slice))})
2956
2957 (mine-all [mine]
2958 (apply merge
2959 (for [i (range (count mine))
2960 j (range (count (mine i)))
2961 :when (= 1 ((mine i) j))]
2962 (mine-one mine [i j]))))
2963 (triangular-series [n]
2964 (/ (* n (+ n 1)) 2))
2965
2966 (transpose [colls]
2967 (apply mapv vector colls))
2968
2969 (invert [colls]
2970 (vec (rseq colls)))
2971
2972 (mrg [mine m1 m2]
2973 (concat (map triangular-series (vals m2))
2974 (vec (for [[[row col] n] m2
2975 :let [m (m2 [row (- (dec (count (mine row))) col)])]]
2976 (if (and m (= n m))
2977 (* n n)
2978 (triangular-series n))))))]
2979
2980 (let [grid (pad (map to-binary nums))
2981 map-invert (partial mapv invert)]
2982
2983 (->> (concat (mrg grid
2984 (mine-all grid)
2985 (-> grid map-invert mine-all))
2986 (mrg (-> grid transpose invert)
2987 (-> grid transpose invert mine-all)
2988 (-> grid transpose invert map-invert mine-all))
2989 (mrg (invert grid)
2990 (-> grid invert mine-all)
2991 (-> grid invert map-invert mine-all))
2992 (mrg (transpose grid)
2993 (-> grid transpose mine-all)
2994 (-> grid transpose map-invert mine-all)))
2995 (apply max)
2996 ((fn [x] (if (> x 2) x nil)))))))
2997
2998
2999(= 10 (love-triangle [15 15 15 15 15]))
3000; 1111 1111
3001; 1111 *111
3002; 1111 -> **11
3003; 1111 ***1
3004; 1111 ****
3005
3006(= 15 (love-triangle [1 3 7 15 31]))
3007; 00001 0000*
3008; 00011 000**
3009; 00111 -> 00***
3010; 01111 0****
3011; 11111 *****
3012
3013(= 3 (love-triangle [3 3]))
3014; 11 *1
3015; 11 -> **
3016
3017(= 4 (love-triangle [7 3]))
3018; 111 ***
3019; 011 -> 0*1
3020
3021(= 6 (love-triangle [17 22 6 14 22]))
3022; 10001 10001
3023; 10110 101*0
3024; 00110 -> 00**0
3025; 01110 0***0
3026; 10110 10110
3027
3028(= 6 (love-triangle [17 22 6 14 22]))
3029; 10001 10001
3030; 10110 101*0
3031; 00110 -> 00**0
3032; 01110 0***0
3033; 10110 10110
3034
3035(= 9 (love-triangle [18 7 14 14 6 3]))
3036; 10010 10010
3037; 00111 001*0
3038; 01110 01**0
3039; 01110 -> 0***0
3040; 00110 00**0
3041; 00011 000*1
3042
3043(= nil (love-triangle [21 10 21 10]))
3044; 10101 10101
3045; 01010 01010
3046; 10101 -> 10101
3047; 01010 01010
3048
3049(= nil (love-triangle [0 31 0 31 0]))
3050; 00000 00000
3051; 11111 11111
3052; 00000 -> 00000
3053; 11111 11111
3054; 00000 00000
3055;; @@
3056;; =>
3057;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
3058;; <=
3059
3060;; @@
3061;; Latin Square Slicing
3062;; Difficulty: Hard
3063;; Topics: data-analysis math
3064
3065
3066;; A Latin square of order n is an n x n array that contains n different elements, each occurring exactly once in each row, and exactly once in each column. For example, among the following arrays only the first one forms a Latin square:
3067
3068
3069;; A B C A B C A B C
3070;; B C A B C A B D A
3071;; C A B C A C C A B
3072
3073;; Let V be a vector of such vectors1 that they may differ in length2. We will say that an arrangement of vectors of V in consecutive rows is an alignment (of vectors) of V if the following conditions are satisfied:
3074
3075;; All vectors of V are used.
3076;; Each row contains just one vector.
3077;; The order of V is preserved.
3078;; All vectors of maximal length are horizontally aligned each other.
3079;; If a vector is not of maximal length then all its elements are aligned ;; with elements of some subvector of a vector of maximal length.
3080;; Let L denote a Latin square of order 2 or greater. We will say that L is included in V or that V includes L iff there exists an alignment of V such that contains a subsquare that is equal to L.
3081;; For example, if V equals [[1 2 3][2 3 1 2 1][3 1 2]] then there are nine alignments of V (brackets omitted):
3082
3083
3084;; 1 2 3
3085
3086;; 1 2 3 1 2 3 1 2 3
3087;; A 2 3 1 2 1 2 3 1 2 1 2 3 1 2 1
3088;; 3 1 2 3 1 2 3 1 2
3089
3090;; 1 2 3 1 2 3 1 2 3
3091;; B 2 3 1 2 1 2 3 1 2 1 2 3 1 2 1
3092;; 3 1 2 3 1 2 3 1 2
3093
3094;; 1 2 3 1 2 3 1 2 3
3095;; C 2 3 1 2 1 2 3 1 2 1 2 3 1 2 1
3096;; 3 1 2 3 1 2 3 1 2
3097
3098;; Alignment A1 contains Latin square [[1 2 3][2 3 1][3 1 2]], alignments A2, A3, B1, B2, B3 contain no Latin squares, and alignments C1, C2, C3 contain [[2 1][1 2]]. Thus in this case V includes one Latin square of order 3 and one of order 2 which is included three times.
3099
3100;; Our aim is to implement a function which accepts a vector of vectors V as an argument, and returns a map which keys and values are integers. Each key should be the order of a Latin square included in V, and its value a count of different Latin squares of that order included in V. If V does not include any Latin squares an empty map should be returned. In the previous example the correct output of such a function is {3 1, 2 1} and not {3 1, 2 3}.
3101
3102;; [1] Of course, we can consider sequences instead of vectors.
3103;; [2] Length of a vector is the number of elements in the vector.
3104
3105
3106;; A rather horrifying solution
3107(defn find-latin-squares [colls]
3108 (letfn [(latin-square? [colls]
3109 (let [t (map set colls)]
3110 (and (apply = t)
3111 (apply = (map set (apply map list colls)))
3112 (= (map count t) (map count colls)))))
3113 (alignments [colls]
3114 (let [longest (apply max (map count colls))]
3115 (for [[i coll] (mapv vector (range) colls)]
3116 (for [j (range (- (inc longest) (count coll)))]
3117 [i j]))))
3118 (product [colls]
3119 (if (empty? colls) (list nil)
3120 (for [x (first colls)
3121 xs (product (rest colls))]
3122 (cons x xs))))
3123 (squares [colls]
3124 (let [mx (apply max (map count colls))]
3125 (for [alignment (product (alignments colls))]
3126 (reduce (fn [ret [row offset]]
3127 (update-in ret
3128 [row]
3129 (fn [coll]
3130 (concat (repeat offset 0)
3131 coll
3132 (repeat (- mx (+ offset (count coll))) 0)))))
3133 colls
3134 alignment))))]
3135 (let [squares (squares colls)
3136 longest-row (apply max (map count colls))]
3137 (->> (for [square squares
3138 size (range 2 (inc longest-row))]
3139 (map #(apply mapv vector %)
3140 (partition size 1
3141 (map (partial partition size 1) square))))
3142 (apply concat)
3143 (apply concat)
3144 (remove #(some (fn [x] (= x 0)) (apply concat %)))
3145 (filter latin-square?)
3146 set
3147 (map (comp count set))
3148 frequencies))))
3149
3150
3151(= (find-latin-squares
3152 '[[A B C D]
3153 [A C D B]
3154 [B A D C]
3155 [D C A B]])
3156 {})
3157
3158(= (find-latin-squares
3159 '[[A B C D E F]
3160 [B C D E F A]
3161 [C D E F A B]
3162 [D E F A B C]
3163 [E F A B C D]
3164 [F A B C D E]])
3165 {6 1})
3166
3167(= (find-latin-squares
3168 '[[A B C D]
3169 [B A D C]
3170 [D C B A]
3171 [C D A B]])
3172 {4 1, 2 4})
3173
3174(= (find-latin-squares
3175 '[[B D A C B]
3176 [D A B C A]
3177 [A B C A B]
3178 [B C A B C]
3179 [A D B C A]])
3180 {3 3})
3181
3182(= (find-latin-squares
3183 [ [2 4 6 3]
3184 [3 4 6 2]
3185 [6 2 4] ])
3186 {})
3187
3188(= (find-latin-squares
3189 [[1]
3190 [1 2 1 2]
3191 [2 1 2 1]
3192 [1 2 1 2]
3193 [] ])
3194 {2 2})
3195
3196(= (find-latin-squares
3197 [[3 1 2]
3198 [1 2 3 1 3 4]
3199 [2 3 1 3] ])
3200 {3 1, 2 2})
3201
3202(= (find-latin-squares
3203 [[8 6 7 3 2 5 1 4]
3204 [6 8 3 7]
3205 [7 3 8 6]
3206 [3 7 6 8 1 4 5 2]
3207 [1 8 5 2 4]
3208 [8 1 2 4 5]])
3209 {4 1, 3 1, 2 7})
3210;; @@
3211;; =>
3212;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
3213;; <=
3214
3215;; @@
3216;; Veitch, Please!
3217;; Difficulty: Hard
3218;; Topics: math circuit-design
3219
3220
3221;; Create a function which accepts as input a boolean algebra function in the form of a set of sets, where the inner sets are collections of symbols corresponding to the input boolean variables which satisfy the function (the inputs of the inner sets are conjoint, and the sets themselves are disjoint... also known as canonical minterms). Note: capitalized symbols represent truth, and lower-case symbols represent negation of the inputs. Your function must return the minimal function which is logically equivalent to the input.
3222
3223;; PS — You may want to give this a read before proceeding: K-Maps
3224
3225
3226(defn veitch [terms]
3227 (letfn [(mrg [ret [a b]]
3228 (let [ab (clojure.set/intersection a b)]
3229 (if (and (= (count ab) (dec (count a)))
3230 (= (.toLowerCase (str (first (clojure.set/difference a ab))))
3231 (.toLowerCase (str (first (clojure.set/difference b ab))))))
3232 (disj (conj ret ab) a b)
3233 ret)))
3234 (reduce-pairwise [terms]
3235 (let [v (vec terms)]
3236 (reduce mrg
3237 terms
3238 (for [i (range (count v))
3239 j (range (inc i) (count v))]
3240 [(v i) (v j)]))))
3241 (tautology? [expr]
3242 (let [vars (apply clojure.set/union expr)
3243 complement* {'a 'A 'A 'A 'b 'B 'B 'b 'C
3244 'c 'c 'C 'd 'D 'D 'd}]
3245 (and (not (empty? vars))
3246 (every? #(contains? vars (complement* %)) vars))))
3247 (remove-tautologies [expr]
3248 (reduce (fn [ret term]
3249 (let [e (->> (disj ret term)
3250 (map (fn [t] (clojure.set/difference t term)))
3251 set)]
3252 (if (tautology? e) (disj ret term) ret)))
3253 expr
3254 expr))]
3255 (->> terms
3256 (iterate reduce-pairwise)
3257 (partition 2 1)
3258 (drop-while (partial apply not=))
3259 ffirst
3260 remove-tautologies)))
3261
3262
3263
3264
3265(= (veitch
3266 #{#{'a 'B 'C 'd}
3267 #{'A 'b 'c 'd}
3268 #{'A 'b 'c 'D}
3269 #{'A 'b 'C 'd}
3270 #{'A 'b 'C 'D}
3271 #{'A 'B 'c 'd}
3272 #{'A 'B 'c 'D}
3273 #{'A 'B 'C 'd}})
3274 #{#{'A 'c}
3275 #{'A 'b}
3276 #{'B 'C 'd}})
3277
3278(= (veitch
3279 #{#{'A 'B 'C 'D}
3280 #{'A 'B 'C 'd}})
3281 #{#{'A 'B 'C}})
3282
3283(= (veitch
3284 #{#{'a 'b 'c 'd}
3285 #{'a 'B 'c 'd}
3286 #{'a 'b 'c 'D}
3287 #{'a 'B 'c 'D}
3288 #{'A 'B 'C 'd}
3289 #{'A 'B 'C 'D}
3290 #{'A 'b 'C 'd}
3291 #{'A 'b 'C 'D}})
3292 #{#{'a 'c}
3293 #{'A 'C}})
3294
3295
3296
3297(= (veitch
3298 #{#{'a 'b 'c}
3299 #{'a 'B 'c}
3300 #{'a 'b 'C}
3301 #{'a 'B 'C}})
3302 #{#{'a}})
3303
3304
3305(= (veitch
3306 #{#{'a 'B 'c 'd}
3307 #{'A 'B 'c 'D}
3308 #{'A 'b 'C 'D}
3309 #{'a 'b 'c 'D}
3310 #{'a 'B 'C 'D}
3311 #{'A 'B 'C 'd}})
3312 #{#{'a 'B 'c 'd}
3313 #{'A 'B 'c 'D}
3314 #{'A 'b 'C 'D}
3315 #{'a 'b 'c 'D}
3316 #{'a 'B 'C 'D}
3317 #{'A 'B 'C 'd}})
3318
3319(= (veitch
3320 #{#{'a 'b 'c 'd}
3321 #{'a 'B 'c 'd}
3322 #{'A 'B 'c 'd}
3323 #{'a 'b 'c 'D}
3324 #{'a 'B 'c 'D}
3325 #{'A 'B 'c 'D}})
3326 #{#{'a 'c}
3327 #{'B 'c}})
3328
3329(= (veitch
3330 #{#{'a 'B 'c 'd}
3331 #{'A 'B 'c 'd}
3332 #{'a 'b 'c 'D}
3333 #{'a 'b 'C 'D}
3334 #{'A 'b 'c 'D}
3335 #{'A 'b 'C 'D}
3336 #{'a 'B 'C 'd}
3337 #{'A 'B 'C 'd}})
3338 #{#{'B 'd}
3339 #{'b 'D}})
3340
3341(= (veitch
3342 #{#{'a 'b 'c 'd}
3343 #{'A 'b 'c 'd}
3344 #{'a 'B 'c 'D}
3345 #{'A 'B 'c 'D}
3346 #{'a 'B 'C 'D}
3347 #{'A 'B 'C 'D}
3348 #{'a 'b 'C 'd}
3349 #{'A 'b 'C 'd}})
3350 #{#{'B 'D}
3351 #{'b 'd}})
3352
3353
3354;; @@
3355;; =>
3356;;; {"type":"html","content":"<span class='clj-unkown'>true</span>","value":"true"}
3357;; <=
3358
3359;; @@
3360
3361;; @@