4clojure

core.clj

(ns for-clj.core)

;; utils

(defn
  digits [n base]
  (loop [n n b base acc '()]
    (let [[q m] ((juxt quot mod) n b)
          d     (/ (* base m) b)]
      (if (> q 0)
        (recur (- n m) (* b base) (conj acc d))
        (conj acc d)))))

;; problem 108

(defn search [& colls]
  (let [heads (map first colls)
        mini  (apply min heads)]
    (if (apply = heads)
      (first heads)
      (recur (map (fn [c]
                    (if (= (first c) mini)
                      (rest c)
                      c)) colls)))))

(comment
  #_(search [1 2 3 4 5 6 7] [0.5 3/2 4 19])

  #_(= 4 (search [1 2 3 4 5 6 7] [0.5 3/2 4 19])))

;; problem 116

(def ->primes #(map first
                    (iterate
                     (fn [[x & xs]]
                       (filter (fn [y] (not= (mod y x) 0)) xs))
                     (iterate inc 2))))

(defn b-prime? [n]
  (let [ps (map first
                (iterate
                 (fn [[x & xs]]
                   (filter (fn [y] (not= (mod y x) 0)) xs))
                 (iterate inc 2)))
        i (.indexOf (take-while #(>= n %) ps) n)]

    (if (or (zero? i) (neg? i)) false
        (let [prev (nth ps (dec i))
              next (nth ps (inc i))
              mean (/ (+ prev next) 2)]
          (= n mean)))))

(comment
  #_(b-prime? 4)
  #_(b-prime? 563)

  #_(= false (b-prime? 4))

  #_(= true  (b-prime? 563))

  #_(= 1103 (nth (filter b-prime? (range)) 15))

  #_(take 5 (filter b-prime? (range))))

;; problem 171

(defn intervals [coll]
  (loop [acc [] v [] coll (sort coll)]
    (cond
      (and (empty? coll) (empty? v))
      acc

      (empty? coll)
      (conj acc ((juxt first last) v))

      (empty? v)
      (recur acc (conj v (first coll)) (rest coll))

      (= (first coll) (inc (last v)))
      (recur acc (conj v (first coll)) (rest coll))

      (some #{(first coll)} v)
      (recur acc v (rest coll))

      :else
      (recur (conj acc ((juxt first last) v)) [(first coll)] (rest coll))
      )
    )
  )

(comment
  #_(intervals [10 9 8 1 2 3])
  #_(= (intervals [10 9 8 1 2 3]) [[1 3] [8 10]])

  #_(intervals []))

;; problem 73

(defn ttt? [board]
  (let [wins  #{#{:x} #{:o}}
        diags [(for [i (range (count board))]
                 (nth (nth board i) (dec (- (count board) i))))
               (for [i (range (count board))]
                 (nth (nth board i) i))]
        lines  (concat board
                       (apply map vector board)
                       diags)]

    (ffirst (filter #(wins (into #{} %)) lines))))

(comment
  #_(= :x (ttt? [[:e :x :x]
                 [:x :e :e]
                 [:o :o :o]])

       ))

;; problem 79

(defn traverse [triangle path]
  (map (fn [row i] (nth row i)) triangle path))

(defn ->paths [triangle & paths]
  (let [paths (or paths [[0]])]
    (if (= (count triangle) (count (first paths)))
      paths

      (recur triangle (mapcat (fn [path] [(conj path (last path))
                                         (conj path (inc (last path)))])
                              paths))
      )))

(defn min-path [triangle]
  (letfn [(->paths [triangle & paths]
            (let [paths (or paths [[0]])]
              (if (= (count triangle) (count (first paths)))
                paths

                (recur triangle (mapcat (fn [path]
                                          [(conj path (last path))
                                           (conj path (inc (last path)))])
                                        paths)))))

          (traverse [triangle path]
            (map (fn [row i] (nth row i)) triangle path))]

    (apply min
           (map (comp (partial apply +)
                      (partial traverse triangle))
                (->paths triangle)))))

(comment
  #_(traverse [[1]
               [2 3]] [0 1])

  #_(->paths [[1]
              [2 4]
              [5 1 4]
              [2 3 4 5]])



  #_(= 7 (min-path '([1]
                     [2 4]
                     [5 1 4]
                     [2 3 4 5])) ; 1->2->1->3

       ))

;; problem 113

(defn dance [& xs]
  (reify clojure.lang.Seqable
    (toString [_] (clojure.string/join ", " (sort xs)))
    (seq      [_] (when (seq xs) (distinct xs)))
    clojure.lang.IPersistentList
    (peek [_] nil)
    (pop [_] nil)))

(comment
  #_(= "1, 2, 3" (str (ff 2 1 3))

       )

  #_(and (= nil (seq (ff)))
         (=  "" (str (ff)))
         ))

