A bunch of grapes

gistfile1.clj

;; http://www2.oninet.ne.jp/mazra/math104.htm
 
(ns grape
  (:refer-clojure :exclude [record? ==])
  (:require [clojure.core.logic.fd :as fd])
  (:use [clojure.core.logic]))

(clojure.pprint/pprint
  (run* [q]
    (fresh [a0 a1 a2 a3 a4 b0 b1 b2 b3 c0 c1 c2 d0 d1 e0 xs]
 
      (conde [(fd/< a0 a1) (fd/- a1 a0 b0)] [(fd/- a0 a1 b0)])
      (conde [(fd/< a1 a2) (fd/- a2 a1 b1)] [(fd/- a1 a2 b1)])
      (conde [(fd/< a2 a3) (fd/- a3 a2 b2)] [(fd/- a2 a3 b2)])
      (conde [(fd/< a3 a4) (fd/- a4 a3 b3)] [(fd/- a3 a4 b3)])

      (conde [(fd/< b0 b1) (fd/- b1 b0 c0)] [(fd/- b0 b1 c0)])
      (conde [(fd/< b1 b2) (fd/- b2 b1 c1)] [(fd/- b1 b2 c1)])
      (conde [(fd/< b2 b3) (fd/- b3 b2 c2)] [(fd/- b2 b3 c2)])

      (conde [(fd/< c0 c1) (fd/- c1 c0 d0)] [(fd/- c0 c1 d0)])
      (conde [(fd/< c1 c2) (fd/- c2 c1 d1)] [(fd/- c1 c2 d1)])

      (conde [(fd/< d0 d1) (fd/- d1 d0 e0)] [(fd/- d0 d1 e0)])

      (== xs [a0 a1 a2 a3 a4 b0 b1 b2 b3 c0 c1 c2 d0 d1 e0])
      (everyg #(fd/in % (apply fd/domain (range 1 16))) xs)
      (everyg fd/distinct [xs])
      (== q [[a0 a1 a2 a3 a4] [b0 b1 b2 b3] [c0 c1 c2] [d0 d1] [e0]]))))

;; ([[6 14 15 3 13] [8 1 12 10] [7 11 2] [4 9] [5]]
;;  [[13 3 15 14 6] [10 12 1 8] [2 11 7] [9 4] [5]])