> From New Scientist #1033, 6th January 1977
>
> An air of rare humility pervades the Common Room at St.
> Aletheia's tonight. The seven inmates overdid the
> post-prandial gin and rashly confessed their sins to one
> another. Each owned to a different pair of the deadly ones and
> each sin turned out to have claimed a different pair of
> victims.
>
> Constance, Emily, and Flavia have no sin in common to any two
> of them. Beatrice, Deborah, Emily, and Gertrude confessed to
> all seven among them. Alice and Gertrude admitted to sloth;
> Deborah and Emily to lust. Alice is not given to pride nor
> Beatrice to avarice nor Flavia to either pride or
> intemperance. Constance, who owned to anger, has a sin in
> common with Deborah, who did not.
>
> Which pair has fallen prey to intemperance and which pair to envy?

newLISP

(define (cartesian-multiply cartesian.lists cartesian.func
(cartesian.built '()))
(if (null? cartesian.lists)
(cartesian.func (reverse cartesian.built))
(dolist (x (first cartesian.lists))
(cartesian-multiply (rest cartesian.lists) cartesian.func
(cons x cartesian.built)))))

;; Iterate over all combinations from a list, and
;; call a function on each.
(define (combine-n combine.size combine.seq combine.func (combine.built '()))
(if (or (zero? combine.size) (null? combine.seq))
(combine.func combine.built)
(for (i 0 (- (length combine.seq) combine.size))
(combine-n
(- combine.size 1)
(slice combine.seq (+ 1 i))
combine.func
(cons (nth i combine.seq) combine.built)))))

(define (combinations size seq)
(let (result '())
(combine-n size seq (fn(x) (push x result)))
result))

;; Reverse association table lookup.
;; Returns a list of all keys.
(define (rev-lookup* val tbl)
(map
(fn (indices) (nth (list (first indices) 0) tbl))
(ref-all val tbl)))

(setf sins '(intemperance envy sloth lust pride avarice anger))
(setf sin-combos (combinations 2 sins))
(define names '(Constance Emily Flavia Beatrice Deborah Gertrude Alice))
(define table (map (fn (nun) (list nun sin-combos)) names))

(define (update-table nun the-sin must-have)
(let (sin-list (lookup nun table))
(setf (lookup nun table)
((if must-have filter clean)
(fn (pair) (member the-sin pair))
sin-list))))

(update-table 'Alice 'sloth true)
(update-table 'Gertrude 'sloth true)
(update-table 'Deborah 'lust true)
(update-table 'Emily 'lust true)
(update-table 'Alice 'pride nil)
(update-table 'Beatrice 'avarice nil)
(update-table 'Flavia 'pride nil)
(update-table 'Flavia 'intemperance nil)
(update-table 'Constance 'anger true)
(update-table 'Deborah 'anger nil)

(define (check sin-pairs)
(local (Constance Emily Flavia Beatrice Deborah Gertrude Alice)
(let (tbl (unify '(Constance Emily Flavia Beatrice Deborah Gertrude Alice)
sin-pairs))
(bind tbl)
(and
(= 7 (length (unique sin-pairs)))
(= 7 (length (union Beatrice Deborah Emily Gertrude)))
(intersect Constance Deborah)
(not (intersect Constance Emily))
(not (intersect Constance Flavia))
(not (intersect Emily Flavia))
(let (nuns-per-sin
(map
(fn (s)
(filter (fn (nun) (member s (lookup nun tbl)))
names))
sins))
(and
(= 7 (length (unique nuns-per-sin)))
(for-all (fn(xs) (= 2 (length xs))) nuns-per-sin)))
(println sin-pairs)
(dolist (s '(intemperance envy))
(println s ": " (rev-lookup* s tbl)))))))

(cartesian-multiply (map (fn (nun) (lookup nun table)) names) check)

intemperance: (Emily Alice)
envy: (Flavia Beatrice)