;; problem 177

(defn balanced? [s]
  (let [matches #{[\( \)] [\{ \}] [\[ \]]}
        add (fn [acc c]
              (assoc acc :stack (conj (:stack acc) c)))
        del (fn [acc c]
              (if (contains? matches [(peek (:stack acc)) c])
                (assoc acc :stack (pop (:stack acc)))
                (assoc acc :failure true)))

        {:keys [stack failure]}
        (reduce (fn [acc c]
                  (let [op (case c
                             \( add \{ add \[ add
                             \] del \) del \} del
                             (constantly acc))]
                    (op acc c)))
                {:stack [] :failure false} s)]

    (and (empty? stack) (not failure))))

(comment
  #_(balanced? "class Test {
      public static void main(String[] args) {
        System.out.println(\"Hello world.\");
      }
    }")

  #_(not (balanced? "(start, end]"))

  #_(balanced? "())"))

;; problem 92

(defn write-roman [r]
  (let [roman->decimal {\M 1000 \D 500 \C 100 \L 50 \X 10 \V 5 \I 1}]
    (->>
     (loop [prev nil [r & rs] (map roman->decimal r) acc []]
       (cond
         (nil? r)
         (conj acc prev)

         (and (not (nil? prev)) (< prev r))
         (recur nil rs (conj acc (- r prev)))

         :else
         (recur r   rs (conj acc prev))))
     (filter identity)
     (reduce +))))

(comment
  #_(= 827 (write-roman "DCCCXXVII"))

  #_(= 14 (write-roman "XIV")))

;; problem 104

(defn read-roman [r]
  (let [decimal->roman {1   {1 \I 5 \V 10 \X}
                        10  {1 \X 5 \L 10 \C}
                        100 {1 \C 5 \D 10 \M}
                        1000 {1 \M}}
        roman {0 [] 1 [1] 2 [1 1] 3 [1 1 1]
               4 [1 5] 5 [5] 6 [5 1] 7 [5 1 1]
               8 [5 1 1 1] 9 [1 10]}
        digits (comp (partial map (comp #(- % 48) int)) seq str)]
    (->> (digits r)
         reverse
         (map-indexed (fn [i x] [(int (Math/pow 10 i)) x]))
         reverse
         (mapcat (fn [[place n]] (let [m (decimal->roman place)]
                                  (map m (roman n))
                                  )))
         (apply str))))

(comment
  #_(= (read-roman 1) "I")

  #_(= (read-roman 827) "DCCCXXVII")

  #_(= (read-roman 14) "XIV")

  #_(= #{true}
       (into #{} (map (comp (partial apply =) (juxt identity (comp write-roman read-roman))) (range 1 4000)))))

;; Problem 150 - Palindromic Numbers

(defn palindromes
  "Returns numbers >= n that read the same backwards and forwards."
  [n]
  (let [
        digits #_(comp (partial map (comp #(- % 48) int)) seq str)
        (fn [n base]
        (loop [n n b base acc '()]
          (let [[q m] ((juxt quot mod) n b)
                d     (/ (* base m) b)]
            (if (> q 0)
              (recur (- n m) (* b base) (conj acc d))
              (conj acc d)))))
        ]
    (->> (iterate inc n)
         (filter #(let [ds (digits % 10)] (= ds (reverse ds))))
         )))

(defn nth-palindrome [n]
  (if (even? n)
    (* 2  (- (Math/pow 10 (/ n 2))       1))
    (* 11 (- (Math/pow 10 (/ (dec n) 2)) 2))))

(comment
  #_(time (take 20 (palindromes 20)))

  #_(time (= (take 26 (palindromes 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]))

  #_(time (= (take 16 (palindromes 162))
             [171 181 191 202 
              212 222 232 242 
              252 262 272 282 
              292 303 313 323]))

  #_(time (= (take 6 (palindromes 1234550000))
             [1234554321 1234664321 1234774321 
              1234884321 1234994321 1235005321]))

  #_(time (= (first (palindromes (* 111111111 111111111)))
             (* 111111111 111111111)))

  #_(time (= (set (take 199 (palindromes 0)))
             (set (map #(first (palindromes %)) (range 0 10000)))))

  ;; LONG!
  #_(time (= true
             (apply < (take 6666 (palindromes 9999999)))))

  ;; LONG!
  #_(time (= (nth (palindromes 0) 10101)
             9102019)))

;; Problem 94 - Game of Life

(defn life [rows]
  (let [alive? (fn [rows x y]
                 (let [max (count rows)]
                   (cond
                     (or (neg? x) (neg? y) (>= x max) (>= y max)) 0
                     (= \space (nth (nth rows y) x)) 0
                     (= \#     (nth (nth rows y) x)) 1)))

        ->cell (fn [c x y rows]
                 (let [nearby (+
                               (alive? rows (dec x) y)
                               (alive? rows x (dec y))
                               (alive? rows (inc x) y)
                               (alive? rows x (inc y))
                               (alive? rows (dec x) (dec  y))
                               (alive? rows (dec x) (inc y))
                               (alive? rows (inc x) (inc y))
                               (alive? rows (inc x) (dec y)))]

                   (cond
                     (> 2 nearby) \space
                     (> nearby 3) \space
                     (= 3 nearby) \#
                     (and (= 2 nearby) (= \# c)) \#
                     :else \space)))]

    (map-indexed
     (fn [y row]
       (->> row
            (map-indexed
             (fn [x cell]
               (->cell cell x y rows)))
            (apply str)))
     rows)))

(comment
  #_(life ["      "
           " ##   "
           " ##   "
           "   ## "
           "   ## "
           "      "])

  #_(= (life ["      "
              " ##   "
              " ##   "
              "   ## "
              "   ## "
              "      "])
       ["      "
        " ##   "
        " #    "
        "    # "
        "   ## "
        "      "])

  #_(= (life ["     "
              "     "
              " ### "
              "     "
              "     "])
       ["     "
        "  #  "
        "  #  "
        "  #  "
        "     "])

  #_(= (life ["      "
              "      "
              "  ### "
              " ###  "
              "      "
              "      "])
       ["      "
        "   #  "
        " #  # "
        " #  # "
        "  #   "
        "      "]))

