四則ソルバー

sisoku.clj

(use 'clojure.contrib.combinatorics)


(def seeds [7 7 7 9 11 11])
(def result 218/100)



(def inject-pos
  (memoize
   (fn [n m]
     (combinations (range (+ n m)) m))))

(defn inject* [coll items pos]
    (loop
        [p 0,
         [x & xs :as pos] pos,
         [c & cs :as coll] coll,
         [i & is :as items] items,
         acc nil]
      (cond
        (and (nil? c) (nil? i))
          (reverse acc)
        (= p x)
          (recur (inc p) xs coll is (cons i acc))
        true
          (recur (inc p) pos cs items (cons c acc)))))

(defn inject [coll items]
  (let [n (count coll)
        m (count items)
        pos (inject-pos n m)]
    (for [p pos] (inject* coll items p))))



(defn rcombinations [coll n]
  (cond
    (zero? n)
      [[]]
    (= 1 (count coll))
      [(repeat n (first coll))]
    true
      (concat (map #(cons (first coll) %)
                   (rcombinations coll (dec n)))
              (rcombinations (rest coll) n))))
         

(def candidates-op*
  (memoize
   (fn [n]
     (rcombinations '[+ - * /] (dec (count seeds))))))

(defn candidates [seeds]
  (apply concat 
         (for [nums (permutations seeds),
               opes (candidates-op* 6),
               ops  (permutations opes)]
           (inject nums ops))))


(defn eval-rev-poland [code]
  (loop [[c & cs] code, stack nil]
    (cond
      (nil? c)
        (first stack)
      (number? c)
        (recur cs (cons c stack))
      true
        (if-let [b (first stack)]
          (if-let [a (second stack)]
            (if (not (and (= c '/) (= b 0)))
            (let [e (case c
                          '+ (+ a b)
                          '- (- a b)
                          '* (* a b)
                          '/ (/ a b))]
              (recur cs (cons e (drop 2 stack))))))))))

(def answer (filter #(= (eval-rev-poland %) result) (candidates seeds)))