Upon reading the Prolog chapter in Seven Languages in Seven Weeks, I wanted to attempt the Sudoku example in Logos.
I quickly found out that Logos had quite a few less helpers than Prolog. In Prolog, you just say fd_all_different on all the rows and columns, not so in Logos. Then I read fd_all_different is implemented as ≢'ing all elements. But then again, Logos does not yet support negation.
So rather than saying “a number can not be on the same row twice” I had to say “this row must contain all numbers from 1 to 9 once”. This is done in permutation-o.
(ns logos.sudoku
(:refer-clojure :exclude [reify == inc])
(:use [logos
minikanren
logic
nonrel]))
(def board [(lvar) 7 (lvar) (lvar) (lvar) 8 (lvar) (lvar) 5
(lvar) (lvar) 8 3 (lvar) 1 (lvar) (lvar) (lvar)
1 6 3 (lvar) (lvar) 4 8 9 7
9 8 (lvar) (lvar) (lvar) (lvar) 4 (lvar) (lvar)
2 (lvar) (lvar) 1 (lvar) 5 (lvar) (lvar) 9
(lvar) (lvar) 4 (lvar) (lvar) (lvar) (lvar) 3 1
3 4 6 9 (lvar) (lvar) 1 7 8
(lvar) (lvar) (lvar) 4 (lvar) 7 9 (lvar) (lvar)
7 (lvar) (lvar) 8 (lvar) (lvar) (lvar) 6 (lvar)])
(def bad-board [9 4 2 5 3 7 6 1 8
(lvar) 7 (lvar) (lvar) 8 6 9 4 3
(lvar) 3 8 (lvar) (lvar) 1 2 7 5
3 (lvar) 7 6 1 (lvar) 4 (lvar) (lvar)
4 (lvar) (lvar) (lvar) 5 (lvar) 7 3 6
(lvar) 2 6 3 (lvar) 4 1 (lvar) 9
8 6 (lvar) (lvar) (lvar) 5 8 2 (lvar)
(lvar) (lvar) 9 4 2 8 3 (lvar) 7
2 8 (lvar) 7 (lvar) 3 5 9 1])
(def full-board [5 3 4 6 7 8 9 1 2
6 7 2 1 9 5 3 4 8
1 9 8 3 4 2 5 6 7
8 5 9 7 6 1 4 2 3
4 2 6 8 5 3 7 9 1
7 1 3 9 2 4 8 5 6
9 6 1 5 3 7 2 8 4
2 8 7 4 1 9 6 3 5
3 4 5 2 8 6 1 7 9])
(def almost-board [5 3 (lvar) 6 7 8 9 1 (lvar)
6 7 (lvar) 1 9 5 3 4 (lvar)
1 9 (lvar) 3 4 2 5 6 (lvar)
8 5 (lvar) 7 6 1 4 2 (lvar)
4 2 (lvar) 8 5 3 7 9 (lvar)
7 1 (lvar) 9 2 4 8 5 (lvar)
9 6 (lvar) 5 3 7 2 8 (lvar)
2 8 (lvar) 4 1 9 6 3 (lvar)
3 4 (lvar) 2 8 6 1 7 (lvar)])
(def empty-board (repeatedly 81 lvar))
(defn disj-o [x l out]
(cond-e ;a
((cons-o x out l))
((exist [f r i]
(cons-o f r l)
(cons-o f i out)
(disj-o x r i)))))
(defn permutation-o [s l]
(cond-e
((== s []) (== l []))
((exist [a b x y z]
(cons-o a b s)
(cons-o x y l)
(disj-o x s z)
(permutation-o z y)))))
(defn blocks [board]
(mapcat (fn [n]
(map #(apply concat %)
(partition 3
(partition 3 9
(drop n board)))))
[0 3 6]))
(defn slice [board]
(let [rows (partition 9 board)
cols (apply map list rows)
blocks (blocks board)]
[rows cols blocks]))
(defmacro sudoku [b]
(let [board (repeatedly 81 gensym)
[rows cols blocks] (slice board)
permfn (fn [row]
`(permutation-o (list ~@row) (range 1 10)))]
(concat
`(exist [~@board]
(== ~b (list ~@board)))
(interleave
(map permfn rows)
(map permfn cols)
(map permfn blocks)))))
The beauty of Logos and logic programming in general is that it allows you to tell the computer the data and the rules, instead of telling it what to do. You’d imagine this to be shorter as well. Furthermore, miniKanren is quite efficient, and Logos equally so.
So, how does this code compare to a regular Clojure version? To tell you the truth, not good. The plain Clojure version is both shorter and faster. By how much?
(ns sudoku
(:use clojure.pprint)
(:require [clojure [set :as s]]))
(def _ nil)
(def board [_ 7 _ _ _ 8 _ _ 5
_ _ 8 3 _ 1 _ _ _
1 6 3 _ _ 4 8 9 7
9 8 _ _ _ _ 4 _ _
2 _ _ 1 _ 5 _ _ 9
_ _ 4 _ _ _ _ 3 1
3 4 6 9 _ _ 1 7 8
_ _ _ 4 _ 7 9 _ _
7 _ _ 8 _ _ _ 6 _])
(def hard [_ 6 _ _ 5 _ 3 2 _ ; 3 added
_ _ _ 3 _ _ _ 9 _
7 _ _ 6 _ _ _ 1 _
_ _ 6 _ 3 _ 4 _ _
_ _ 4 _ 7 _ 1 _ _
_ _ 5 _ 9 _ 8 _ _
_ 4 _ _ _ 1 _ _ 6
_ 3 _ _ _ 8 _ _ _
_ 2 9 _ 4 _ _ 5 _]) ; can be either 7 or 9
(def from-blocks [0 9 18 1 10 19 2 11 20 3 12 21 4 13 22 5 14 23 6 15 24 7 16 25 8 17 26 27 36 45 28 37 46 29 38 47 30 39 48 31 40 49 32 41 50 33 42 51 34 43 52 35 44 53 54 63 72 55 64 73 56 65 74 57 66 75 58 67 76 59 68 77 60 69 78 61 70 79 62 71 80])
(def to-blocks [0 1 2 27 28 29 54 55 56 3 4 5 30 31 32 57 58 59 6 7 8 33 34 35 60 61 62 9 10 11 36 37 38 63 64 65 12 13 14 39 40 41 66 67 68 15 16 17 42 43 44 69 70 71 18 19 20 45 46 47 72 73 74 21 22 23 48 49 50 75 76 77 24 25 26 51 52 53 78 79 80])
(defn reduceable-board [board]
(for [cell board]
(if (number? cell)
cell
(set (range 1 10)))))
(defn prune [group]
(let [nrs (set (filter number? group))]
(for [cell group]
(cond
(number? cell) cell
(= (count cell) 1) (first cell)
:else (s/difference cell nrs)))))
(defn transpose [old mapping]
(apply assoc (vec old) (interleave mapping old)))
(defn slice [board]
(let [rows (map prune (partition 9 board))
cols (map prune (apply map list rows))
blocks (map prune (partition 9 (transpose (flatten cols) to-blocks)))]
(transpose (flatten blocks) from-blocks)))
(defn sudoku [board]
(loop [board (reduceable-board board)]
(let [next-board (slice board)]
(pprint (partition 9 next-board))
(if (or (= board next-board)
(every? number? next-board)
(some #(= #{} %) next-board))
next-board
(recur next-board)))))
The Clojure code is just a tad shorter, but not significantly so. With pattern matching and negation in place(more on that later), I think the difference becomes negligible.
In speed, however, the difference is huge. The Clojure version can solve a Sudoku in a matter of seconds, I had to leave the Logos version running overnight. Truth be told, for smaller fields or very, very easy boards, Logos can do it in half a second as well. This is why most examples implement mini-sudoku.
There is light at the end of the tunnel though! A recent update to Logos adds pattern matching, which allows for a more Prolog-ish way to express relations.
(defn-e append-o [x y z]
([() _ y])
([[?a . ?d] _ [?a . ?r]] (append-o ?d y ?r)))
(defn append-o [l s out]
(cond-e
((null-o l) (== s out))
((exist [a d res]
(cons-o a d l)
(cons-o a res out)
(append-o d s res)))))
Negation is also planned, which would make it a lot faster to express the relation the numbers in a Sudoku row have.
Last but not least, cond-a and cond-u will return, allowing me to cut away useless branches. Cond-a quits after the first match, rather than searching for alternate solutions.