;; Problem 141 - Tricky card games

(defn trump->trick [trump]
  (fn [cards]
    (let [trump?    (some #(= (:suit %) trump) cards)
          suit      (if trump? trump (:suit (first cards)))]
      (->> cards
           (filter #(= (:suit %) suit))
           (sort-by :rank)
           last))))

(comment
  (let [notrump (trump->trick 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} ((trump->trick :club) [{:suit :spade :rank 2}
                                                   {:suit :club :rank 10}]))

  (= {:suit :heart :rank 8}
     ((trump->trick :heart) [{:suit :heart :rank 6} {:suit :heart :rank 8}
                             {:suit :diamond :rank 10} {:suit :heart :rank 4}]))

  )

;; Problem 119 - Win at Tic-Tac-Toe

(defn find-ttt-wins [player board]
  (let [->winner (fn [board] ;; via problem 73
                   (let [wins  #{#{:x} #{:o}}
                         diags [(for [i (range (count board))]
                                  (nth (nth board i) (dec (- (count board) i))))
                                (for [i (range (count board))]
                                  (nth (nth board i) i))]
                         lines  (concat board
                                        (apply map vector board)
                                        diags)]

                     (ffirst (filter #(wins (into #{} %)) lines))))]

    (->> (for [x (-> board first count range)
               y (-> board count range)]
           [y x])
         (map (fn [[y x]]
                (when (= :e (get-in board [y x]))
                  [[y x] (assoc-in board [y x] player)])))
         (filter identity)
         (filter #(= player (->winner (second %))))
         (map first)
         set)))

(comment
  (= (find-ttt-wins :x [[:o :e :e]
                        [:o :x :o]
                        [:x :x :e]])
     #{[2 2] [0 1] [0 2]})

  (= (find-ttt-wins :x [[:x :o :o]
             [:x :x :e]
             [:e :o :e]])
     #{[2 2] [1 2] [2 0]})

  (= (find-ttt-wins :x [[:x :e :x]
              [:o :x :o]
              [:e :o :e]])
      #{[2 2] [0 1] [2 0]})

  (= (find-ttt-wins :x [[:x :x :o]
             [:e :e :e]
             [:e :e :e]])
     #{})

  (= (find-ttt-wins :o [[:x :x :o]
             [:o :e :o]
             [:x :e :e]])
     #{[2 2] [1 1]})

  )

;; Problem 178 - Best Hand

(defn best-hand [cards]
  (let [->card (fn [[s r]] {:suit ({\D :diamond \H :heart \C :club \S :spade} s)
                           :rank ((zipmap "23456789TJQKA" (range)) r)})
        cards (map ->card cards)
        sequence? (fn [cards]
                    (let [with-low-ace (map (fn [c] (if (= (:rank c) 12) (assoc c :rank -1) c)) cards)
                          seq? (fn [cs] (->> cs
                                            (map :rank)
                                            sort
                                            ((fn [cs] (and
                                                      (= (count cs) (inc (- (last cs) (first cs))))
                                                      (apply < cs))))))]
                      (or (seq? cards)
                          (seq? with-low-ace))))
        flush? (fn [cs] (apply = (map :suit cs)))
        ranks  (fn [cs] (sort (map count (vals (group-by :rank cs)))))]

    (cond
      (= '(2 3) (ranks cards))
      :full-house

      (= '(1 2 2) (ranks cards))
      :two-pair

      (= 4 (apply max (ranks cards)))
      :four-of-a-kind

      (= 3 (apply max (ranks cards)))
      :three-of-a-kind

      (= 2 (apply max (ranks cards)))
      :pair

      (and (flush? cards) (sequence? cards))
      :straight-flush

      (sequence? cards)
      :straight

      (flush? cards)
      :flush

      :else
      :high-card)))

(comment
  (= :high-card (best-hand ["HA" "D2" "H3" "C9" "DJ"]))
  (= :pair (best-hand ["HA" "HQ" "SJ" "DA" "HT"]))
  (= :two-pair (best-hand ["HA" "DA" "HQ" "SQ" "HT"]))
  (= :three-of-a-kind (best-hand ["HA" "DA" "CA" "HJ" "HT"]))
  (= :straight (best-hand ["HA" "DK" "HQ" "HJ" "HT"]))
  (= :straight (best-hand ["HA" "H2" "S3" "D4" "C5"]))
  (= :flush (best-hand ["HA" "HK" "H2" "H4" "HT"]))
  (= :full-house (best-hand ["HA" "DA" "CA" "HJ" "DJ"]))
  (= :four-of-a-kind (best-hand ["HA" "DA" "CA" "SA" "DJ"]))
  (= :straight-flush (best-hand ["HA" "HK" "HQ" "HJ" "HT"]))
  )