Path: ...!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Seven sins
Date: Wed, 7 Aug 2024 04:59:21 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 108
Message-ID: <v8uuv3$27a3i$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Wed, 07 Aug 2024 06:59:21 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="3618421e7cf17a9fd6ff329509e3098e";
	logging-data="2336882"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+VpOnE/N7q3zlMrFFs/a8s"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:yP3oFA1yHyO8hgMD8XHOj+hSu7I=
Bytes: 4685

> 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)