yveszoundi / 4clojure Answers
Programming Languages
Labels
Projects that are alternatives of or similar to 4clojure Answers
#+TITLE: README #+Options: num:nil #+STARTUP: odd #+Style: <style> h1,h2,h3 {font-family: arial, helvetica, sans-serif} </style> #+STYLE: #+INFOJS_OPT: view:nil toc:t ltoc:t mouse:underline buttons:0 path:http://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/2.0.3/bootstrap.min.js
-
Overview Answers to some of [[http://4clojure.com/][4clojure.com]] questions.
It looks like there are some broken questions or gaps between questions sometimes.
I did couple of problems and I believe that most of my current basic issues
are related to :
- writing non idiomatic code (tendency to think in Java)
- Graph manipulations/traversal in a pure functional way.
- TBD to move forward
- Do "real" Clojure books reading, as reading is fundamental.
- I have a basic Compojure application that I should finish: I've been looking at it about once a month for a while... (Compojure, Korma, Java JCE, etc.)
- Need to master about macros well enough.
- Need to explore stuff such as core.async, transducers, transients, etc.
- Need to do more puzzles, as my background isn't pure computer science or engineering.
- Problem 1
Nothing but the Truth
#+begin_src clojure ;; This is a clojure form. ;; Enter a value which will make the form evaluate to true. ;; Don't over think it! If you are confused, see the ;; getting started page. ;; Hint: true is equal to true. ;; (= __ true) (= true true) #+end_src
- Problem 2
Simple Math
#+begin_src clojure ;;
If you are not familiar with ;; polish notation ;; , simple arithmetic might seem confusing.
Note: ;; Enter only enough to fill in the blank ;; (in this case, a single number) - do not retype the whole problem.
;; (= (- 10 (* 2 3)) __) (= (- 10 (* 2 3)) 4) #+end_src- Problem 3
Intro to Strings
#+begin_src clojure
;; Clojure strings are Java strings.
;; This means that you can use any of the Java string methods on Clojure strings.
;; (= __ (.toUpperCase "hello world"))
(= "HELLO WORLD" (.toUpperCase "hello world"))
#+end_src
- Problem 4
Intro to Lists
#+begin_src clojure ;; Lists can be constructed with either a function or a quoted form. ;; (= (list __) '(:a :b :c)) (= (list :a :b :c) '(:a :b :c)) #+end_src
- Problem 5
Lists: conj
#+begin_src clojure ;; When operating on a list, the conj function will return ;; a new list with one or more items "added" to the front. ;; (= __ (conj '(2 3 4) 1)) (= '(1 2 3 4) (conj '(2 3 4) 1)) #+end_src
- Problem 6
Intro to Vectors
#+begin_src clojure ;; Vectors can be constructed several ways. You can compare them with lists. ;; (= [__] (list :a :b :c) (vec '(:a :b :c)) (vector :a :b :c)) (= [:a :b :c] (list :a :b :c) (vec '(:a :b :c)) (vector :a :b :c)) #+end_src
- Problem 7
Vectors: conj
#+begin_src clojure ;; When operating on a Vector, the conj function will return a new vector with one or ;; more items "added" to the end. ;; (= __ (conj [1 2 3] 4)) (= [ 1 2 3 4] (conj [1 2 3] 4)) #+end_src
- Problem 8
Intro to Sets
#+begin_src clojure ;; Sets are collections of unique values. ;; (= __ (set '(:a :a :b :c :c :c :c :d :d))) (= #{:a :b :c :d} (set '(:a :a :b :c :c :c :c :d :d))) #+end_src
- Problem 9
Sets: conj
#+begin_src clojure ;; When operating on a set, the conj function returns a new set with one or more keys ;; "added". ;; (= #{1 2 3 4} (conj #{1 4 3} __)) (= #{1 2 3 4} (conj #{1 4 3} 2)) #+end_src
- Problem 10
Intro to Maps
#+begin_src clojure ;; Maps store key-value pairs. Both maps and keywords can be used as lookup functions. ;; Commas can be used to make maps more readable, but they are not required. ;; (= __ ((hash-map :a 10, :b 20, :c 30) :b)) (= 20 ((hash-map :a 10, :b 20, :c 30) :b)) #+end_src
- Problem 11
Maps: conj
#+begin_src clojure ;; When operating on a map, the conj function returns a new map with one or more ;; key-value pairs "added". ;; (= {:a 1, :b 2, :c 3} (conj {:a 1} __ [:c 3])) (= {:a 1, :b 2, :c 3} (conj {:a 1} {:b 2} [:c 3])) #+end_src
- Problem 12
Intro to Sequences
#+begin_src clojure ;; All Clojure collections support sequencing. You can operate on sequences with ;; functions like first, second, and last. ;; (= __ (first '(3 2 1))) (= 3 (first '(3 2 1))) #+end_src
- Problem 13
Sequences: rest
#+begin_src clojure ;; The rest function will return all the items of a sequence except the first. ;; (= __ (rest [10 20 30 40])) (= [20 30 40] (rest [10 20 30 40])) #+end_src
- Problem 14
Intro to Functions
#+begin_src clojure ;; Clojure has many different ways to create functions. ;; (= __ ((fn add-five [x] (+ x 5)) 3)) (= 8 ((fn add-five [x] (+ x 5)) 3)) #+end_src
- Problem 15
Double Down
#+begin_src clojure ;; Write a function which doubles a number. ;; (= (__ 2) 4) (defn double-num [n] (* n 2))
(clojure.test/testing "Write a function which doubles a number." (clojure.test/is (and (= (double-num 2) 4) (= (double-num 3) 6) (= (double-num 11) 22) (= (double-num 7) 14)))) #+end_src
- Problem 16
Hello World
#+begin_src clojure ;; Write a function which returns a personalized greeting. ;; (= (__ "Dave") "Hello, Dave!") (defn greet [someone] (format "Hello, %s!" someone))
(clojure.test/testing "Write a function which returns a personalized greeting." (clojure.test/is (and (= (greet "Dave") "Hello, Dave!") (= (greet "Jenn") "Hello, Jenn!") (= (greet "Rhea") "Hello, Rhea!")))) #+end_src
- Problem 17
Sequences: map
#+begin_src clojure ;; The map function takes two arguments: a function (f) and a sequence (s). ;; Map returns a new sequence consisting of the result of applying f to each item of s. ;; Do not confuse the map function with the map data structure. ;; (= __ (map #(+ % 5) '(1 2 3))) (= '( 6 7 8) (map #(+ % 5) '(1 2 3))) #+end_src
- Problem 18
Sequences: filter
#+begin_src clojure ;; The filter function takes two arguments: a predicate function (f) and a sequence (s). ;; Filter returns a new sequence consisting of all the items of s for which (f item) ;; returns true. ;; (= __ (filter #(> % 5) '(3 4 5 6 7))) (= '(6 7) (filter #(> % 5) '(3 4 5 6 7))) #+end_src
- Problem 19
Last Element
#+begin_src clojure ;; Write a function which returns the last element in a sequence. ;; Restrictions (please don't use these function(s)): last ;; (= (__ [1 2 3 4 5]) 5) (defn last-elem [[n & more]] (if more (recur more) n))
(clojure.test/testing
"Write a function which returns the second to last
element from a sequence."
(clojure.test/is (and
(= (last-elem [1 2 3 4 5]) 5)
(= (last-elem '(5 4 3)) 3)
(= (last-elem ["b" "c" "d"]) "d"))))
#+end_src
- Problem 20
Penultimate Element
#+begin_src clojure ;; Write a function which returns the second to last element from a sequence.
(defn second-to-last [[x & xs]] (if (= 1 (count xs)) x (recur xs)))
(clojure.test/testing "Write a function which returns the second to last element from a sequence." (clojure.test/is (and (= (second-to-last (list 1 2 3 4 5)) 4) (= (second-to-last ["a" "b" "c"]) "b") (= (second-to-last [[1 2] [3 4]]) [1 2])))) #+end_src
- Problem 21
Nth Element
#+begin_src clojure ;; Write a function which returns the Nth element from a sequence. ;; Restrictions (please don't use these function(s)): nth ;; (= (__ '(4 5 6 7) 2) 6)
(defn nth-element [[x & xs] idx] (if (= idx 0) x (recur xs (dec idx))))
(= (nth-element '(4 5 6 7) 2) 6) #+end_src
- Problem 22
Count a Sequence
#+begin_src clojure ;; Write a function which returns the total number of elements in a sequence. ;; Restrictions (please don't use these function(s)): count
(defn count-seq [xs] (reduce (fn [sum _] (inc sum)) 0 xs))
(and (= (count-seq '(1 2 3 3 1)) 5) (= (count-seq "Hello World") 11) (= (count-seq [[1 2] [3 4] [5 6]]) 3) (= (count-seq '(13)) 1) (= (count-seq '(:a :b :c)) 3)) #+end_src
- Problem 23
Reverse a Sequence
#+begin_src clojure ;; Write a function which reverses a sequence. ;; Restrictions (please don't use these function(s)): reverse, rseq ;; (= (__ [1 2 3 4 5]) [5 4 3 2 1]) (defn reverse-seq [xs] (into '() xs))
(clojure.test/testing "Write a function which reverses a sequence." (clojure.test/is (and (= (reverse-seq [1 2 3 4 5]) [5 4 3 2 1]) (= (reverse-seq (sorted-set 5 7 2 7)) '(7 5 2)) (= (reverse-seq [[1 2][3 4][5 6]]) [[5 6][3 4][1 2]])))) #+end_src
- Problem 24
Sum It All Up
#+begin_src clojure ;; Write a function which returns the sum of a sequence of numbers. ;; (= (__ [1 2 3]) 6) (defn sum-xs [xs] (reduce + xs))
(clojure.test/testing "Write a function which returns the sum of a sequence of numbers." (clojure.test/is (and (= (sum-xs [1 2 3]) 6) (= (sum-xs (list 0 -2 5 5)) 8) (= (sum-xs #{4 2 1}) 7) (= (sum-xs '(0 0 -1)) -1) (= (sum-xs '(1 10 3)) 14)))) #+end_src
- Problem 25
Find the odd numbers
#+begin_src clojure ;; Write a function which returns only the odd numbers from a sequence. ;; (= (__ #{1 2 3 4 5}) '(1 3 5)) (defn odd-numbers [xs] (filter odd? xs))
(clojure.test/testing "Only odd numbers." (clojure.test/is (= (odd-numbers #{1 2 3 4 5}) '(1 3 5)))) #+end_src
- Problem 26
Fibonacci Sequence
#+begin_src clojure ;; Write a function which returns the first X fibonacci numbers. ;; (= (__ 3) '(1 1 2)) (defn fib [n] {:pre [(pos? n)]} (letfn [(fibonacci [a b] (lazy-seq (cons (+ a b) (fibonacci b (+ a b)))))] (take n (cons 1 (fibonacci 0 1)))))
(clojure.test/testing "Write a function which returns the first X fibonacci numbers." (clojure.test/is (and (= (fib 3) '(1 1 2)) (= (fib 6) '(1 1 2 3 5 8)) (= (fib 8) '(1 1 2 3 5 8 13 21)))))
#+end_src
- Problem 27
Palindrome Detector
#+BEGIN_SRC clojure ;; Write a function which returns true if the given sequence is a palindrome. ;; Hint: "racecar" does not equal '(\r \a \c \e \c \a \r)
(defn palindrome? [xs]
(every? #(true? %) (map #(= %1 %2) xs (reverse xs))))
(and
(false? (palindrome? '(1 2 3 4 5)))
(true? (palindrome? "racecar"))
(true? (palindrome? [:foo :bar :foo]))
(true? (palindrome? '(1 1 3 3 1 1)))
(false? (palindrome? '(:a :b :c))))
#+END_SRC
- Problem 28
Flatten a Sequence
#+BEGIN_SRC clojure ;; Write a function which flattens a sequence. ;; Restrictions (please don't use these function(s)): flatten
(defn my-flatten [xs]
(lazy-seq
(reduce (fn --internal-flatten [col v]
(if (sequential? v)
(reduce --internal-flatten col v)
(conj col v)))
[]
xs)))
(and (= (my-flatten '((1 2) 3 [4 [5 6]])) '(1 2 3 4 5 6))
(= (my-flatten ["a" ["b"] "c"]) '("a" "b" "c"))
(= (my-flatten '((((:a))))) '(:a)))
#+END_SRC
- Problem 29
Get the Caps
#+begin_src clojure ;; Write a function which takes a string and returns a new string containing only ;; the capital letters. ;; (= (__ "HeLlO, WoRlD!") "HLOWRD") (defn only-caps [s] (reduce str (filter #(Character/isUpperCase %1) s)))
(clojure.test/testing "Write a function which takes a string and returns a new string containing only the capital letters." (clojure.test/is (and (= (only-caps "HeLlO, WoRlD!") "HLOWRD") (empty? (only-caps "nothing")) (= (only-caps "$#A(*&987Zf") "AZ"))))
#+end_src
- Problem 30
Compress a Sequence
#+BEGIN_SRC clojure ;; Write a function which removes consecutive duplicates from a sequence.
;; maybe more elegant and idiomatic, do not thing it is faster than
;; the first reduce version though but did not time it.
(defn del-consecutive-dups [col]
(mapcat set (#(partition-by identity %1) col)))
(and (= (apply str (del-consecutive-dups "Leeeeeerrroyyy")) "Leroy")
(= (del-consecutive-dups [1 1 2 3 3 2 2 3]) '(1 2 3 2 3))
(= (del-consecutive-dups [[1 2] [1 2] [3 4] [1 2]]) '([1 2] [3 4] [1 2])))
#+END_SRC
- Problem 31
Pack a Sequence
#+BEGIN_SRC clojure ;; Write a function which packs consecutive duplicates into sub-lists.
;; Took more than few mins for something so simple
;; I'm not fluent yet with group-by vs split-width vs partition
(defn partition-dups [col]
(partition-by identity col))
(and
(= (partition-dups [1 1 2 1 1 1 3 3]) '((1 1) (2) (1 1 1) (3 3)))
(= (partition-dups [:a :a :b :b :c]) '((:a :a) (:b :b) (:c)))
(= (partition-dups [[1 2] [1 2] [3 4]]) '(([1 2] [1 2]) ([3 4]))))
#+END_SRC
- Problem 32
Duplicate a Sequence
#+BEGIN_SRC clojure ;; Write a function which duplicates each element of a sequence.
(defn dup-each-item [xs]
(reduce #(apply conj %1 (list %2 %2)) [] xs))
(and
(= (dup-each-item [1 2 3]) '(1 1 2 2 3 3))
(= (dup-each-item [:a :a :b :b]) '(:a :a :a :a :b :b :b :b))
(= (dup-each-item [[1 2] [3 4]]) '([1 2] [1 2] [3 4] [3 4]))
(= (dup-each-item [[1 2] [3 4]]) '([1 2] [1 2] [3 4] [3 4])))
#+END_SRC
- Problem 33
Replicate a Sequence
#+BEGIN_SRC clojure ;; Write a function which replicates each element ;; of a sequence a variable number of times.
(defn replicate-each-item [col n-times]
(mapcat #(repeat n-times %1) col))
(and (= (replicate-each-item [1 2 3] 2) '(1 1 2 2 3 3))
(= (replicate-each-item [:a :b] 4) '(:a :a :a :a :b :b :b :b))
(= (replicate-each-item [4 5 6] 1) '(4 5 6))
(= (replicate-each-item [[1 2] [3 4]] 2) '([1 2] [1 2] [3 4] [3 4]))
(= (replicate-each-item [44 33] 2) [44 44 33 33]))
#+END_SRC
- Problem 34
Implement range
#+begin_src clojure ;; Write a function which creates a list of all integers in a given range. ;; Restrictions (please don't use these function(s)): range ;; (= (__ 1 4) '(1 2 3)) (defn find-range [start end] (take (- end start) (iterate inc start)))
(clojure.test/testing "Write a function which creates a list of all integers in a given range." (clojure.test/is (and (= (find-range 1 4) '(1 2 3)) (= (find-range -2 2) '(-2 -1 0 1)) (= (find-range 5 8) '(5 6 7))))) #+end_src
- Problem 35
Local bindings
#+begin_src clojure ;; Clojure lets you give local names to values using the special let-form. ;; (= __ (let [x 5] (+ 2 x))) ;; (= __ (let [x 3, y 10] (- y x))) ;; (= __ (let [x 21] (let [y 3] (/ x y)))) (clojure.test/testing "Clojure lets you give local names to values using the special let-form." (clojure.test/is (and (= 7 (let [x 5] (+ 2 x))) (= 7 (let [x 3 y 10] (- y x))) (= 7 (let [x 21] (let [y 3] (/ x y)))))))
#+end_src
- Problem 36
Let it Be
#+begin_src clojure ;; Can you bind x, y, and z so that these are all true? ;; (= 10 (let __ (+ x y))) ;; (= 4 (let __ (+ y z))) ;; (= 1 (let __ z)) (clojure.test/testing "Can you bind x, y, and z so that these are all true?" (clojure.test/is (and (= 10 (let [x 7 y 3 z 1] (+ x y))) (= 4 (let [x 7 y 3 z 1] (+ y z))) (= 1 (let [x 7 y 3 z 1] z))))) #+end_src
- Problem 37
Regular Expressions
#+BEGIN_SRC clojure ;; Regex patterns are supported with a special reader macro. (= "ABC" (apply str (re-seq #"[A-Z]+" "bA1B3Ce "))) #+END_SRC
- Problem 38
Maximum value
#+begin_src clojure ;; Write a function which takes a variable number of parameters ;; and returns the maximum value. ;; Restrictions (please don't use these function(s)): max, max-key
(defn max-value [x & xs] (reduce (fn [x y] (if (pos? (.compareTo y x)) y x)) x xs))
(clojure.test/testing "Write a function which takes a variable number of parameters and returns the maximum value." (clojure.test/is (and (= (max-value 1 8 3 4) 8) (= (max-value 30 20) 30) (= (max-value 45 67 11) 67))))
#+end_src
- Problem 39
Interleave Two Seqs
#+begin_src clojure ;; Write a function which takes two sequences and ;; returns the first item from each, then the second item ;; from each, then the third, etc. ;; Restrictions (please don't use these function(s)): interleave
(defn my-interleave [x1 x2] (lazy-seq (when-not (or (empty? x1) (empty? x2)) (cons (first x1) (cons (first x2) (my-interleave (rest x1) (rest x2)))))))
(and (= (my-interleave [1 2 3] [:a :b :c]) '(1 :a 2 :b 3 :c)) (= (my-interleave [1 2] [3 4 5 6]) '(1 3 2 4)) (= (my-interleave [1 2 3 4] [5]) [1 5]) (= (my-interleave [30 20] [25 15]) [30 25 20 15]))
#+end_src
- Problem 40
Interpose a Seq
#+BEGIN_SRC clojure ;; Write a function which separates the items ;; of a sequence by an arbitrary value. ;; ;; Restrictions (please don't use these function(s)): ;; interpose
(defn my-interpose [delimiter [x & more]]
(lazy-seq
(when x
(if more
(cons x (cons delimiter (my-interpose delimiter more)))
(cons x nil)))))
(and
(= (my-interpose 0 [1 2 3]) [1 0 2 0 3])
(= (apply str (my-interpose ", " ["one" "two" "three"])) "one, two, three")
(= (my-interpose :z [:a :b :c :d]) [:a :z :b :z :c :z :d]))
#+END_SRC
- Problem 41
Drop Every Nth Item
#+BEGIN_SRC clojure ;; Write a function which drops every Nth item from a sequence.
;; simplistic approach no accumulator in a loop or similar
;; try to write more idiomatic code first.
(defn my-drop-every [col n]
(when col
(lazy-cat (take (dec n) col) (my-drop-every (nthnext col n) n))))
(and
(= (my-drop-every [1 2 3 4 5 6 7 8] 3) [1 2 4 5 7 8])
(= (my-drop-every [:a :b :c :d :e :f] 2) [:a :c :e])
(= (my-drop-every [1 2 3 4 5 6] 4) [1 2 3 5 6]))
#+END_SRC
- Problem 42
Factorial Fun
#+begin_src clojure ;; Write a function which calculates factorials. (defn factorial [n] (reduce * (range 1 (inc n))))
(clojure.test/testing "Write a function which calculates factorials." (clojure.test/is (and (= (factorial 1) 1) (= (factorial 3) 6) (= (factorial 5) 120) (= (factorial 8) 40320))))
#+end_src
- Problem 43
Reverse Interleave
#+BEGIN_SRC clojure ;; Write a function which reverses the interleave ;; process into x number of subsequences.
(defn reverse-interleave [xs n]
(letfn [(stepper [col nb-items step limit]
(when (pos? limit)
(cons (take nb-items (take-nth step col))
(stepper (next col) nb-items step (dec limit)))))]
(stepper xs (/ (count xs) n) n n)))
(and (= (reverse-interleave [1 2 3 4 5 6] 2) '((1 3 5) (2 4 6)))
(= (reverse-interleave (range 9) 3) '((0 3 6) (1 4 7) (2 5 8)))
(= (reverse-interleave (range 10) 5) '((0 5) (1 6) (2 7) (3 8) (4 9))))
#+END_SRC
- Problem 44
Rotate Sequence
#+BEGIN_SRC clojure ;; Write a function which can rotate a sequence in either direction.
(defn rotate-xs [dir xs]
(let [ln (count xs)]
(if (pos? dir)
(take ln (drop dir (cycle xs)))
(take ln (drop (- ln (mod (* dir -1) ln)) (cycle xs))))))
(and (= (rotate-xs 2 [1 2 3 4 5]) '(3 4 5 1 2))
(= (rotate-xs -2 [1 2 3 4 5]) '(4 5 1 2 3))
(= (rotate-xs 6 [1 2 3 4 5]) '(2 3 4 5 1))
(= (rotate-xs 1 '(:a :b :c)) '(:b :c :a))
(= (rotate-xs -4 '(:a :b :c)) '(:c :a :b)))
#+END_SRC
- Problem 45
Intro to Iterate
#+begin_src clojure ;; The iterate function can be used to produce an infinite lazy sequence. ;; (= __ (take 5 (iterate #(+ 3 %) 1))) (= '(1 4 7 10 13) (take 5 (iterate #(+ 3 %) 1))) #+end_src
- Problem 46
Flipping out
#+begin_src clojure ;; Write a higher-order function which flips the order ;; of the arguments of an input function.
(defn flip-args [f] (fn [& args] (apply f (reverse args))))
(clojure.test/testing "Write a higher-order function which flips the order of the arguments of an input function." (clojure.test/is (and (= 3 ((flip-args nth) 2 [1 2 3 4 5])) (= true ((flip-args >) 7 8)) (= 4 ((flip-args quot) 2 8)) (= [1 2 3] ((flip-args take) [1 2 3 4 5] 3))))) #+end_src
- Problem 47
Contain Yourself
#+begin_src clojure ;; 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. (contains? #{4 5 6} 4) (contains? [1 1 1 1 1] 1) (contains? {4 :a 2 :b} 2) #+end_src
- Problem 48
Intro to some
#+begin_src clojure ;; 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. (= 6 (some #{2 7 6} [5 6 7 8])) (= 6 (some #(when (even? %) %) [5 6 7 8])) #+end_src
- Problem 49
Split a sequence
#+begin_src clojure ;; Write a function which will split a sequence into two parts.;; ;; Restrictions (please don't use these function(s)): split-at
;; Initial implementation used (vector (take n xs) (drop n xs))) ;; traverses twice the sequence... (defn my-split-at [n xs] ((fn step [acc xs idx limit] (if (= idx limit) (conj [] acc (into [] xs)) (step (conj acc (first xs)) (next xs) (inc idx) limit))) [] xs 0 n))
(clojure.test/testing "Write a function which will split a sequence into two parts." (clojure.test/is (and (= (my-split-at 3 [1 2 3 4 5 6]) [[1 2 3] [4 5 6]]) (= (my-split-at 1 [:a :b :c :d]) [[:a] [:b :c :d]]) (= (my-split-at 2 [[1 2] [3 4] [5 6]]) [[[1 2] [3 4]] [[5 6]]])))) #+end_src
- Problem 50
Split by Type
#+BEGIN_SRC clojure ;; Write a function which takes a sequence consisting of items ;; with different types and splits them up into a set of ;; homogeneous sub-sequences. The internal order of each ;; sub-sequence should be maintained, but the sub-sequences ;; themselves can be returned in any order (this is why ;; 'set' is used in the test cases).
(defn type-partition [col]
(vals (group-by #(type %1) col)))
(and
(= (set (type-partition [1 :a 2 :b 3 :c])) #{[1 2 3] [:a :b :c]})
(= (set (type-partition [:a "foo" "bar" :b])) #{[:a :b] ["foo" "bar"]})
(= (set (type-partition [[1 2] :a [3 4] 5 6 :b])) #{[[1 2] [3 4]] [:a :b] [5 6]}))
#+END_SRC
- Problem 51
Advanced Destructuring
#+BEGIN_SRC clojure ;; Problem 51 ;; ;; Here is an example of some more sophisticated destructuring.
(= [1 2 [3 4 5] [1 2 3 4 5]] (let [[a b & c :as d] [1 2 3 4 5]] [a b c d]))
#+END_SRC
- Problem 52
Intro to Destructuring
#+begin_src clojure ;; Problem 52 ;; ;; Let bindings and function parameter lists support destructuring.
(= [2 4] (let [[a b c d e f g] (range)] [c e])) #+end_src
- Problem 53
Longest Increasing Sub-Seq
#+BEGIN_SRC clojure ;; 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. ;;
(defn lis [xs]
(letfn [(make-piles [col]
(reduce (fn [acc num]
(let [xs (last acc)]
(if (or (nil? xs) (<= num (peek xs)))
(conj acc [num])
(assoc acc (dec (count acc)) (conj xs num)))))
[] col))
(max-seq [piles]
(or (first (filter #(>= (count %1) 2) (sort-by count > piles))) '()))]
(-> (make-piles xs) (max-seq))))
(and (= (lis [1 0 1 2 3 0 4 5]) [0 1 2 3])
(= (lis [5 6 1 3 2 7]) [5 6])
(= (lis [2 3 3 4 5]) [3 4 5])
(= (lis [7 6 5 4]) []))
#+END_SRC
- Problem 54
Partition a Sequence
#+BEGIN_SRC clojure ;; Write a function which returns a sequence of lists of x items each. ;; Lists of less than x items should not be returned. ;; ;; Restrictions (please don't use these function(s)): partition, partition-all
(defn my-partition [n c]
(lazy-seq
(when (>= (count c) n)
(cons (take n c) (my-partition n (nthnext c n))))))
(and
(= (my-partition 3 (range 9)) '((0 1 2) (3 4 5) (6 7 8)))
(= (my-partition 2 (range 8)) '((0 1) (2 3) (4 5) (6 7)))
(= (my-partition 3 (range 8)) '((0 1 2) (3 4 5))))
#+END_SRC
- Problem 55
Count Occurrences
#+begin_src clojure (defn map-frequencies "Map occurrences of numbers. Should not use frequencies function." [xs] (reduce (fn [m i] (assoc m i (inc (m i 0)))) {} xs))
(clojure.test/testing "Write a function which returns a map containing the number of occurences of each distinct item in a sequence." (clojure.test/is (and (= (map-frequencies [1 1 2 3 2 1 1]) {1 4, 2 2, 3 1}) (= (map-frequencies [:b :a :b :a :b]) {:a 2, :b 3}) (= (map-frequencies '([1 2] [1 3] [1 3])) {[1 2] 1, [1 3] 2})))) #+end_src
- Problem 56
Find Distinct Items
#+begin_src clojure ;; Find Distinct Items ;; Difficulty: Medium ;; Topics: seqs core-functions (defn only-distinct [col] (reduce (fn [xs item] (if (some #(= item %1) xs) xs (conj xs item))) [] col))
(clojure.test/testing "Write a function which removes the duplicates from a sequence. Order of the items must be maintained." (clojure.test/is (and (= (only-distinct [1 2 1 3 1 2 4]) [1 2 3 4]) (= (only-distinct [:a :a :b :b :c :c]) [:a :b :c]) (= (only-distinct '([2 4] [1 2] [1 3] [1 3])) '([2 4] [1 2] [1 3])) (= (only-distinct (range 50)) (range 50))))) #+end_src
- Problem 57
Simple Recursion
#+begin_src clojure ;; Simple Recursion ;; Difficulty: Elementary ;;Topics: recursion (clojure.test/testing "A recursive function is a function which calls itself. This is one of the fundamental techniques used in functional programming." (clojure.test/is (= '(5 4 3 2 1) ((fn foo [x] (when (> x 0) (conj (foo (dec x)) x))) 5)))) #+end_src
- Problem 58
Function Composition
#+begin_src clojure ;; Write a function which allows you to create function compositions. ;; The parameter list should take a variable number of functions, ;; and create a function applies them from right-to-left. ;; ;; Restrictions (please don't use these function(s)): comp (defn compclj [& fs] (fn [& args] (reduce #(apply %2 (list %1)) args (reverse fs))))
(clojure.test/testing "Write a function which allows you to create function compositions. The parameter list should take a variable number of functions, and create a function applies them from right-to-left." (clojure.test/is (and (= [3 2 1] ((compclj rest reverse) [1 2 3 4])) (= 5 ((compclj (partial + 3) second) [1 2 3 4]) (= true ((compclj zero? #(mod % 8) +) 3 5 7 9)) (= "HELLO" ((compclj #(.toUpperCase %) #(apply str %) take) 5 "hello world")))))) #+end_src
- Problem 59
Juxtaposition
#+BEGIN_SRC clojure ;; Take a set of functions and return a new function ;; that takes a variable number of arguments and ;; returns a sequence containing the result of ;; applying each function left-to-right to the argument list. ;; ;; Restrictions (please don't use these function(s)): juxt
(defn map-apply [& fs]
(fn [& args]
(map #(apply %1 args) fs)))
(and (= [21 6 1] ((map-apply + max min) 2 3 5 1 6 4))
(= ["HELLO" 5] ((map-apply #(.toUpperCase %) count) "hello"))
(= [2 6 4] ((map-apply :a :c :b) {:a 2, :b 4, :c 6, :d 8 :e 10})))
#+END_SRC
- Problem 60
Sequence Reductions
#+begin_src clojure (defn my-reductions ([f col] (my-reductions f (first col) (rest col))) ([f init col] (cons init (lazy-seq (if (empty? col) nil (my-reductions f (apply f (list init (first col))) (rest col)))))))
(clojure.test/testing "Problem 60. Write a function which behaves like reduce, but returns each intermediate value of the reduction. Your function must accept either two or three arguments, and the return sequence must be lazy." (clojure.test/is (and (= (take 5 (my-reductions + (range))) [0 1 3 6 10]) (= (my-reductions conj [1] [2 3 4]) [[1] [1 2] [1 2 3] [1 2 3 4]]) (= (last (my-reductions * 2 [3 4 5])) (reduce * 2 [3 4 5]) 120)))) #+end_src
- Problem 61
Map Construction
#+begin_src clojure (defn do-zipmap [ks vs] (apply hash-map (interleave ks vs)))
(clojure.test/testing "Problem 61. Write a function which takes a vector of keys and a vector of values and constructs a map from them. Restrictions (please don't use these function(s)): zipmap." (clojure.test/is (and (= (do-zipmap [:a :b :c] [1 2 3]) {:a 1, :b 2, :c 3}) (= (do-zipmap [1 2 3 4] ["one" "two" "three"]) {1 "one", 2 "two", 3 "three"}) (= (do-zipmap [:foo :bar] ["foo" "bar" "baz"]) {:foo "foo", :bar "bar"})))) #+end_src
- Problem 62
Re-implement Iterate
#+begin_src clojure ;; 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. (defn do-iterate [f x] (cons x (lazy-seq (do-iterate f (f x)))))
(clojure.test/testing "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." (clojure.test/is (and (= (take 5 (do-iterate #(* 2 %) 1)) [1 2 4 8 16]) (= (take 100 (do-iterate inc 0)) (take 100 (range))) (= (take 9 (do-iterate #(inc (mod % 3)) 1)) (take 9 (cycle [1 2 3])))))) #+end_src
- Problem 63
Group a Sequence
#+begin_src clojure ;; 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.
(defn do-group-by [f s] (reduce (fn [m i] (assoc m (f i) (conj (m (f i) []) i))) {} s))
(and (= (do-group-by #(> % 5) [1 3 6 8]) {false [1 3], true [6 8]}) (= (do-group-by #(apply / %) [[1 2] [2 4] [4 6] [3 6]]) {1/2 [[1 2] [2 4] [3 6]], 2/3 [[4 6]]}) (= (do-group-by count [[1] [1 2] [3] [1 2 3] [2 3]]) {1 [[1] [3]], 2 [[1 2] [2 3]], 3 [[1 2 3]]})) #+end_src
- Problem 64
Intro to Reduce
#+begin_src clojure (clojure.test/testing "Reduce takes a 2 argument function and an optional starting value. It then applies the function to the first 2 items in the sequence (or the starting value and the first element of the sequence). In the next iteration the function will be called on the previous return value and the next item from the sequence, thus reducing the entire collection to one value. Don't worry, it's not as complicated as it sounds." (clojure.test/is (and (= 15 (reduce #'+ [1 2 3 4 5])) (= 0 (reduce #'+ [])) (= 6 (reduce #'+ 1 [2 3]))))) #+end_src
- Problem 65
Black Box Testing
#+begin_src clojure
;; "Clojure has many sequence types, which act in subtly different ways.
;; The core functions typically convert them into a uniform "sequence"
;; type and work with them that way, but it can be important to understand
;; the behavioral and performance differences so that you know which kind
;; is appropriate for your application.
Write a function which
;; takes a collection and returns one of :map, :set, :list, or :vector -
;; describing the type of collection it was given.
You won't be allowed
;; to inspect their class or use the built-in predicates like list? - the
;; point is to poke at them and understand their behavior.
;;
;; Restrictions (please don't use these function(s)): class, type, Class,
;; vector?, sequential?, list?, seq?, map?, set?, instance?, getClass"
(defn lookup-type [obj] (let [a [1 1] result (conj obj a)] (cond (and (not (associative? obj)) (= (conj result a) result)) :set (and (associative? obj) (identical? (conj result a) result)) :map (and (not (associative? obj)) (identical? (first result) a)) :list (and (associative? obj) (identical? (last result) a)) :vector :else (throw (IllegalArgumentException. "Unknown collection type!")))))
(and (= :map (lookup-type {:a 1, :b 2})) (= :list (lookup-type (range (rand-int 20)))) (= :vector (lookup-type [1 2 3 4 5 6])) (= :set (lookup-type #{10 (rand-int 5)})) (= [:map :set :vector :list] (map lookup-type [{} #{} [] ()])))
#+end_src
- Problem 66
Greatest Common Divisor
#+begin_src clojure (defn gcd "Greatest common dividor of 2 numbers. See http://en.wikipedia.org/wiki/Greatest_common_divisor" [a b] (cond (or (= 0 a) (= 0 b)) 0 ( = a b) a (> a b) (recur (- a b) b) :else (recur a (- b a))))
(clojure.test/testing "Given two integers, write a function which returns the greatest common divisor." (clojure.test/is (and (= (gcd 2 4) 2) (= (gcd 10 5) 5) (= (gcd 5 7) 1) (= (gcd 1023 858) 33)))) #+end_src
- Problem 67
Prime Numbers
#+begin_src clojure ;; Write a function which returns the first x ;; number of prime numbers.
(defn prime-sieve "Prime sieve" ([] (letfn [(add-prime? [candidate primes] (let [narrowed-primes (reduce-primes-set candidate primes)] (if (empty? narrowed-primes) candidate (recur (next-prime-candidate candidate) primes))))
(reduce-primes-set [candidate primes-set]
(let [max-val (inc (long (Math/ceil (Math/sqrt candidate))))]
(for [i primes-set :while (< i max-val)
:when (zero? (mod candidate i))] i)))
(next-prime-candidate [current-candidate]
(+ 2 current-candidate))
(gen-primes [candidate acc]
(lazy-seq
(let [next-prime (add-prime? candidate acc)]
(cons next-prime
(gen-primes (next-prime-candidate next-prime)
(conj acc next-prime))))))]
(cons 2 (gen-primes 3 [2]))))
([n]
(take n (prime-sieve))))
(and (= (prime-sieve 2) [2 3]) (= (prime-sieve 5) [2 3 5 7 11]) (= (last (prime-sieve 100)) 541)) #+end_src
- Problem 68
Recurring Theme
#+BEGIN_SRC clojure ;; Clojure only has one non-stack-consuming looping construct: recur. ;; Either a function or a loop can be used as the recursion point. ;; Either way, recur rebinds the bindings of the recursion point ;; to the values it is passed. ;; ;; Recur must be called from the tail-position, ;; and calling it elsewhere will result in an error.
(= [7 6 5 4 3]
(loop [x 5
result []]
(if (> x 0)
(recur (dec x) (conj result (+ 2 x)))
result)))
#+END_SRC
- Problem 69
Merge with a Function
#+BEGIN_SRC clojure ;; Write a function which takes a function f and a variable number of maps. ;; Your function should return a map that consists of the rest of the maps ;; conj-ed onto the first. If a key occurs in more than one map, ;; the mapping(s) from the latter (left-to-right) should be combined ;; with the mapping in the result by calling (f val-in-result val-in-latter) ;; ;; Restrictions (please don't use these function(s)): merge-with
(defn my-merge-with [f m & ms]
(if (empty? ms)
m
(let [new-m (reduce (fn [acc [k v]]
(if (acc k)
(assoc acc k (f (acc k) v))
(assoc acc k v)))
m
(first ms))]
(recur f new-m (rest ms)))))
(and
(= (my-merge-with * {:a 2, :b 3, :c 4} {:a 2} {:b 2} {:c 5})
{:a 4, :b 6, :c 20})
(= (my-merge-with - {1 10, 2 20} {1 3, 2 10, 3 15})
{1 7, 2 10, 3 15})
(= (my-merge-with concat {:a [3], :b [6]} {:a [4 5], :c [8 9]} {:b [7]})
{:a [3 4 5], :b [6 7], :c [8 9]}))
#+END_SRC
- Problem 70
Word Sorting
#+begin_src clojure (defn split-sentence [xs] (->> (re-seq #"\w+|\d+" xs) (sort-by #(.toLowerCase %))))
(clojure.test/testing "Write a function that splits a sentence up into a sorted list of words. Capitalization should not affect sort order and punctuation should be ignored." (clojure.test/is (and (= (split-sentence "Have a nice day.") ["a" "day" "Have" "nice"]) (= (split-sentence "Clojure is a fun language!") ["a" "Clojure" "fun" "is" "language"]) (= (split-sentence "Fools fall for foolish follies.") ["fall" "follies" "foolish" "Fools" "for"])))) #+end_src
- Problem 71
Rearranging Code: ->
#+BEGIN_SRC clojure ;; 4Clojure Question 71 ;; ;; The -> macro threads an expression x through a variable ;; number of forms. First, x is inserted as the second item ;; in the first form, making a list of it if it is not a ;; list already.
;; Then the first form is inserted as the second item in
;; the second form, making a list of that form if necessary.
;; This process continues for all the forms.
;; Using -> can sometimes make your code more readable.
;;
(= (last (sort (rest (reverse [2 5 4 1 3 6]))))
(-> [2 5 4 1 3 6] (reverse) (rest) (sort) (last))
5)
#+END_SRC
- Problem 72
Rearranging Code: ->>
#+BEGIN_SRC clojure ;; The ->> macro threads an expression x through a variable number of forms. ;; First, x is inserted as the last item in the first form, ;; making a list of it if it is not a list already. ;; Then the first form is inserted as the last item in the second form, ;; making a list of that form if necessary. ;; This process continues for all the forms. ;; Using ->> can sometimes make your code more readable.
(= (reduce + (map inc (take 3 (drop 2 [2 5 4 1 3 6]))))
(->> [2 5 4 1 3 6] (drop 2) (take 3) (map inc) (__))
11)
#+END_SRC
- Problem 73
Analyze a Tic-Tac-Toe Board
#+begin_src clojure ;; 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.
;; Other approach http://mathworld.wolfram.com/MagicSquare.html ;; - Map number to 0 for empty cells ;; - Leave number as is for :o ;; - Multiply the number by 2 for :x ;; - If the total of a row adds up to 15 :o wins, 30 :x wins otherwise nobody ;; (defn tic-tac-toe-winner-magic-square [board] ;; (let [magic-square [[8 1 6] [3 5 7] [4 9 2]]
;; make-groups (fn [board] ;; (let [max-col (count board), max-row (count (first board))] ;; (concat ;; (for [i (range max-col)] ;; (for [j (range max-row)] ((board i) j))) ;; (for [j (range max-row)] ;; (for [i (range max-col)] ((board i) j))) ;; [(for [i (range max-row)] ((board i) i))] ;; [(for [i (reverse (range max-row))] ;; ((board i) (dec (- max-row i))))])))
;; row-winner (fn [row] (case (reduce + row) 15 :o, 30 :x, nil))
;; cell-to-num (fn [cell mapped-cell] ;; (case cell :o mapped-cell, :x (* mapped-cell 2), 0))
;; transform-row (fn [matrix mapped-matrix] ;; (mapv (fn [row mapped-row] (cell-to-num row mapped-row)) ;; matrix mapped-matrix))
;; game-winner (fn [cell-groups winner] ;; (if (or winner (empty? cell-groups)) ;; winner ;; (recur (next cell-groups) (row-winner (first cell-groups)))))]
;; (let [num-matrix (mapv transform-row board magic-square) ;; cell-groups (make-groups num-matrix)] ;; (game-winner cell-groups nil))))
(defn tic-tac-toe-winner [board] (letfn [(make-groups [board] (let [max-col (count board) max-row (count (first board))] (concat (for [i (range max-col)] (for [j (range max-row)] ((board i) j))) (for [j (range max-row)] (for [i (range max-col)] ((board i) j))) [(for [i (range max-row)] ((board i) i))] [(for [i (reverse (range max-row))] ((board i) (dec (- max-row i))))])))
(game-winner [[cell-grp & cell-grps]]
(if-not cell-grp
nil
(if (and (not (some #(= :e %1) cell-grp)) (apply = cell-grp))
(first cell-grp)
(recur cell-grps))))]
(game-winner (make-groups board))))
(and (= nil (tic-tac-toe-winner [[:e :e :e] [:e :e :e] [:e :e :e]]))
(= :x (tic-tac-toe-winner [[:x :e :o] [:x :e :e] [:x :e :o]]))
(= :o (tic-tac-toe-winner [[:e :x :e] [:o :o :o] [:x :e :x]]))
(= nil (tic-tac-toe-winner [[:x :e :o] [:x :x :e] [:o :x :o]]))
(= :x (tic-tac-toe-winner [[:x :e :e] [:o :x :e] [:o :e :x]]))
(= :o (tic-tac-toe-winner [[:x :e :o] [:x :o :e] [:o :e :x]]))
(= nil (tic-tac-toe-winner [[:x :o :x] [:x :o :x] [:o :x :o]]))) #+end_src
- Problem 74
Filter Perfect Squares
#+begin_src clojure ;; Perfect square numbers ;; http://en.wikipedia.org/wiki/Square_number (defn perfect-sqrt-nums [num-seq] (letfn [(perfect-square? [s] (let [n-sqrt (Math/sqrt (Integer/valueOf s))] (= (double 0) (double (- n-sqrt (Math/floor n-sqrt))))))] (->> (interpose "," (filter perfect-square? (re-seq #"\d+" num-seq))) (apply str))))
(clojure.test/testing "Given a string of comma separated integers, write a function which returns a new comma separated string that only contains the numbers which are perfect squares." (clojure.test/is (and (= (perfect-sqrt-nums "4,5,6,7,8,9") "4,9") (= (perfect-sqrt-nums "15,16,25,36,37") "16,25,36")))) #+end_src
- Problem 75
Euler's Totient Function
#+begin_src clojure ;; Write a function which calculates Euler's totient function. ;; NOTE: Reusing gcd function from question 66. ;; ;; Two numbers are coprime if their greatest common divisor equals 1. ;; Euler's totient function f(x) is defined as the number of positive integers ;; less than x which are coprime to x. ;; The special case f(1) equals 1. ;; Write a function which calculates Euler's totient function. (defn euler-totient [n] {:pre [ (pos? n)]} (if (= 1 n) n (count (filter #(= 1 (gcd n %1)) (range n)))))
(clojure.test/testing "Test Euler's totient function." (clojure.test/is (and (= (euler-totient 1) 1) (= (euler-totient 10) (count '(1 3 7 9)) 4) (= (euler-totient 40) 16) (= (euler-totient 99) 60)))) #+end_src
- Problem 76
Intro to Trampoline
#+begin_src clojure ;; ;; The trampoline function takes a function f and a variable number of parameters. ;; Trampoline calls f with any parameters that were supplied. ;; If f returns a function, trampoline calls that function with no arguments. ;; This is repeated, until the return value is not a function, ;; and then trampoline returns that non-function value. ;; This is useful for implementing mutually recursive algorithms ;; in a way that won't consume the stack.
(= [1 3 5 7 9 11] (letfn [(foo [x y] #(bar (conj x y) y)) (bar [x y] (if (> (last x) 10) x #(foo x (+ 2 y))))] (trampoline foo [] 1))) #+end_src
- Problem 77
Anagram Finder
#+BEGIN_SRC clojure ;; 4Clojure Question 77 ;; ;; Write a function which finds all the anagrams in a vector of words. ;; A word x is an anagram of word y if all the letters in x can be ;; rearranged in a different order to form y. ;; Your function should return a set of sets, ;; where each sub-set is a group of words which are anagrams of each other. ;; Each sub-set should have at least two words. ;; Words without any anagrams should not be included in the result.
(defn anagrams [xs]
(->> (vals (group-by #(sort %1) (set xs)))
(filter #(> (count %1) 1))
(map set)
(into #{})))
(and
(= (anagrams ["meat" "mat" "team" "mate" "eat"])
#{#{"meat" "team" "mate"}})
(= (anagrams ["veer" "lake" "item" "kale" "mite" "ever"])
#{#{"veer" "ever"} #{"lake" "kale"} #{"mite" "item"}}))
#+END_SRC
- Problem 78
Reimplement Trampoline
#+BEGIN_SRC clojure ;; Reimplement the function described in "Intro to Trampoline". ;; ;; Restrictions (please don't use these function(s)): trampoline (defn my-trampoline [f x] ((fn step [f & args] (let [result (apply f args)] (if-not (fn? result) result (recur f result)))) f x))
(= (letfn [(triple [x] #(sub-two (* 3 x)))
(sub-two [x] #(stop?(- x 2)))
(stop? [x] (if (> x 50) x #(triple x)))]
(__ triple 2))
82)
(= (letfn [(my-even? [x] (if (zero? x) true #(my-odd? (dec x))))
(my-odd? [x] (if (zero? x) false #(my-even? (dec x))))]
(map (partial __ my-even?) (range 6)))
[true false true false true false])
#+END_SRC
- Problem 79
Triangle Minimal Path
#+BEGIN_SRC clojure ;; 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. (defn min-triangle-path [col] (letfn [(current-row-min-path [cur-row] (->> (partition 2 1 cur-row) (mapv #(reduce min %))))
(update-triangle-base [last-row min-path]
(mapv + last-row min-path))
(update-triangle [triangle idx updated-base]
(assoc triangle idx updated-base))
(min-path-sum [triangle]
(if (= 1 (count triangle))
(first (flatten triangle))
(let [new-triangle (pop triangle)
new-base (last new-triangle)
new-base-idx (dec (count new-triangle))
prev-base (peek triangle)]
(recur (->> (current-row-min-path prev-base)
(update-triangle-base new-base)
(update-triangle new-triangle new-base-idx))))))]
(min-path-sum (into [] col))))
(and
(= 7 (min-triangle-path '([1]
[2 4]
[5 1 4]
[2 3 4 5]))) ; 1->2->1->3
(= 20 (min-triangle-path '([3]
[2 4]
[1 9 3]
[9 9 2 4]
[4 6 6 7 8]
[5 7 3 5 1 4]))) ; 3->4->3->2->7->1
)
#+END_SRC
- Problem 80
Test perfect numbers
#+begin_src clojure ;; A number is "perfect" if the sum of its divisors equal the number itself. ;; 6 is a perfect number because 1+2+3=6. ;; Write a function which returns true for perfect numbers and false otherwise.
(defn perfect-num? [n] (and (not (odd? n)) (= n (reduce + (filter #(= 0 (mod n %)) (range 1 n))))))
(clojure.test/testing "Test perfect numbers." (clojure.test/is (and (= (perfect-num? 6) true) (= (perfect-num? 7) false) (= (perfect-num? 496) true) (= (perfect-num? 500) false) (= (perfect-num? 8128) true)))) #+end_src
- Problem 81
Write a function which returns the intersection of two sets.
#+begin_src clojure ;; The intersection is the sub-set of items that each set has in common. ;; Restrictions (please don't use these function(s)): intersection
(defn set-intersection [x1 x2] (set (filter x1 x2)))
(clojure.test/testing "Intersection of two sets." (clojure.test/is (and (= (set-intersection #{0 1 2 3} #{2 3 4 5}) #{2 3}) (= (set-intersection #{0 1 2} #{3 4 5}) #{}) (= (set-intersection #{:a :b :c :d} #{:c :e :a :f :d}) #{:a :c :d})))) #+end_src
- Problem 82 Test continuous word chain
#+begin_src clojure ;; 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: ;; cat -> cot -> coat -> oat -> hat -> hot -> hog -> dog
;; 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.
(defn continuous-word-chain? [xs] (letfn [(combinations-tree [elem xs] (cons elem (when-not (empty? xs) (let [r (filter #(= 1 (words-diff elem %1)) xs)] (when-not (empty? r) (map #(combinations-tree %1 (disj xs %1)) r))))))
(max-tree-height [tree]
(if (not (seq? tree)) 0
(+ 1 (reduce max (map max-tree-height tree)))))
(words-diff [w1 w2]
(let [r (count (apply disj (set w1) (seq w2)))
letters-diff (- (count w1) (count w2))
diff (if (neg? letters-diff) (* -1 letters-diff) letters-diff)]
(+ diff r)))]
(->> (map #(max-tree-height (combinations-tree %1 (disj xs %1))) xs)
(reduce max)
(= (count xs)))))
(clojure.test/testing "Word chain" (clojure.test/is (and (= true (continuous-word-chain? #{"hat" "coat" "dog" "cat" "oat" "cot" "hot" "hog"})) (= false (continuous-word-chain? #{"cot" "hot" "bat" "fat"})) (= false (continuous-word-chain? #{"to" "top" "stop" "tops" "toss"})) (= true (continuous-word-chain? #{"spout" "do" "pot" "pout" "spot" "dot"})) (= true (continuous-word-chain? #{"share" "hares" "shares" "hare" "are"})) (= false (continuous-word-chain? #{"share" "hares" "hare" "are"}))))) #+end_src
- Problem 83
A Half-Truth
#+begin_src clojure ;; Write a function which takes a variable number of booleans. ;; Your function should return true if some of the parameters ;; are true, but not all of the parameters are true. ;; Otherwise your function should return false.
(defn some-true? [& cols] (= (set cols) #{true false}))
(and (= false (some-true? false false)) (= true (some-true? true false)) (= false (some-true? true)) (= true (some-true? false true false)) (= false (some-true? true true true)) (= true (some-true? true true true false))) #+end_src
- Problem 84
Transitive Closure
#+begin_src clojure ;; http://en.wikipedia.org/wiki/Transitive_closure ;; http://en.wikipedia.org/wiki/Binary_relation ;; ;; Write a function which generates the transitive closure of a binary relation. ;; The relation will be represented as a set of 2 item vectors.
(defn transitive-closure [g] (letfn [(adjacent-vertices [v g] (keep (fn [[a b]] (when (= v a) b)) g))
(vertices [g]
(set (reduce concat g)))
(bfs-iter [v g]
(loop [queue (-> (clojure.lang.PersistentQueue/EMPTY) (conj v))
visited #{v}]
(if (empty? queue)
(disj visited v)
(let [node (peek queue)
cur-queue (pop queue)
neighbours (adjacent-vertices node g)
unseen (reduce disj (set neighbours) visited)
next-queue (reduce conj cur-queue unseen)]
(recur next-queue (reduce conj visited unseen))))))
(transitive-edges [v connections]
(reduce #(conj %1 [v %2]) connections))]
(reduce (fn [graph vertex]
(let [reachable-nodes (bfs-iter vertex g)
transitive-links (transitive-edges vertex reachable-nodes)]
(reduce #(conj %1 %2) graph transitive-links)))
g (vertices g))))
(and (let [divides #{[8 4] [9 3] [4 2] [27 9]}] (= (transitive-closure divides) #{[4 2] [8 4] [8 2] [9 3] [27 9] [27 3]}))
(let [more-legs #{["cat" "man"] ["man" "snake"] ["spider" "cat"]}] (= (transitive-closure more-legs) #{["cat" "man"] ["cat" "snake"] ["man" "snake"] ["spider" "cat"] ["spider" "man"] ["spider" "snake"]}))
(let [progeny #{["father" "son"] ["uncle" "cousin"] ["son" "grandson"]}] (= (transitive-closure progeny) #{["father" "son"] ["father" "grandson"] ["uncle" "cousin"] ["son" "grandson"]}))) #+end_src
- Problem 85
Power Set
#+begin_src clojure ;; http://en.wikipedia.org/wiki/Power_set ;; Write a function which generates the power set of a given set. ;; ;; The power set of a set x is the set of all subsets of x, ;; including the empty set and x itself. ;; ;; http://www.mathsisfun.com/sets/power-set.html
(defn powerset [xs] (let [ln (count xs) col (into [] xs) set-size (Math/pow 2 ln)] (->> (for [i (range set-size)] (->> (for [j (range ln) :when (pos? (bit-and i (bit-shift-left 1 j)))] (col j)) (into #{}))) (into #{}))))
(and (= (powerset #{1 :a}) #{#{1 :a} #{:a} #{} #{1}}) (= (powerset #{}) #{#{}}) (= (powerset #{1 2 3}) #{#{} #{1} #{2} #{3} #{1 2} #{1 3} #{2 3} #{1 2 3}}) (= (count (powerset (into #{} (range 10)))) 1024))
#+end_src
- Problem 86 Test happy numbers
#+begin_src clojure ;; Happy numbers are positive integers that follow a particular formula: ;; - Take each individual digit, square it, ;; and then sum the squares to get a new number. ;; - Repeat with the new number and eventually, ;; you might get to a number whose squared sum is 1. ;; - This is a happy number.
;; An unhappy number (or sad number) is one that loops endlessly. ;; Write a function that determines if a number is happy or not.
(defn happy-num? [n] {:pre [(pos? n)]} (letfn [(digits [n] (map #(Character/getNumericValue %1) (str n))) (square-sum [xs] (long (reduce #(+ %1 (Math/pow %2 2)) 0 xs)))] (loop [loop-detection #{} i n] (let [sum (square-sum (digits i))] (cond (= 1 sum) true (contains? loop-detection sum) false :else (recur (conj loop-detection sum) sum))))))
(and (= (happy-num? 7) true) (= (happy-num? 986543210) true) (= (happy-num? 2) false) (= (happy-num? 3) false)) #+end_src
- Problem 87
THERE IS NO PROBLEM 87
- Problem 88
Symmetric difference of two sets
#+begin_src clojure ;; 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.
(defn symetric-set-diff [s1 s2] (let [not-in-s1 (filter #(not (s1 %1)) s2) not-in-s2 (filter #(not (s2 %1)) s1)] (set (concat not-in-s1 not-in-s2))))
(and (= (symetric-set-diff #{1 2 3 4 5 6} #{1 3 5 7}) #{2 4 6 7}) (= (symetric-set-diff #{:a :b :c} #{}) #{:a :b :c}) (= (symetric-set-diff #{} #{4 5 6}) #{4 5 6}) (= (symetric-set-diff #{[1 2] [2 3]} #{[2 3] [3 4]}) #{[1 2] [3 4]})) #+end_src
- Problem 89
Graph Tour
#+begin_src clojure ;; 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.The graph is represented by a ;; vector of tuples, where each tuple represents a single edge. ;; ;; The rules are: ;; - You can start at any node. ;; - You must visit each edge exactly once. ;; - All edges are undirected.
(defn eulerian-walk? [g] (letfn [(vertices [g] (set (reduce concat g)))
(adjacent-edges [v g] (filter (fn [[a b]] (or (= a v) (= b v))) g))
(next-vertex [e u] (first (disj (into #{} e) u)))
(rem-first [xs x]
(when xs
(if (not= (first xs) x)
(cons (first xs) (rem-first (next xs) x))
(rest xs))))
(get-paths [v g q]
(let [edges (adjacent-edges v g)]
(if (empty? edges)
(cons q nil)
(->> (mapcat #(reduce conj [] (get-paths (next-vertex %1 v)
(rem-first g %1)
(conj q %1)))
edges)
(map seq)))))]
(let [nodes (vertices g)
node (first nodes)
eulerian-trail? (->> (get-paths node g (clojure.lang.PersistentQueue/EMPTY))
(some #(= (count g) (count %1))))]
(or eulerian-trail? false))))
(and (= true (eulerian-walk? [[:a :b]])) (= false (eulerian-walk? [[:a :a] [:b :b]])) (= false (eulerian-walk? [[:a :b] [:a :b] [:a :c] [:c :a] [:a :d] [:b :d] [:c :d]])) (= true (eulerian-walk? [[1 2] [2 3] [3 4] [4 1]])) (= true (eulerian-walk? [[:a :b] [:a :c] [:c :b] [:a :e] [:b :e] [:a :d] [:b :d] [:c :e] [:d :e] [:c :f] [:d :f]])) (= false (eulerian-walk? [[1 2] [2 3] [2 4] [2 5]]))) #+end_src
- Problem 90
Cartesian product
#+begin_src clojure ;; Write a function which calculates the Cartesian product of two sets. ;; http://en.wikipedia.org/wiki/Cartesian_product
(defn cartesian-product [xs1 xs2] (set (for [x1 xs1 x2 xs2] [x1 x2])))
(and (= (cartesian-product #{"ace" "king" "queen"} #{"♠" "♥" "♦" "♣"}) #{["ace" "♠"] ["ace" "♥"] ["ace" "♦"] ["ace" "♣"] ["king" "♠"] ["king" "♥"] ["king" "♦"] ["king" "♣"] ["queen" "♠"] ["queen" "♥"] ["queen" "♦"] ["queen" "♣"]}) (= (cartesian-product #{1 2 3} #{4 5}) #{[1 4] [2 4] [3 4] [1 5] [2 5] [3 5]}) (= 300 (count (cartesian-product (into #{} (range 10)) (into #{} (range 30))))))
#+end_src
- Problem 91
Check if a graph is connected
#+begin_src clojure ;; Given a graph, determine whether the graph is connected. ;; A connected graph is such that a path exists between any two given nodes. ;; - Your function must return true if the graph is connected and false otherwise. ;; - 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. ;; - Each edge is undirected (can be traversed either direction).
(defn graph-connected? [g] (letfn [(adjacent-nodes [v g] (keep (fn [[a b]] (cond (= v a) b, (= v b) a)) g))
(dfs-iter [v g]
(loop [stack (cons v nil) visited #{}]
(if (empty? stack)
visited
(let [node (peek stack)
col (pop stack)
not-visited? (not (contains? visited node))
next-visited (if not-visited?
(conj visited node)
visited)
next-stack (if not-visited?
(reduce #(conj %1 %2)
col (adjacent-nodes node g))
col)]
(recur next-stack next-visited)))))]
(let [nodes (set (reduce concat g))
connections (reduce (fn [acc v]
(assoc acc v (dfs-iter v g)))
{} nodes)]
(every? #(= (count nodes) (count (last %1))) connections))))
(and (= true (graph-connected? #{[:a :a]})) (= true (graph-connected? #{[:a :b]})) (= false (graph-connected? #{[1 2] [2 3] [3 1] [4 5] [5 6] [6 4]})) (= true (graph-connected? #{[1 2] [2 3] [3 1] [4 5] [5 6] [6 4] [3 4]})) (= false (graph-connected? #{[:a :b] [:b :c] [:c :d] [:x :y] [:d :a] [:b :e]})) (= true (graph-connected? #{[:a :b] [:b :c] [:c :d] [:x :y] [:d :a] [:b :e] [:x :a]})))
#+end_src
- Problem 92
Roman numerals to decimal parser Also read about the [[href="http://en.wikipedia.org/wiki/Roman_numerals#Subtractive_principle][substractive principle]] on Wikipedia.
#+begin_src clojure ;; 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. ;; ;; 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.
(defn roman-numeral-to-number [str] (let [sym-table {\I 1, \V 5, \X 10, \L 50, \C 100, \D 500, \M 1000} nums (mapv #(sym-table %1) str)] (reduce + (map-indexed (fn [idx item] (let [max-right-item (reduce max (subvec nums idx)) num-x (if (> max-right-item item) -1 1)] (* item num-x))) nums))))
(and (= 14 (roman-numeral-to-number "XIV")) (= 827 (roman-numeral-to-number "DCCCXXVII")) (= 3999 (roman-numeral-to-number "MMMCMXCIX")) (= 48 (roman-numeral-to-number "XLVIII")))
#+end_src
- Problem 93
Partially Flatten a Sequence
#+BEGIN_SRC clojure ;; Write a function which flattens any nested combination of sequential things ;; (lists, vectors, etc.), but maintains the lowest level sequential items. ;; The result should be a sequence of sequences with only one level of nesting.
;; bottom up approach seems easier here for me at least here...
(defn flatten-1 [xs]
(letfn [(stepper [xs]
(when (not (empty? xs))
(let [cur (last xs)]
(if-not (and (coll? cur) (every? coll? cur))
(cons cur (stepper (butlast xs)))
(recur (concat (butlast xs) cur))))))]
(into '() (stepper xs))))
(and (= (flatten-1 [["Do"] ["Nothing"]])
[["Do"] ["Nothing"]])
(= (flatten-1 [[[[:a :b]]] [[:c :d]] [:e :f]])
[[:a :b] [:c :d] [:e :f]])
(= (flatten-1 '((1 2)((3 4)((((5 6)))))))
'((1 2)(3 4)(5 6))))
#+END_SRC
- Problem 94
Game of Life
#+BEGIN_SRC clojure ;; The game of life ;; is a cellular automaton devised by mathematician John Conway.
;; 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:<br/><br/>
;; 1) Any live cell with fewer than two live neighbours dies, as if caused by
;; under-population.
;; 2) Any live cell with two or three live neighbours lives on to the next generation.
;; 3) Any live cell with more than three live neighbours dies, as if by overcrowding.
;; 4) Any dead cell with exactly three live neighbours becomes a live cell,
;; as if by reproduction.
;; Write a function that accepts a board, and returns a board representing
;; the next generation of cells.
(defn game-of-life [board]
(letfn [(find-cells [board]
(map-indexed (fn [i row]
(map-indexed (fn [j ch]
(let [ln (count (live-neighbors board [i j]))]
(if (= ch \#)
(if (or (< ln 2) (> ln 3)) \space ch)
(if (= ln 3) \# ch))))
row))
board))
(valid-live-cell? [board [i j] max-i max-j]
(and (>= i 0) (>= j 0) (< i max-i) (< j max-j) (= (get-in board [i j]) \#)))
(live-neighbors [board [i j]]
(let [max-i (count board)
max-j (count (first board))]
(->> [[(dec i) j] [(dec i) (dec j)] [i (dec j)] [(inc i) (dec j)]
[(inc i) j] [(inc i) (inc j)] [i (inc j)] [(dec i) (inc j)]]
(filter #(valid-live-cell? board %1 max-i max-j)))))]
(mapv #(apply str %1) (find-cells board))))
(and
(= (game-of-life [" "
" ## "
" ## "
" ## "
" ## "
" "])
[" "
" ## "
" # "
" # "
" ## "
" "])
(= (game-of-life [" "
" "
" ### "
" "
" "])
[" "
" # "
" # "
" # "
" "])
(= (game-of-life [" "
" "
" ### "
" ### "
" "
" "])
[" "
" # "
" # # "
" # # "
" # "
" "]))
#+END_SRC
- Problem 95
To Tree, or not to Tree
#+BEGIN_SRC clojure ;; 4Clojure Question 95 ;; ;; Write a predicate which checks whether or not a given ;; sequence represents a ;; binary tree. ;; Each node in the tree must have a value, a left child, and a right child.
(defn binary-tree? [xs]
(letfn [(valid-node? [col idx]
(let [elem (nth col idx)]
(if (nil? elem)
true
(and (coll? elem) (binary-tree? elem)))))]
(if (= 3 (count xs))
(and
(not (nil? (nth xs 0))) (valid-node? xs 1) (valid-node? xs 2))
false)))
(and
(= (binary-tree? '(:a (:b nil nil) nil))
true)
(= (binary-tree? '(:a (:b nil nil)))
false)
(= (binary-tree? [1 nil [2 [3 nil nil] [4 nil nil]]])
true)
(= (binary-tree? [1 [2 nil nil] [3 nil nil] [4 nil nil]])
false)
(= (binary-tree? [1 [2 [3 [4 nil nil] nil] nil] nil])
true)
(= (binary-tree? [1 [2 [3 [4 false nil] nil] nil] nil])
false)
(= (binary-tree? '(:a nil ()))
false))
#+END_SRC
- Problem 96
Beauty is Symmetry
#+BEGIN_SRC clojure ;; Let us define a binary tree as "symmetric" if the left ;; half of the tree is the mirror image of the right half ;; of the tree.
;; Write a predicate to determine whether or not a given
;; binary tree is symmetric. (see <a href='/problem/95'>To Tree,
;; or not to Tree</a> for a reminder on the tree representation we're using).
;; Reusing our binary-tree? function from problem 95.
(defn symmetric-binary-tree? [xs]
(letfn [(symmetric? [left right]
(if (or (coll? left) (coll? right))
(and (and (coll? left) (coll? right))
(= (first left) (first right))
(symmetric? (second (rest left)) (first (rest right)))
(symmetric? (first (rest left)) (second (rest right))))
(= left right)))]
(and (binary-tree? xs) (symmetric? (first (rest xs)) (second (rest xs))))))
(and
(= (symmetric-binary-tree? '(:a (:b nil nil) (:b nil nil))) true)
(= (symmetric-binary-tree? '(:a (:b nil nil) nil)) false)
(= (symmetric-binary-tree? '(:a (:b nil nil) (:c nil nil))) false)
(= (symmetric-binary-tree? [1 [2 nil [3 [4 [5 nil nil] [6 nil nil]] nil]]
[2 [3 nil [4 [6 nil nil] [5 nil nil]]] nil]])
true)
(= (symmetric-binary-tree? [1 [2 nil [3 [4 [5 nil nil] [6 nil nil]] nil]]
[2 [3 nil [4 [5 nil nil] [6 nil nil]]] nil]])
false)
(= (symmetric-binary-tree? [1 [2 nil [3 [4 [5 nil nil] [6 nil nil]] nil]]
[2 [3 nil [4 [6 nil nil] nil]] nil]])
false))
#+END_SRC
- Problem 97
Pascal's Triangle
#+BEGIN_SRC clojure
;; Pascal's triangle
;; is a triangle of numbers computed using the following rules:
-
;; The first row is 1.- Each successive row is computed by adding
;; together adjacent numbers in the row above, and adding a 1 to the
;; beginning and end of the row.
Write a function which
;; returns the nth row of Pascal's Triangle.
(defn pascal-triangle-row [n]
(letfn [(step [xs]
(-> (into [(first xs)] (map #(reduce +' %1N) (partition 2 1 xs)))
(conj (last xs))))]
(last (take n (iterate step [1])))))
(and
(= (pascal-triangle-row 1) [1])
(= (map pascal-triangle-row (range 1 6))
[ [1]
[1 1]
[1 2 1]
[1 3 3 1]
[1 4 6 4 1]])
(= (pascal-triangle-row 11)
[1 10 45 120 210 252 210 120 45 10 1]))
#+END_SRC
- Problem 98
Equivalence Classes
#+BEGIN_SRC clojure ;; 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.
(defn equiv-classes [f xs] (->> (vals (group-by f xs)) (map set) (into #{})))
(and (= (equiv-classes #(* % %) #{-2 -1 0 1 2}) #{#{0} #{1 -1} #{2 -2}})
(= (equiv-classes #(rem % 3) #{0 1 2 3 4 5 }) #{#{0 3} #{1 4} #{2 5}})
(= (equiv-classes identity #{0 1 2 3 4}) #{#{0} #{1} #{2} #{3} #{4}})
(= (equiv-classes (constantly true) #{0 1 2 3 4}) #{#{0 1 2 3 4}}))
#+END_SRC
- Problem 99
Product Digits
#+BEGIN_SRC clojure ;; Write a function which multiplies two numbers ;; and returns the result as a sequence of its digits.
(defn product-digits [a b] (map #(Character/getNumericValue %) (str (* a b))))
(and (= (product-digits 1 1) [1]) (= (product-digits 99 9) [8 9 1]) (= (product-digits 999 99) [9 8 9 0 1])) #+END_SRC
- Problem 100
Least Common Multiple
#+BEGIN_SRC clojure ;; Write a function which calculates the ;; least common multiple. ;; Your function should accept a variable number of positive integers or ratios.
;; We reuse our gcd function from question 66 (defn lcm [& nums] (reduce (fn [a b] (/ (* a b) (gcd a b))) nums))
(and (== (lcm 2 3) 6) (== (lcm 5 3 7) 105) (== (lcm 1/3 2/5) 2) (== (lcm 3/4 1/6) 3/2) (== (lcm 7 5/7 2 3/5) 210)) #+END_SRC
- Problem 101
Levenshtein Distance
#+BEGIN_SRC clojure ;; https://secure.wikimedia.org/wikipedia/en/wiki/Levenshtein_distance
;; 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:<br/><br/>- insert a single item<br/>-
;; delete a single item<br/>- replace a single item with another item
;; <br/><br/>WARNING: Some of the test cases may timeout
;; if you write an inefficient solution!
(defn levenshtein [w1 w2]
(letfn [(cell-value [same-char? prev-row cur-row col-idx]
(min (inc (nth prev-row col-idx))
(inc (last cur-row))
(+ (nth prev-row (dec col-idx)) (if same-char? 0 1))))]
(loop [row-idx 1
max-rows (inc (count w2))
prev-row (range (inc (count w1)))]
(if (= row-idx max-rows)
(last prev-row)
(let [ch2 (nth w2 (dec row-idx))
next-prev (reduce (fn [cur-row i]
(let [same-char? (= (nth w1 (dec i)) ch2)]
(conj cur-row (cell-value same-char?
prev-row
cur-row
i))))
[row-idx]
(range 1 (count prev-row)))]
(recur (inc row-idx) max-rows, next-prev))))))
(and
(= (levenshtein "kitten" "sitting") 3)
(= (levenshtein "closure" "clojure") (levenshtein "clojure" "closure") 1)
(= (levenshtein "xyx" "xyyyx") 2)
(= (levenshtein "" "123456") 6)
(= (levenshtein "Clojure" "Clojure") (levenshtein "" "") (levenshtein [] []) 0)
(= (levenshtein [1 2 3 4] [0 2 3 4 5]) 2)
(= (levenshtein '(:a :b :c :d) '(:a :d)) 2)
(= (levenshtein "ttttattttctg" "tcaaccctaccat") 10)
(= (levenshtein "gaattctaatctc" "caaacaaaaaattt") 9))
#+END_SRC
- Problem 102
intoCamelCase
#+BEGIN_SRC clojure
;; When working with java, you often need to create an object
;; with fieldsLikeThis, but you'd rather work with a
;; hashmap that has :keys-like-this until it's time to convert.
;; Write a function which takes lower-case hyphen-separated strings and
;; converts them to camel-case strings.
(defn camel-case [s] (let [->camel-case #(concat (str (Character/toUpperCase (first %1))) (rest %1)) xs (take-nth 2 (partition-by #(= - %1) s))] (->> (mapcat ->camel-case (rest xs)) (concat (first xs)) (apply str))))
(and (= (camel-case "something") "something") (= (camel-case "multi-word-key") "multiWordKey") (= (camel-case "leaveMeAlone") "leaveMeAlone")) #+END_SRC
- Problem 103
Generating k-combinations
#+BEGIN_SRC clojure ;; Given a sequence S consisting of n elements generate all ;; k-combinations ;; of S, i. e. generate all possible sets consisting of k distinct elements taken from S. ;; ;; The number of k-combinations for a sequence is equal to the ;; ;; binomial coefficient.
;; Reusing our powerset function from problem 85 and we just reduce it. (defn k-distinct-combos [n xs] (case (- n (count xs)) pos? #{} zero? #{xs} (into #{} (filter #(= n (count %1)) (powerset xs)))))
(and (= (k-distinct-combos 1 #{4 5 6}) #{#{4} #{5} #{6}})
(= (k-distinct-combos 10 #{4 5 6}) #{})
(= (k-distinct-combos 2 #{0 1 2}) #{#{0 1} #{0 2} #{1 2}})
(= (k-distinct-combos 3 #{0 1 2 3 4}) #{#{0 1 2} #{0 1 3} #{0 1 4} #{0 2 3} #{0 2 4} #{0 3 4} #{1 2 3} #{1 2 4} #{1 3 4} #{2 3 4}})
(= (k-distinct-combos 4 #{[1 2 3] :a "abc" "efg"}) #{#{[1 2 3] :a "abc" "efg"}})
(= (k-distinct-combos 2 #{[1 2 3] :a "abc" "efg"}) #{#{[1 2 3] :a} #{[1 2 3] "abc"} #{[1 2 3] "efg"} #{:a "abc"} #{:a "efg"} #{"abc" "efg"}})) #+END_SRC
- Problem 104
Write roman numerals
#+begin_src clojure ;; This is the inverse of Problem 92, but much easier. ;; Given an integer smaller than 4000, return the corresponding roman numeral ;; in uppercase, adhering to the subtractive principle.
;; The trick here is to select carefully ;; the symbol table so that you don't need to check for repetition ;; 4 = IV vs XXXX (without storing such cases, ;; it is more difficult for the recursion...) ;; I couldn't make it work with a basic table as in problem 92. (defn number-to-roman-numeral [n] (let [sym-table {1 "I", 4 "IV", 5 "V", 9 "IX", 10 "X", 40 "XL", 50 "L", 90 "XC", 100 "C", 400 "CD", 500 "D", 900 "CM" 1000 "M"} sym-keys (keys sym-table)]
(loop [remainder n
result []]
(if (zero? remainder)
(apply str result)
(let [min-num-sym (reduce max (filter #(<= %1 remainder) sym-keys))
min-sym (sym-table min-num-sym)]
(recur (- remainder min-num-sym) (conj result min-sym)))))))
(and (= "I" (number-to-roman-numeral 1)) (= "XXX" (number-to-roman-numeral 30)) (= "IV" (number-to-roman-numeral 4)) (= "CXL" (number-to-roman-numeral 140)) (= "DCCCXXVII" (number-to-roman-numeral 827)) (= "MMMCMXCIX" (number-to-roman-numeral 3999)) (= "XLVIII" (number-to-roman-numeral 48))) #+end_src
- Problem 105
#+begin_src clojure ;; Given an input sequence of keywords and numbers, ;; create a map such that each key in the map is a keyword, ;; and the value is a sequence of all the numbers (if any) ;; between it and the next keyword in the sequence.
(defn keyword-set[xs] (->> (reduce (fn [acc item] (if (keyword? item) (conj acc item []) (assoc acc (dec (count acc)) (conj (peek acc) item)))) [] xs) (apply hash-map)))
(and (= {} (keyword-set [])) (= {:a [1]} (keyword-set [:a 1])) (= {:a [1], :b [2]} (keyword-set [:a 1, :b 2])) (= {:a [1 2 3], :b [], :c [4]} (keyword-set [:a 1 2 3 :b :c 4])))
#+end_src
- Problem 106
Number Maze
#+begin_src clojure ;; Given a pair of numbers, the start and end point, ;; find a path between the two using only three possible operations:
-
;;
;;
- double ;;
- halve (odd numbers cannot be halved) ;;
- add 2
(defn num-maze-steps [start end]
(letfn [(possible-operations [n]
(let [ops [#(+ %1 2), #(* %1 2)]]
(if (even? n)
(conj ops #(/ %1 2))
ops)))
(apply-operations [nums]
(mapcat (fn [n] (map #(%1 n) (possible-operations n))) nums))]
(loop [nodes [start]
step 1]
(if (some #(= end %) nodes)
step
(recur (apply-operations nodes), (inc step))))))
(and
(= 1 (num-maze-steps 1 1)) ; 1
(= 3 (num-maze-steps 3 12)) ; 3 6 12
(= 3 (num-maze-steps 12 3)) ; 12 6 3
(= 3 (num-maze-steps 5 9)) ; 5 7 9
(= 9 (num-maze-steps 9 2)) ; 9 18 20 10 12 6 8 4 2
(= 5 (num-maze-steps 9 12)) ; 9 11 22 24 12
)
#+end_src
- Problem 107
Simple closures
#+begin_src clojure ;;
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.
;; ;; ;;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.
(defn exp [n] (fn [& args] (long (Math/pow (first args) n))))
(and (= 256 ((exp 2) 16), ((exp 8) 2)) (= [1 8 27 64] (map (exp 3) [1 2 3 4])) (= [1 2 4 8 16] (map #((exp %) 2) [0 1 2 3 4]))) #+end_src
- Problem 108
Lazy Searching
#+begin_src clojure ;; 4Clojure Question 108 ;; ;;
Given any number of sequences, each sorted from smallest to largest, ;; find the smallest single number which appears in all of the sequences. ;; The sequences may be infinite, so be careful to search lazily.
(defn smallest-common-num [& cols] (letfn [(move-cursor [col num] (if (>= (first col) num) col (recur (rest col) num)))] (let [firsts (map first cols) max-first (reduce max firsts)] (if (apply = firsts) (first firsts) (recur (map #(move-cursor %1 max-first) cols))))))
(and (= 3 (smallest-common-num [3 4 5])) (= 4 (smallest-common-num [1 2 3 4 5 6 7] [0.5 3/2 4 19])) (= 7 (smallest-common-num (range) (range 0 100 7/6) [2 3 5 7 11 13])) (= 64 (smallest-common-num (map #(* % % %) (range)) ;; perfect cubes (filter #(zero? (bit-and % (dec %))) (range)) ;; powers of 2 (iterate inc 20))) ;; at least as large as 20 ) #+end_src
- Problem 109
THERE IS NO PROBLEM 109
- Problem 110
#+begin_src clojure ;;
Write a function that returns a lazy sequence of "pronunciations"
;; of a sequence of numbers. A pronunciation of each element in the
;; sequence consists of the number of repeating identical numbers
;; and the number itself. For example, [1 1] is
;; pronounced as [2 1] ("two ones"), which in turn is
;; pronounced as [1 2 1 1] ("one two, one one").
;;
Your function should accept an initial sequence of numbers, ;; and return an infinite lazy sequence of pronunciations, ;; each element being a pronunciation of the previous element.
(defn pronunciations [xs] (letfn [(stepper [xs] (mapcat #(vector (count %1) (first %1)) (partition-by identity xs)))] (iterate stepper (stepper xs))))
(and (= [[1 1] [2 1] [1 2 1 1]] (take 3 (pronunciations [1]))) (= [3 1 2 4] (first (pronunciations [1 1 1 4 4]))) (= [1 1 1 3 2 1 3 2 1 1] (nth (pronunciations [1]) 6)) (= 338 (count (nth (pronunciations [3 2]) 15)))) #+end_src
- Problem 111
#+begin_src clojure ;; 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.
;; 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. ;; ;; For a word to be legally placed on the board: ;; - It may use empty spaces (underscores) ;; - It may use but must not conflict with any pre-filled characters. ;; - It must not use any unusable spaces (hashes).;; ;; - There must be no empty spaces (underscores) or extra characters ;; before or after the word (the word may be bound by unusable spaces though). ;; - Characters are not case-sensitive. ;; - Words may be placed vertically (proceeding top-down only), ;; or horizontally (proceeding left-right only).
;; Rewrite using plain stupid brute force instead of smarter code. ;; ;; 0. always go down, check right and down, switch column as needed . ;; 1. If the placement is valid (nothing other than # before and after), just go to 2. ;; 2. Replace non spaces or overwritable chars by #. ;; 3. If we have a range without # we have a solution. (defn solved-crossword? [word board] (let [wc (count word) puzzle (mapv (fn [col] (into [] (filter #(not= \space %1) col))) board) max-i (count puzzle) max-j (count (first puzzle))]
(letfn [(solved? [puzzle i j]
(if (= \# ((puzzle i) j))
false
(or
;; right
(and (>= (- max-j j wc) 0)
(valid-position? puzzle i (dec j))
(valid-position? puzzle i (+ j wc))
(not (some #(= \# %1)
(transform (subvec (puzzle i)
j
(+ j wc))))))
;; down
(and (>= (- max-i i wc) 0)
(valid-position? puzzle (dec i) j)
(valid-position? puzzle (+ i wc) j)
(not (some #(= \# %1)
(transform (subvec (mapv (fn [m] (nth m j)) puzzle)
i
(+ i wc)))))))))
(valid-position? [puzzle i j]
(if (or (neg? i) (neg? j) (>= j max-j) (>= i max-i))
true
(= \# ((puzzle i) j))))
(transform [view]
(map-indexed #(if (and (not= %2 \_) (not= (nth word %1) %2)) \# %2) view))
(next-move [puzzle i j]
(let [next-i (mod (inc i) max-i)
next-j (if (>= (inc i) max-i) (inc j) j)]
[next-i next-j]))
(solve-puzzle [puzzle [i j] cur-iter max-iter]
(if (solved? puzzle i j)
true
(if (= cur-iter max-iter)
false
(recur puzzle (next-move puzzle i j) (inc cur-iter) max-iter))))]
(solve-puzzle puzzle [0 0] 1 (* max-i max-j)))))
(and (= true (solved-crossword? "the" ["_ # _ _ e"]))
(= false (solved-crossword? "the" ["c _ _ _"
"d _ # e"
"r y _ _"]))
(= true (solved-crossword? "joy" ["c _ _ _"
"d _ # e"
"r y _ _"]))
(= false (solved-crossword? "joy" ["c o n j"
"_ _ y _"
"r _ _ #"]))
(= true (solved-crossword? "clojure" ["_ _ _ # j o y"
"_ _ o _ _ _ _"
"_ _ f _ # _ _"])))
#+end_src
- Problem 112
Sequs Horribilis
#+begin_src clojure ;; Create a function which takes an integer ;; and a nested collection of integers as arguments. ;; ;; Analyze the elements of the input collection and ;; return a sequence which maintains the nested ;; structure, and which includes all elements starting ;; from the head whose sum is less than or equal to ;; the input integer.
(defn sequs-horribilis [n xs] (letfn [(mk-ctx [q cur sum limit] (if (coll? cur) (let [pending (enqueue [] cur sum limit) new-sum (+ sum (reduce + (flatten pending)))] {:queue (conj q pending) :sum new-sum}) {:queue (maybe-add-num q cur sum limit) :sum (+ sum cur)}))
(maybe-add-num [q cur sum limit]
(if (> (+ cur sum) limit) q (conj q cur)))
(enqueue [q xs sum limit]
(if (or (empty? xs) (> sum limit))
q
(let [cur (first xs)
ctx (mk-ctx q cur sum limit)]
(recur (:queue ctx) (next xs) (:sum ctx) limit))))]
(enqueue [] xs 0 n)))
(and (= (sequs-horribilis 10 [1 2 [3 [4 5] 6] 7]) '(1 2 (3 (4))))
(= (sequs-horribilis 30 [1 2 [3 [4 [5 [6 [7 8]] 9]] 10] 11]) '(1 2 (3 (4 (5 (6 (7)))))))
(= (sequs-horribilis 9 (range)) '(0 1 2 3))
(= (sequs-horribilis 1 [[[[[1]]]]]) '(((((1))))))
(= (sequs-horribilis 0 [1 2 [3 [4 5] 6] 7]) '())
(= (sequs-horribilis 0 [0 0 [0 [0]]]) '(0 0 (0 (0))))
(= (sequs-horribilis 1 [-10 [1 [2 3 [4 5 [6 7 [8]]]]]]) '(-10 (1 (2 3 (4)))))) #+end_src
- Problem 113
Data types
#+begin_src clojure ;; 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. ;; ;; Restrictions (please don't use these function(s)): proxy
(defn seqable-proxy [& xs] (let [input (apply list xs)] (reify clojure.lang.Seqable (toString [this] (clojure.string/join ", " (sort input))) (seq [this] (seq (distinct input))))))
(and (= "1, 2, 3" (str (seqable-proxy 2 1 3))) (= '(2 1 3) (seq (seqable-proxy 2 1 3))) (= '(2 1 3) (seq (seqable-proxy 2 1 3 3 1 2))) (= '(1) (seq (apply seqable-proxy (repeat 5 1)))) (= "1, 1, 1, 1, 1" (str (apply seqable-proxy (repeat 5 1)))) (and (= nil (seq (seqable-proxy))) (= "" (str (seqable-proxy))))) #+end_src
- Problem 114
Global take-while
#+begin_src clojure
;; take-while is great for filtering sequences,
;; but it limited: you can only examine
;; a single item of the sequence at a time. What if you need to keep
;; track of some state as you go over the sequence?
;;
;; Write a function which accepts an integer n,
;; a predicate p, and a sequence. It should return
;; a lazy sequence of items in the list up to, but not including,
;; the nth item that satisfies the predicate.
;;
(defn take-up-to [n pred? xs]
(lazy-seq
(when (and (pos? n) (not (empty? xs)))
(let [cur (first xs)
next-n (if (pred? cur)
(dec n)
n)]
(when-not (zero? next-n)
(cons cur (take-up-to next-n pred? (rest xs))))))))
(and (= [2 3 5 7 11 13] (take-up-to 4 #(= 2 (mod % 3)) [2 3 5 7 11 13 17 19 23]))
(= ["this" "is" "a" "sentence"]
(take-up-to 3 #(some #{\i} %)
["this" "is" "a" "sentence" "i" "wrote"]))
(= ["this" "is"]
(take-up-to 1 #{"a"}
["this" "is" "a" "sentence" "i" "wrote"])))
#+end_src
- Problem 115
The Balance of N
#+BEGIN_SRC clojure ;; Problem 115 ;; ;; A balanced number is one whose component digits ;; have the same sum on the left and right halves of the number. ;; ;; Write a function which accepts an integer n, ;; and returns true iff n is balanced.
(defn balanced-num? [n]
(let [digits (mapv #(Character/getNumericValue %1) (str n))
mid (fn [xs] (let [middle (bigint (/ (count xs) 2))]
(if (odd? (count xs))
[middle (inc middle)]
[middle middle])))
bounds (mid digits)]
(= (reduce +' (subvec digits 0 (first bounds)))
(reduce +' (subvec digits (last bounds))))))
(and
(= true (balanced-num? 11))
(= true (balanced-num? 121))
(= false (balanced-num? 123))
(= true (balanced-num? 0))
(= false (balanced-num? 88099))
(= true (balanced-num? 89098))
(= true (balanced-num? 89089))
(= (take 20 (filter balanced-num? (range)))
[0 1 2 3 4 5 6 7 8 9 11 22 33 44 55 66 77 88 99 101]))
#+END_SRC
- Problem 116
Prime Sandwich
#+BEGIN_SRC clojure ;; http://en.wikipedia.org/wiki/Balanced_prime ;; ;; A balanced prime is a prime number which is also ;; the mean of the primes directly before and after ;; it in the sequence of valid primes.
;; Create a function which takes an integer n,
;; and returns true iff it is a balanced prime.
;;
;; requires previous prime-sieve function from problem 67
(defn balanced-prime? [n]
(letfn [(primes-interval [n]
(let [[a b c & more] (prime-sieve)]
(loop [acc [a b c] primes more]
(if (> (last acc) n)
acc
(recur (conj (vec (rest acc)) (first primes))
(rest primes))))))]
(let [ [a b c] (primes-interval n)]
(and (= n b) (= n (/ (+ a c) 2))))))
(and (= false (balanced-prime? 4))
(= true (balanced-prime? 563))
(= 1103 (nth (filter balanced-prime? (range)) 15)))
#+END_SRC
- Problem 117
For Science!
#+BEGIN_SRC clojure ;; 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: ;; ;;
-
;;
;;
- spaces represent areas where the mouse can walk freely ;; ;;
- hashes (#) represent walls where the mouse can not walk ;; ;;
- M represents the mouse's starting point ;; ;;
- C represents the cheese which the mouse must reach ;; ;;
;; Notes:
;; Use graph concepts explicitly for training purposes
;; 1. Make a labelled graph of coordinates and keep only navigable paths.
;; 2. Find the mouse position.
;; 3. Jump to adjacent edges (coordinates) and check the label.
;; 4. Could have written 10-15 less lines of code without formalities.
(defn cheese-reachable? [maze]
(letfn [(unsigned-int [n] (if (>= n 0) n (* n -1)))
(make-labelled-graph [maze]
(->> (for [i (range (count maze))]
(for [j (range (count (first maze)))
:let [label (get-in maze [i j])]
:when (not= label \#)]
[i j label]))
(reduce concat)
set))
(next-edges [[u v _] g]
(filter (fn [[a b _]]
(and (or (= a u) (= b v))
(= 1 (unsigned-int (- (or (first (reduce disj
(set [u v])
[a b]))
u)
(or (first (reduce disj
(set [a b])
[u v]))
a))))))
g))
(bfs-iter-match? [maze]
(let [graph (make-labelled-graph maze)
start (first (filter (fn [[i j label]] (= label \M)) graph))]
(loop [visits (-> (clojure.lang.PersistentQueue/EMPTY) (conj start))
seen #{start}]
(if (empty? visits)
false
(let [cur (peek visits)
cur-visits (pop visits)]
(if (= (last cur) \C)
true
(let [next-steps (->> (next-edges cur (disj graph cur))
(filter #(not (contains? seen %1))))
next-visits (reduce conj cur-visits next-steps)
next-seen (reduce conj seen next-steps)]
(recur next-visits next-seen))))))))]
(bfs-iter-match? maze)))
(and
(= true (cheese-reachable? ["M C"]))
(= false (cheese-reachable? ["M # C"]))
(= true (cheese-reachable? ["#######"
"# #"
"# # #"
"#M # C#"
"#######"]))
(= false (cheese-reachable? ["########"
"#M # #"
"# # #"
"# # # #"
"# # #"
"# # #"
"# # # #"
"# # #"
"# # C#"
"########"]))
(= false (cheese-reachable? ["M "
" "
" "
" "
" ##"
" #C"]))
(= true (cheese-reachable? ["C######"
" # "
" # # "
" # #M"
" # "]))
(= true (cheese-reachable? ["C# # # #"
" "
"# # # # "
" "
" # # # #"
" "
"# # # #M"])))
#+END_SRC
- Problem 118
Re-implement Map
#+BEGIN_SRC clojure ;; Problem 118 ;; ;;
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.
;;
;; Restrictions (please don't use these function(s)): map, map-indexed, mapcat, for
(defn do-map [f col]
((fn step [xs]
(lazy-seq
(when-not (empty? xs)
(cons (f (first xs)) (step (rest xs))))))
col))
(and (= [3 4 5 6 7]
(do-map inc [2 3 4 5 6]))
(= (repeat 10 nil)
(do-map (fn [_] nil) (range 10)))
(= [1000000 1000001]
(->> (do-map inc (range))
(drop (dec 1000000))
(take 2))))
#+END_SRC
- Problem 119
Win at Tic-Tac-Toe
#+BEGIN_SRC clojure ;;
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.</p>
;; <p>Board coordinates should be as in calls to <code>get-in</code>.
;; For example, <code>[0 1]</code> is the topmost row, center position.</p>
(defn win-tic-tac-toe-moves [piece board]
(letfn [(winning-moves [piece board cell-groups]
(reduce (fn [acc cell-group]
(let [group-vals (mapv (fn [[i j]] ((board i) j)) cell-group)
empty-idxs (keep-indexed #(when (= %2 :e) %1) group-vals)]
(if (and (= 1 (count empty-idxs))
(= 2 (count (filter #(= piece %1) group-vals))))
(conj acc (nth cell-group (first empty-idxs)))
acc)))
#{} cell-groups))
(make-groups [board]
(let [max-col (count board)
max-row (count (first board))]
(concat
(for [i (range max-col)] (for [j (range max-row)] [i j]))
(for [j (range max-row)] (for [i (range max-col)] [i j]))
[(for [i (range max-row)] [i i])]
[(for [i (reverse (range max-row))] [i (dec (- max-row i))])])))]
(->> (make-groups board) (winning-moves piece board))))
(and
(= (win-tic-tac-toe-moves :x
[[:o :e :e]
[:o :x :o]
[:x :x :e]])
#{[2 2] [0 1] [0 2]})
(= (win-tic-tac-toe-moves :x [[:x :o :o]
[:x :x :e]
[:e :o :e]])
#{[2 2] [1 2] [2 0]})
(= (win-tic-tac-toe-moves :x [[:x :e :x]
[:o :x :o]
[:e :o :e]])
#{[2 2] [0 1] [2 0]})
(= (win-tic-tac-toe-moves :x [[:x :x :o]
[:e :e :e]
[:e :e :e]])
#{})
(= (win-tic-tac-toe-moves :o [[:x :x :o]
[:o :e :o]
[:x :e :e]])
#{[2 2] [1 1]}))
#+END_SRC
- Problem 120
Sum of square of digits
#+BEGIN_SRC clojure ;; 4Clojure Question 120 ;; ;; 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.
(defn cnt-<-x2-sum-digits [xs]
(letfn [(digits [n]
(lazy-seq
(loop [x n r '()]
(if (< x 10) (cons x r)
(recur (quot x 10) (cons (mod x 10) r))))))
(square-sum [col]
(reduce + (map (fn [x] (Math/pow x 2)) col)))]
(reduce (fn [total num]
(let [num-digits (digits num)
num-square-sum (square-sum num-digits)]
(if (< num num-square-sum) (inc total) total)))
0
xs)))
(and (= 8 (cnt-<-x2-sum-digits (range 10)))
(= 19 (cnt-<-x2-sum-digits (range 30)))
(= 50 (cnt-<-x2-sum-digits (range 100)))
(= 50 (cnt-<-x2-sum-digits (range 1000))))
#+END_SRC
- Problem 121
Universal Computation Engine
#+BEGIN_SRC clojure ;; Given a mathematical formula in prefix notation, return a function that calculates ;; the value of the formula. ;; The formula can contain nested calculations using the four basic ;; mathematical operators, numeric constants, and symbols representing variables. ;; The returned function has to accept a single parameter containing the map ;; of variable names to their values.
(defn uce [expr]
(let [fn-mappings (apply hash-map ['+ + '- - '* * '/ /])]
(letfn [(map-args [st mappings]
(map (fn [sym]
(if (coll? sym)
(map-args sym mappings)
(get mappings sym sym)))
st))
(visit [[op & arguments]]
(if (nil? arguments)
(recur op)
(if-not (some coll? arguments)
(apply (fn-mappings op) arguments)
(visit
(cons op (map (fn [x]
(if (coll? x)
(visit x)
x))
arguments))))))]
(fn [& args]
(->> (map-args expr (first args)) visit)))))
(and
(= 2 ((uce '(/ a b))
'{b 8 a 16}))
(= 8 ((uce '(+ a b 2))
'{a 2 b 4}))
(= [6 0 -4]
(map (uce '(* (+ 2 a)
(- 10 b)))
'[{a 1 b 8}
{b 5 a -2}
{a 2 b 11}]))
(= 1 ((uce '(/ (+ x 2)
(* 3 (+ y 1))))
'{x 4 y 1})))
#+END_SRC
- Problem 122
Read a binary number
#+BEGIN_SRC clojure ;; Convert a binary number, provided in the form of a string, to its numerical value.
(defn bin->decimal [xs]
(let [col (map #(read-string %) (reverse (re-seq #"\d" xs)))]
(bigint (reduce +' (map-indexed #(* (Math/pow 2 %1) %2) col)))))
(defn bin->decimal-java [str-xs]
(Integer/valueOf str-xs 2))
(and (= 0 (bin->decimal "0"))
(= 7 (bin->decimal "111"))
(= 8 (bin->decimal "1000"))
(= 9 (bin->decimal "1001"))
(= 255 (bin->decimal "11111111"))
(= 1365 (bin->decimal "10101010101"))
(= 65535 (bin->decimal "1111111111111111")))
#+END_SRC
- Problem 123
THERE IS NO PROBLEM 123
- Problem 124
Analyze Reversi-TODO
#+BEGIN_SRC clojure ;;
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.
;;
Board coordinates should be as in calls to get-in.
;; For example, [0 1] is the topmost row, second column from the left.
(defn reversi [board color])
(and (= {[1 3] #{[1 2]}, [0 2] #{[1 2]}, [3 1] #{[2 1]}, [2 0] #{[2 1]}} (reversi '[[e e e e] [e w b e] [e b w e] [e e e e]] 'w))
(= {[3 2] #{[2 2]}, [3 0] #{[2 1]}, [1 0] #{[1 1]}} (reversi '[[e e e e] [e w b e] [w w w e] [e e e e]] 'b))
(= {[0 3] #{[1 2]}, [1 3] #{[1 2]}, [3 3] #{[2 2]}, [2 3] #{[2 2]}} (reversi '[[e e e e] [e w b e] [w w b e] [e e b e]] 'w))
(= {[0 3] #{[2 1] [1 2]}, [1 3] #{[1 2]}, [2 3] #{[2 1] [2 2]}} (reversi '[[e e w e] [b b w e] [b w w e] [b w w w]] 'b)))
#+END_SRC
- Problem 125
Gus' Quinundrum-TODO
#+BEGIN_SRC clojure ;; Create a function of no arguments which returns a string that ;; is an exact copy of the function itself.
;; Hint: read <a href="http://en.wikipedia.org/wiki/Quine_(computing)">this</a>
;; 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!
;; Fun fact: Gus is the name of the <a href="http://i.imgur.com/FBd8z.png">4Clojure dragon</a>.
(= (str '__) (__))
#+END_SRC
- Problem 126
Through the Looking Class
#+BEGIN_SRC clojure ;; Enter a value which satisfies the following:
(let [x Class]
(and (= (class x) x) x))
#+END_SRC
- Problem 127
Love Triangle-TODO
#+BEGIN_SRC clojure ;; Everyone loves triangles, and it's easy to understand why— ;; they're so wonderfully symmetric (except scalenes, they suck).
;; 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.
;; Someone has already written a
;; <a href="http://en.wikipedia.org/wiki/Computer_vision">computer-vision</a>
;; system for the mine.
;; It images each rock as it comes into the processing centre and
;; creates a cross-sectional
;; <a href="http://en.wikipedia.org/wiki/Bit_array">bitmap</a>
;; of mineral (1) and rock (0) concentrations for each one.
;; 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:
;; <li>The minerals only have smooth faces when sheared vertically
;; or horizontally from the rock's cross-section</li>
;;
;; <li>The mine is only concerned with harvesting isosceles triangles
;; (such that one or two sides can be sheared)</li>
;;
;; <li>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)</li>
;;
;; <li>The harvested mineral may not contain any traces of rock</li>
;;
;; <li>The mineral may lie in any orientation in the plane</li>
;;
;; <li>Area should be calculated as the sum of 1s that comprise the mineral</li>
;;
;; <li>Minerals must have a minimum of three measures of area to be harvested</li>
;;
;; <li>If no minerals can be harvested from the rock, your function should return nil</li>
;;
;; </ul>
(defn love-triangle [xs]
(let [mk-digits (fn [xs]
(->> (map #(Integer/toBinaryString %1) xs)
(mapv (fn [x]
(mapv #(Character/getNumericValue %1) x)))))
get-triangles (fn [tree]
)
]
(mk-digits xs)
))
(and
(= 10 (love-triangle [15 15 15 15 15]))
; 1111 1111
; 1111 *111
; 1111 -> **11
; 1111 ***1
; 1111 ****
(= 15 (love-triangle [1 3 7 15 31]))
; 00001 0000*
; 00011 000**
; 00111 -> 00***
; 01111 0****
; 11111 *****
(= 3 (love-triangle [3 3]))
; 11 *1
; 11 -> **
(= 4 (love-triangle [7 3]))
; 111 ***
; 011 -> 0*1
(= 6 (love-triangle [17 22 6 14 22]))
; 10001 10001
; 10110 101*0
; 00110 -> 00**0
; 01110 0***0
; 10110 10110
(= 9 (love-triangle [18 7 14 14 6 3]))
; 10010 10010
; 00111 001*0
; 01110 01**0
; 01110 -> 0***0
; 00110 00**0
; 00011 000*1
(= nil (love-triangle [21 10 21 10]))
; 10101 10101
; 01010 01010
; 10101 -> 10101
; 01010 01010
(= nil (love-triangle [0 31 0 31 0]))
; 00000 00000
; 11111 11111
; 00000 -> 00000
; 11111 11111
; 00000 00000
)
#+END_SRC
- Problem 128
Recognize Playing Cards
#+begin_src clojure ;; A standard American deck of playing cards has four suits ;; - spades, hearts, diamonds, and clubs - and thirteen cards in each suit. ;; Two is the lowest rank, followed by other integers up to ten; ;; then the jack, queen, king, and ace.
;; It's convenient for humans to represent these cards as suit/rank pairs, ;; such as H5 or DQ: the heart five and diamond queen respectively. ;; But these forms are not convenient for programmers, ;; so to write a card game you need some way to parse an input string ;; into meaningful components. For purposes of determining rank, ;; we will define the cards to be valued from 0 (the two) to 12 (the ace).
;; Write a function which converts (for example) the string "SJ" into a map
;; of {:suit :spade, :rank 9}. A ten will always be represented
;; with the single character "T", rather than the two characters "10".
(defn decode-card [code] (let [suits {\D :diamond \H :heart \S :spade \C :club} ranks {\A 12 \K 11 \Q 10 \T 10 \J 9} get-rank (fn [x] (cond (Character/isDigit x) (- (Character/getNumericValue x) 2) (= \T x) (- (ranks x) 2) :else (ranks x)))] (-> (assoc {} :suit (suits (first code))) (assoc :rank (get-rank (last code))))))
(and (= {:suit :diamond :rank 10} (decode-card "DQ")) (= {:suit :heart :rank 3} (decode-card "H5")) (= {:suit :club :rank 12} (decode-card "CA")) (= (range 13) (map (comp :rank decode-card str) '[S2 S3 S4 S5 S6 S7 S8 S9 ST SJ SQ SK SA]))) #+end_src
- Problem 129
THERE IS NO PROBLEM 129
- Problem 130
Tree reparenting-TODO
#+BEGIN_SRC clojure
;; 4Clojure Question 130
;;
;; 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.
;;
;;
;;
;; 
;;
;;
;;
;; 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.
;;
;;
;;
;; Use M-x 4clojure-check-answers when you're done!
(= '(n)
(__ 'n '(n)))
(= '(a (t (e)))
(__ 'a '(t (e) (a))))
(= '(e (t (a)))
(__ 'e '(a (t (e)))))
(= '(a (b (c)))
(__ 'a '(c (b (a)))))
(= '(d
(b
(c)
(e)
(a
(f
(g)
(h)))))
(__ 'd '(a
(b
(c)
(d)
(e))
(f
(g)
(h)))))
(= '(c
(d)
(e)
(b
(f
(g)
(h))
(a
(i
(j
(k)
(l))
(m
(n)
(o))))))
(__ 'c '(a
(b
(c
(d)
(e))
(f
(g)
(h)))
(i
(j
(k)
(l))
(m
(n)
(o))))))
#+END_SRC
- Problem 131
Sum Some Set Subsets
#+BEGIN_SRC clojure ;; 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.
;; Reusing powerset function from Question 85
(defn common-subset-sum? [& xs]
(letfn [(non-empty-subsets [col]
(keep #(not-empty %1) (powerset col)))
(subsets-sum [col]
(into #{} (map #(reduce + %1) col)))
(find-common-subsets [subsets-sums]
(reduce #(filter (set %1) %2) (first subsets-sums) (rest subsets-sums)))]
(if (= 1 (count xs))
true
(->> (map non-empty-subsets xs) (map subsets-sum) find-common-subsets count pos?))))
(and
(= true (common-subset-sum? #{-1 1 99}
#{-2 2 888}
#{-3 3 7777}))
; ex. all sets have a
; subset which sums to zero
(= false (common-subset-sum? #{1}
#{2}
#{3}
#{4}))
(= true (common-subset-sum? #{1}))
(= false (common-subset-sum? #{1 -3 51 9}
#{0}
#{9 2 81 33}))
(= true (common-subset-sum? #{1 3 5}
#{9 11 4}
#{-3 12 3}
#{-3 4 -2 10}))
(= false (common-subset-sum? #{-1 -2 -3 -4 -5 -6}
#{1 2 3 4 5 6 7 8 9}))
(= true (common-subset-sum? #{1 3 5 7}
#{2 4 6 8}))
(= true (common-subset-sum? #{-1 3 -5 7 -9 11 -13 15}
#{1 -3 5 -7 9 -11 13 -15}
#{1 -1 2 -2 4 -4 8 -8}))
(= true (common-subset-sum? #{-10 9 -8 7 -6 5 -4 3 -2 1}
#{10 -9 8 -7 6 -5 4 -3 2 -1})))
#+END_SRC
- Problem 132
Insert between two items
#+begin_src clojure
;; Write a function that takes a two-argument predicate,
;; a value, and a collection; and returns a new collection
;; where the value is inserted between every
;; two items that satisfy the predicate.
(defn insert-between-items [pred sep xs] (let [col (partition-all 2 1 xs)] ((fn step [items] (lazy-seq (when-not (empty? items) (let [[prev cur] (first items)] (if cur (if (pred prev cur) (cons prev (cons sep (step (rest items)))) (cons prev (step (rest items)))) (cons prev nil)))))) col)))
(and (= '(1 :less 6 :less 7 4 3) (insert-between-items < :less [1 6 7 4 3])) (= '(2) (insert-between-items > :more [2])) (= [0 1 :x 2 :x 3 :x 4] (insert-between-items #(and (pos? %) (< % %2)) :x (range 5))) (empty? (insert-between-items > :more ())) (and (= [0 1 :same 1 2 3 :same 5 8 13 :same 21] (take 12 (->> [0 1] (iterate (fn [[a b]] [b (+ a b)])) (map first) ; fibonacci numbers (insert-between-items (fn [a b] ; both even or both odd (= (mod a 2) (mod b 2))) :same))))))
#+end_src
- Problem 133
THERE IS NO PROBLEM 133
- Problem 134
A nil key
#+BEGIN_SRC clojure ;; Write a function which, given a key and map, ;; returns true if the map contains an entry with that key and its value is nil.
(defn nil-key? [k m]
(nil? (m k false)))
(and (true? (nil-key? :a {:a nil :b 2}))
(false? (nil-key? :b {:a nil :b 2}))
(false? (nil-key? :c {:a nil :b 2})))
#+END_SRC
- Problem 135
Infix Calculator
#+BEGIN_SRC clojure ;; 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.
(defn infix-calc
[& expr]
((fn step [init [a f b & more]]
(if-not f
init
(let [r (f a b)]
(recur r (cons r more)))))
0 expr))
(and (= 7 (infix-calc 2 + 5))
(= 42 (infix-calc 38 + 48 - 2 / 2))
(= 8 (infix-calc 10 / 2 - 1 * 2))
(= 72 (infix-calc 20 / 2 + 2 + 4 + 8 - 6 - 10 * 9)))
#+END_SRC
- Problem 136
THERE IS NO PROBLEM 136
- Problem 137
Digits and bases
#+BEGIN_SRC clojure ;; Write a function which returns a sequence of digits ;; of a non-negative number (first argument) in numerical ;; system with an arbitrary base (second argument). ;; Digits should be represented with their integer values, ;; e.g. 15 would be [1 5] in base 10, [1 1 1 1] in base 2 ;; and [15] in base 16.
(defn seq-digits [num radix]
((fn step [r n base]
(if (pos? n)
(let [d (mod n base)
q (quot n base)]
(recur (cons d r) q base))
(if (empty? r) '(0) r)))
'() num radix))
(and (= [1 2 3 4 5 0 1] (seq-digits 1234501 10))
(= [0] (seq-digits 0 11))
(= [1 0 0 1] (seq-digits 9 2))
(= [1 0] (let [n (rand-int 100000)](seq-digits n n)))
(= [16 18 5 24 15 1] (seq-digits Integer/MAX_VALUE 42)))
#+END_SRC
- Problem 138
Squares Squared-TODO
#+BEGIN_SRC clojure ;; 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.
(defn squares-squared [start end] (let [build-seq (fn [start end] (loop [i start j end acc []] (if (> i j) acc (let [next-i (Math/pow i 2)] (recur next-i j (conj acc (long i)))))))
rotate-45 (fn [xs] xs)
make-matrix (fn [nums]
(mapv #(str %1) nums))]
(->> (build-seq start end)
(make-matrix)
(rotate-45))))
(and (= (squares-squared 2 2) ["2"])
(= (squares-squared 2 4) [" 2 " "* 4" " * "])
(= (squares-squared 3 81) [" 3 " "1 9" " 8 "])
(= (squares-squared 4 20) [" 4 " "* 1" " 6 "])
(= (squares-squared 2 256) [" 6 " " 5 * " "2 2 *" " 6 4 " " 1 "])
(= (squares-squared 10 10000) [" 0 " " 1 0 " " 0 1 0 " "* 0 0 0" " * 1 * " " * * " " * "])) #+END_SRC
- Problem 139
THERE IS NO PROBLEM 139
- Problem 140
Veitch, Please!-TODO
#+BEGIN_SRC clojure ;; 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. ;; ;; You may want to give this a read before proceeding: ;; K-Maps
(= (__ #{#{'a 'B 'C 'd} #{'A 'b 'c 'd} #{'A 'b 'c 'D} #{'A 'b 'C 'd} #{'A 'b 'C 'D} #{'A 'B 'c 'd} #{'A 'B 'c 'D} #{'A 'B 'C 'd}}) #{#{'A 'c} #{'A 'b} #{'B 'C 'd}})
(= (__ #{#{'A 'B 'C 'D} #{'A 'B 'C 'd}}) #{#{'A 'B 'C}})
(= (__ #{#{'a 'b 'c 'd} #{'a 'B 'c 'd} #{'a 'b 'c 'D} #{'a 'B 'c 'D} #{'A 'B 'C 'd} #{'A 'B 'C 'D} #{'A 'b 'C 'd} #{'A 'b 'C 'D}}) #{#{'a 'c} #{'A 'C}})
(= (__ #{#{'a 'b 'c} #{'a 'B 'c} #{'a 'b 'C} #{'a 'B 'C}}) #{#{'a}})
(= (__ #{#{'a 'B 'c 'd} #{'A 'B 'c 'D} #{'A 'b 'C 'D} #{'a 'b 'c 'D} #{'a 'B 'C 'D} #{'A 'B 'C 'd}}) #{#{'a 'B 'c 'd} #{'A 'B 'c 'D} #{'A 'b 'C 'D} #{'a 'b 'c 'D} #{'a 'B 'C 'D} #{'A 'B 'C 'd}})
(= (__ #{#{'a 'b 'c 'd} #{'a 'B 'c 'd} #{'A 'B 'c 'd} #{'a 'b 'c 'D} #{'a 'B 'c 'D} #{'A 'B 'c 'D}}) #{#{'a 'c} #{'B 'c}})
(= (__ #{#{'a 'B 'c 'd} #{'A 'B 'c 'd} #{'a 'b 'c 'D} #{'a 'b 'C 'D} #{'A 'b 'c 'D} #{'A 'b 'C 'D} #{'a 'B 'C 'd} #{'A 'B 'C 'd}}) #{#{'B 'd} #{'b 'D}})
(= (__ #{#{'a 'b 'c 'd} #{'A 'b 'c 'd} #{'a 'B 'c 'D} #{'A 'B 'c 'D} #{'a 'B 'C 'D} #{'A 'B 'C 'D} #{'a 'b 'C 'd} #{'A 'b 'C 'd}}) #{#{'B 'D} #{'b 'd}}) #+END_SRC
- Problem 141
Tricky card games
#+BEGIN_SRC clojure ;; 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.
;; 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.
(defn tricky-card-game-winner [trump-suit] (fn [args] (let [effective-trump-suit (or trump-suit (:suit (first args)))] (->> (filter #(= (:suit %1) effective-trump-suit) args) (apply max-key :rank)))))
(and (let [notrump (tricky-card-game-winner nil)] (and (= {:suit :club :rank 9} (notrump [{:suit :club :rank 4} {:suit :club :rank 9}])) (= {:suit :spade :rank 2} (notrump [{:suit :spade :rank 2} {:suit :club :rank 10}]))))
(= {:suit :club :rank 10} ((tricky-card-game-winner :club) [{:suit :spade :rank 2} {:suit :club :rank 10}]))
(= {:suit :heart :rank 8} ((tricky-card-game-winner :heart) [{:suit :heart :rank 6} {:suit :heart :rank 8} {:suit :diamond :rank 10} {:suit :heart :rank 4}]))) #+END_SRC
- Problem 142
THERE IS NO PROBLEM 142
- Problem 143
Dot Product
#+BEGIN_SRC clojure ;; Problem 143 ;; http://en.wikipedia.org/wiki/Dot_product#Definition ;; ;; Create a function that computes the dot product of two sequences. ;; You may assume that the vectors will have the same length.
(defn dot-product
"dot product of two sequences"
[c1 c2]
{:pre [(= (count c1) (count c2))]}
(reduce + (map * c1 c2)))
(and (= 0 (dot-product [0 1 0] [1 0 0]))
(= 3 (dot-product [1 1 1] [1 1 1]))
(= 32 (dot-product [1 2 3] [4 5 6]))
(= 256 (dot-product [2 5 6] [100 10 1])))
#+END_SRC
- Problem 144
Oscillate iterate
#+BEGIN_SRC clojure ;; Problem 144 ;; ;; 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.
;; Did not know details about 'reductions' function
;; (reductions f init col)
(defn oscillating-iterate
[n & [f fs]]
(cons n
(lazy-seq
(when f
(oscillating-iterate (f n) fs)))))
(and (= (take 4 (oscillating-iterate 3.14 int double)) [3.14 3 3.0])
(= (take 5 (oscillating-iterate 3 #(- % 3) #(+ 5 %))) [3 0 5 2 7])
(= (take 12 (oscillating-iterate 0 inc dec inc dec inc)) [0 1 0 1 0 1 2 1 2 1 2 3]))
#+END_SRC
- Problem 145
For the win
#+BEGIN_SRC clojure
;; Clojure's for macro is a tremendously versatile mechanism
;; for producing a sequence based on some other sequence(s).
;; It can take some time to understand how to use it properly,
;; but that investment will be paid back with clear,
;; concise sequence-wrangling later.
;;
;; With that in mind, read over these for expressions
;; and try to see how each of them produces the same result.
;;
;; answer (take-nth 4 (range 1 40))
(and (= (take-nth 4 (range 1 40)) (for [x (range 40)
:when (= 1 (rem x 4))]
x))
(= (take-nth 4 (range 1 40)) (for [x (iterate #(+ 4 %) 0)
:let [z (inc x)]
:while (< z 40)]
z))
(= (take-nth 4 (range 1 40)) (for [[x y] (partition 2 (range 20))]
(+ x y))))
#+END_SRC
- Problem 146
Trees into tables
#+BEGIN_SRC clojure ;;
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.
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.
1 That is, (get-in original [k1 k2]) should
;; be the same as (get result [k1 k2])
(defn tree->table
"Flattens a map."
[m]
(reduce (fn [acc [k v]]
(reduce (fn step [p [ke ve]]
(assoc p [k ke] ve))
acc (seq v)))
{} m))
(and (= (tree->table '{a {p 1, q 2}
b {m 3, n 4}})
'{[a p] 1, [a q] 2
[b m] 3, [b n] 4})
(= (tree->table '{[1] {a b c d}
[2] {q r s t u v w x}})
'{[[1] a] b, [[1] c] d,
[[2] q] r, [[2] s] t,
[[2] u] v, [[2] w] x})
(= (tree->table '{m {1 [a b c] 3 nil}})
'{[m 1] [a b c], [m 3] nil}))
#+END_SRC
- Problem 147
Pascal's Trapezoid
#+BEGIN_SRC clojure ;;
Write a function that, for any given input vector of numbers, ;; returns an infinite lazy sequence of vectors, where each next one ;; is constructed from the previous following the rules used in ;; Pascal's Triangle. ;; For example, for [3 1 2], the next row is [3 4 3 2].
;; ;;Beware of arithmetic overflow! In clojure (since version 1.3 in 2011), ;; if you use an arithmetic operator like + and the result is too large to ;; fit into a 64-bit integer, an exception is thrown. ;; You can use +' to indicate that you would rather overflow into Clojure's slower, ;; arbitrary-precision bigint.
(defn pascal-triangle [xs]
(letfn [(stepper [xs]
(-> (into [(first xs)] (map #(reduce +' %1N) (partition 2 1 xs)))
(conj (last xs))))]
(iterate stepper xs)))
(and
(= (second (pascal-triangle [2 3 2])) [2 5 5 2])
(= (take 5 (pascal-triangle [1])) [[1] [1 1] [1 2 1] [1 3 3 1] [1 4 6 4 1]])
(= (take 2 (pascal-triangle [3 1 2])) [[3 1 2] [3 4 3 2]])
(= (take 100 (pascal-triangle [2 4 2])) (rest (take 101 (pascal-triangle [2 2])))))
#+END_SRC
- Problem 148
The Big Divide
#+BEGIN_SRC clojure ;;
Write a function which calculates the sum of all natural numbers ;; under n (first argument) which are evenly divisible by at ;; least one of a and b (second and third argument).
;; Numbers a and b are guaranteed to be ;; coprimes.
;;
Note: Some test cases have a very large n, ;; so the most obvious solution will exceed the time limit.
(defn big-divide [n a b] (letfn [(n-sum [x limit] (let [n-val (quot limit x)] (if (pos? n-val) (-> (inc n-val) (' n-val) (/ 2) (' x) bigint) 0)))] (let [limit (dec n)] (-> (+' (n-sum a limit) (n-sum b limit)) (-' (n-sum (*' a b) limit))))))
(and (= 0 (big-divide 3 17 11))
(= 23 (big-divide 10 3 5))
(= 233168 (big-divide 1000 3 5))
(= "2333333316666668" (str (big-divide 100000000 3 5)))
(= "110389610389889610389610" (str (big-divide (* 10000 10000 10000) 7 11)))
(= "1277732511922987429116" (str (big-divide (* 10000 10000 10000) 757 809)))
(= "4530161696788274281" (str (big-divide (* 10000 10000 1000) 1597 3571)))) #+END_SRC
- Problem 149
THERE IS NO PROBLEM 149
- Problem 150
Palindromic number
#+begin_src clojure ;; A palindromic number is a number that is the same ;; when written forwards or backwards (e.g., 3, 99, 14341). ;; 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. ;; The most simple solution will exceed the time limit!
(defn palindromic-num-sieve [n] (letfn [(num->digits [n] (loop [x n r []] (if (< x 10) (into [x] r) (recur (quot x 10) (into [(mod x 10)] r)))))
(digits->num [xs]
(let [ln (count xs)
last-idx (dec ln)]
(reduce (fn [r idx]
(+' r (bigint (*' (Math/pow 10N idx) (xs (-' last-idx idx))))))
0N (range ln))))
(get-mid-idx [digits]
(bigint (Math/ceil (/ (count digits) 2))))
(mirror-digits [left-digits mid-idx to-replicate]
(if (zero? mid-idx)
left-digits
(into left-digits (reverse (take to-replicate left-digits)))))
(inc-digits [digits pos]
(if (neg? pos)
;; we have to grow the left side
(into [1] (repeat (count digits) 0))
(let [num-at-pos (digits pos)]
(if (< num-at-pos 9)
(assoc digits pos (inc num-at-pos))
(recur (assoc digits pos 0) (dec pos) )))))
(maybe-match-first-last-digits [digits left-side-grown?]
(if left-side-grown?
(assoc digits (dec (count digits)) (first digits))
digits))
(cur-palindrome [pal-number inc-left-side?]
(let [pal (num->digits pal-number)
mid-idx (get-mid-idx pal)
left-digits (if (neg? mid-idx) pal (subvec pal 0 mid-idx))
next-left-digits (if inc-left-side?
(inc-digits left-digits (dec (count left-digits)))
left-digits)
to-replicate (bigint (Math/floor (/ (count pal) 2)))
left-grown? (> (count next-left-digits) (count left-digits))]
(-> (mirror-digits next-left-digits mid-idx to-replicate)
(maybe-match-first-last-digits left-grown?)
digits->num)))
(next-palindrome [pal-number] (cur-palindrome pal-number true))
(ensure-palindrome [cur-num target]
(if (< cur-num 9)
(bigint cur-num)
(let [next-num (cur-palindrome cur-num false)]
(if (< next-num target)
(cur-palindrome cur-num true)
next-num))))]
(iterate next-palindrome (ensure-palindrome n n))))
(and (= (take 26 (palindromic-num-sieve 0)) [0 1 2 3 4 5 6 7 8 9 11 22 33 44 55 66 77 88 99 101 111 121 131 141 151 161])
(= (take 16 (palindromic-num-sieve 162)) [171 181 191 202 212 222 232 242 252 262 272 282 292 303 313 323])
;; (= (take 6 (palindromic-num-sieve 1234550000)) [1234554321 1234664321 1234774321 1234884321 1234994321 1235005321])
(= (first (palindromic-num-sieve (* 111111111 111111111))) (* 111111111 111111111))
(= (set (take 199 (palindromic-num-sieve 0))) (set (map #(first (palindromic-num-sieve %)) (range 0 10000))))
(= true (apply < (take 6666 (palindromic-num-sieve 9999999))))
(= (nth (palindromic-num-sieve 0) 10101) 9102019)) #+end_src
- Problem 164 - INPROGRESS
Language of a DFA TBD: recursion -> iteration to pass test
#+BEGIN_SRC clojure ;; http://en.wikipedia.org/wiki/Deterministic_finite_automaton ;; http://en.wikipedia.org/wiki/Regular_language
;; 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: ;; -:states is the set of states for the DFA. ;; -:alphabet is the set of symbols included in the language recognized by the DFA. ;; -:start is the start state of the DFA. ;; -:accepts is the set of accept states in the DFA. ;; -:transitions is the transition function for the DFA, mapping ;; :states :alphabet onto :states.
;; 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!
(defn analyze-dfa [g] (letfn [(accept? [u] (contains? (:accepts g) u))
(visit [[w u] transitions p r]
(lazy-seq
(let [next-states (seq (get-in g [:transitions u]))
accepted? (accept? u)
cur-path (if (nil? w)
p
(conj p w))
ret (if accepted?
(conj r cur-path)
r)]
(if (empty? next-states)
(map (fn [coll] (apply str coll)) ret)
(mapcat (fn [[sym v]]
(visit [sym v] (dissoc transitions v) cur-path ret))
next-states)))))]
(visit [nil (:start g)] (:transitions g) [] [])))
(and (= #{"a" "ab" "abc"} (set (analyze-dfa '{:states #{q0 q1 q2 q3} :alphabet #{a b c} :start q0 :accepts #{q1 q2 q3} :transitions {q0 {a q1} q1 {b q2} q2 {c q3}}})))
(= #{"hi" "hey" "hello"} (set (analyze-dfa '{:states #{q0 q1 q2 q3 q4 q5 q6 q7} :alphabet #{e h i l o y} :start q0 :accepts #{q2 q4 q7} :transitions {q0 {h q1} q1 {i q2, e q3} q3 {l q5, y q4} q5 {l q6} q6 {o q7}}})))
(= (set (let [ss "vwxyz"] (for [i ss, j ss, k ss, l ss] (str i j k l)))) (set (analyze-dfa '{:states #{q0 q1 q2 q3 q4} :alphabet #{v w x y z} :start q0 :accepts #{q4} :transitions {q0 {v q1, w q1, x q1, y q1, z q1} q1 {v q2, w q2, x q2, y q2, z q2} q2 {v q3, w q3, x q3, y q3, z q3} q3 {v q4, w q4, x q4, y q4, z q4}}})))
(let [res (take 2000 (analyze-dfa '{:states #{q0 q1} :alphabet #{0 1} :start q0 :accepts #{q0} :transitions {q0 {0 q0, 1 q1} q1 {0 q1, 1 q0}}}))] (and (every? (partial re-matches #"0*(?:1010)*") res) (= res (distinct res))))
(let [res (take 2000 (analyze-dfa '{:states #{q0 q1} :alphabet #{n m} :start q0 :accepts #{q1} :transitions {q0 {n q0, m q1}}}))] (and (every? (partial re-matches #"n*m") res) (= res (distinct res))))
(let [res (take 2000 (analyze-dfa '{:states #{q0 q1 q2 q3 q4 q5 q6 q7 q8 q9} :alphabet #{i l o m p t} :start q0 :accepts #{q5 q8} :transitions {q0 {l q1} q1 {i q2, o q6} q2 {m q3} q3 {i q4} q4 {t q5} q6 {o q7} q7 {p q8} q8 {l q9} q9 {o q6}}}))] (and (every? (partial re-matches #"limit|(?:loop)+") res) (= res (distinct res)))))
#+END_SRC