The Countdown number round with clojure.core.logic

countdown1.clj

(ns countdown1
  (:use
   [clojure.core.logic])
  (:require
   [clojure.string :as str]))

;; Attempt to solve the "Numbers Game" from the UK Channel 4 gameshow
;; countdown.

;; Basically, 6 random numbers are chosen; then a random target is
;; chosen.  Contestents have to reach the target (or as close as
;; possible) within 30 seconds, by using the numbers and basic
;; arithmetic operators.  Each number can only be used once.

;; See: http://www.dilan4.com/maths/countdown.htm for more details


;; setting up the game

(def small-cards [1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10])

(def big-cards [25 50 75 100])

(defn pick-cards  
  [big]
  {:pre [(>= big 0)
	 (<= big (count big-cards))]}
  (let [allowed 6
	small (- allowed big)]
    (reverse
     (sort
      (concat
       (take big (shuffle big-cards))
       (take small (shuffle small-cards)))))))

(defn pick-target
  []
  (+ 100 (rand-int 900)))

;; logic stuff

(defmacro are-nums
  [& vars]
  `(infd ~@vars ~(interval 0 1000)))

(defn op
  [x op y r]
  ;; TODO why are calls to are-nums required below?  And why are they
  ;; required in those places?
  (conde
   [(== op '+)
    (are-nums r)
    (<=fd x y) ; optimisation
    (+fd x y r)]
    [(== op '-)
     (are-nums  r)
     (<fd y x) ; optimisation
     (+fd y r x)]
    [(== op '*)
     (are-nums r)
     (<=fd x y) ; optimisation
     (!=fd x 1) ; optimisation
     (!=fd y 1) ; optimisation
     (*fd x y r)]
    [(== op '/)
     (are-nums r)
     (!=fd y 1) ; optimisation
     (*fd y r x)]
    )) 

(defn take2
  "Pick two members (x and y), and the remaining members (others),
  from inxs"
  [inxs x y others]
  (fresh [i1]
	 (rembero x inxs i1)
	 (rembero y i1 others)))

(defn solve-numbers
  [inxs inoplist foutoplist foutxs target]
  (fresh [x o y others r
	  outoplist outxs]
	 (take2 inxs x y others) ; take two inputs to operate on
	 (op x o y r) ; calculate the answer
	 (conso [x o y '= r] inoplist outoplist) ; record the operation
	 (conso r others outxs) ; discard the inputs, and remember the new output
	 (conde
	  [(=fd r target) ; if we've reached the target
	   (== outxs foutxs) ; then record the results
	   (== outoplist foutoplist)]
	  [(solve-numbers outxs outoplist foutoplist foutxs target)] ; else recur
	  )))

(defn go
  [target cards]
  (println "Cards: " (str/join " " cards))
  (println "Target: " target)
  (time
   (let [solutions (run 1 [oplist]
			(infd target (interval 100 999))
			(everyg #(infd % (interval 1 100)) cards)
			(fresh [outxs]
			       (solve-numbers cards [] oplist outxs target)))]
     (doseq [solution solutions]
       (newline)
       (doseq [step (reverse solution)]
	 (println (str/join " " step)))))))

(defn prob1
  []
  (go 265 [100 2 6 10 9 6]))

(defn prob-random
  []
  (go (pick-target) (pick-cards 1)))