Created
August 16, 2012 23:33
-
-
Save djpowell/3374505 to your computer and use it in GitHub Desktop.
The Countdown number round with clojure.core.logic
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment