Tantalizer 482: Lapses from grace

[Robert L.]

Seven sins

> 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 between 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?


(define sins '(intemperance envy sloth lust pride avarice anger))
(define names '(Constance Emily Flavia Beatrice Deborah Gertrude Alice))

(use srfi-1)
(use combinatorics)

(define (solve)
(define (has duet sin) (member sin duet))
(define (common a b) (lset-intersection eq? a b))
(define sin-duets (unordered-subset-fold cons '() sins 2))
(define (check-combination com)
(every
(lambda(sin)
(= 2 (count (lambda(duet) (member sin duet)) com)))
sins))
(define possible-combinations
(unordered-subset-fold
(lambda(c accum)
(if (check-combination c)
(cons c accum)
accum))
'() sin-duets 7))
(define (consider perm)
(receive (Constance Emily Flavia Beatrice Deborah Gertrude Alice)
(apply values perm)
(when (and
(has Constance 'anger)
(not (has Deborah 'anger))
(not (has Alice 'pride))
(not (has Beatrice 'avarice))
(not (null? (common Constance Deborah)))
(null? (common Flavia '(pride intemperance)))
(has Deborah 'lust)
(has Emily 'lust)
(has Gertrude 'sloth)
(has Alice 'sloth)
(= 6 (length (delete-duplicates
(concatenate (list Constance Emily Flavia))
eq?)))
(= 7 (length (delete-duplicates
`(,@Beatrice ,@Deborah ,@Emily ,@Gertrude)
eq?))))
(pp (map cons names perm)))))
(define (consider-permutations combination)
(ordered-subset-for-each consider combination))
(for-each consider-permutations possible-combinations))

(solve)
===>
((Constance anger pride)
(Emily lust intemperance)
(Flavia avarice envy)
(Beatrice anger envy)
(Deborah pride lust)
(Gertrude avarice sloth)
(Alice sloth intemperance))


In Forth?

--
The conscious and intelligent manipulation of the organized habits and opinions
of the masses is an important element in democratic society. Those who
manipulate this unseen mechanism of society constitute an invisible government
which is the true ruling power of our country. --- (((Edward Bernays)))