fork download
copy 
  1. (def max-piles-count 7)
  2. (def max-stones-count 10)
  3.  
  4. (defn inc-val [col key] (assoc col key (inc (col key 0))))
  5. (defn dec-val [col key] (let [val (col key)] (if (== 1 val) (dissoc col key) (assoc col key (dec val)))))
  6. (defn take-stones [state position count] (inc-val (dec-val state position) (- position count)))
  7.  
  8. (defn move-from [state] 
  9.     (for [pos (keys state) cnt (range 1 4) :when (<= cnt pos)] 
  10.         (take-stones state pos cnt)))
  11.  
  12. (defn next-state [state]
  13.     (let [pos (first (filter #(< 0 %) (sort < (keys state))))]
  14.         (case pos
  15.             nil nil
  16.             1 (-> state (dec-val 1) (inc-val 0))
  17.             (let [val (+ (state 0 0) (state (dec pos) 0) 1)]
  18.                 (-> state (dec-val pos) (dissoc 0) (assoc (dec pos) val))))))
  19.  
  20. (defn update-values [[state-values state]] [(reduce (fn [sv st] (assoc sv st true)) state-values (move-from state)) state])
  21. (defn find-state [[state-values state]] [state-values (->> (iterate next-state state) (drop 1) (drop-while #(state-values %)) first)])
  22.  
  23. (defn calculate []
  24.     (let [root {(dec max-stones-count) max-piles-count}] 
  25.         (->> (iterate (comp update-values find-state) [{root true} root])  
  26.             (some #(when (nil? (% 1)) (% 0)))))) 
  27.  
  28. (defn number->state [number]
  29.     ((reduce (fn [[st n] _] [(inc-val st (rem n 10)) (quot n 10)]) [{} number] (range max-piles-count)) 0))
  30.  
  31. (defn get-moves [number]
  32.     (for [[pos tens] (take  max-piles-count (iterate (fn [[n e]] [(inc n) (* 10 e)]) [0 1])) cnt (range 1 4) 
  33.         :when (< cnt (-  max-stones-count (rem (quot number tens) 10)))] (+ number (* cnt tens))))
  34.  
  35. (defn solve [number] 
  36.     (let [state-values (calculate)] 
  37.         (if (state-values (number->state number))
  38.             (do (println "First win")
  39.                 (doseq [move (filter #(not (state-values (number->state %))) (get-moves number))] 
  40.                     (print (str move " "))))
  41.             (println "Second win"))))
  42.  
  43. ;main
  44. (solve 16)
Success #stdin #stdout 1.81s 4386816KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
First win
19 36 216 2016 20016 200016 2000016
https://ideone.com/7vusZg
language:
Clojure (clojure 1.10.0)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!