From Newsgroup: comp.lang.lisp

Baker does not live on the top floor.
Cooper does not live on the bottom floor.
Fletcher does not live on either the top or the bottom floor.
Miller lives on a higher floor than does Cooper.
Smith does not live on a floor adjacent to Fletcher's.
Fletcher does not live on a floor adjacent to Cooper's.

Gauche Scheme

(use util.combinations) ;; permutations
(use srfi-1) ;; list-index

(define (index x xs) (list-index (cut equal? <> x) xs))
(define (apart a b xs) (< 1 (abs (- (index a xs) (index b xs)))))

(define men
`((baker . ,(iota 4))
(cooper . ,(iota 4 1))
(fletcher . ,(iota 3 1))
(miller . ,(lrange 2 5))
(smith . ,(iota 5))))

(dolist (perm (permutations (map car men)))
(when
(and
(every
(lambda(man) (member (index man perm) (assoc-ref men man)))
perm)
(> (index 'miller perm) (index 'cooper perm))
(apart 'smith 'fletcher perm)
(apart 'cooper 'fletcher perm))
(print perm)))

(smith cooper baker fletcher miller)
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

Baker does not live on the top floor.
Cooper does not live on the bottom floor.
Fletcher does not live on either the top or the bottom floor.
Miller lives on a higher floor than does Cooper.
Smith does not live on a floor adjacent to Fletcher's.
Fletcher does not live on a floor adjacent to Cooper's.

Gauche Scheme

(use util.combinations) ;; permutations
(use srfi-1) ;; list-index

(define (index x xs) (list-index (cut equal? <> x) xs))
(define (apart a b xs) (< 1 (abs (- (index a xs) (index b xs)))))

(define men
`((baker . ,(iota 4))
(cooper . ,(iota 4 1))
(fletcher . ,(iota 3 1))
(miller . ,(lrange 2 5))
(smith . ,(iota 5))))

(dolist (perm (permutations (map car men)))
(when
(and
(every
(lambda(man) (member (index man perm) (assoc-ref men man)))
perm)
(> (index 'miller perm) (index 'cooper perm))
(apart 'smith 'fletcher perm)
(apart 'cooper 'fletcher perm))
(print perm)))

(smith cooper baker fletcher miller)

Shorter:

(dolist (perm (permutations (map car men)))
(when
(and
(% every (member (index _ perm) (assoc-ref men _))
perm)
(> (index 'miller perm) (index 'cooper perm))
(apart 'smith 'fletcher perm)
(apart 'cooper 'fletcher perm))
(print perm)))

Given:

(define-macro %
(case-lambda
((func expr List)
`(,func (lambda(_) ,expr) ,List))
((func expr List . more)
(let ((vnames (map (lambda(n)(symbol-append '_ n))
(iota (+ 1 (length more))))))
`(,func (lambda ,vnames ,expr) ,List ,@more)))))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

Baker does not live on the top floor.
Cooper does not live on the bottom floor.
Fletcher does not live on either the top or the bottom floor.
Miller lives on a higher floor than does Cooper.
Smith does not live on a floor adjacent to Fletcher's.
Fletcher does not live on a floor adjacent to Cooper's.

Gauche Scheme

(use util.combinations) ;; permutations
(use srfi-1) ;; list-index

(define (index x xs) (list-index (cut equal? <> x) xs))
(define (apart a b xs) (< 1 (abs (- (index a xs) (index b xs)))))

(define men
`((baker . ,(iota 4))
(cooper . ,(iota 4 1))
(fletcher . ,(iota 3 1))
(miller . ,(lrange 2 5))
(smith . ,(iota 5))))

(dolist (perm (permutations (map car men)))
(when
(and
(every
(lambda(man) (member (index man perm) (assoc-ref men man)))
perm)
(> (index 'miller perm) (index 'cooper perm))
(apart 'smith 'fletcher perm)
(apart 'cooper 'fletcher perm))
(print perm)))

(smith cooper baker fletcher miller)

Gauche Scheme

Without using SRFI-1.

(use util.combinations) ;; permutations

(define (index x z) (- (length (memv x (reverse z))) 1))

(define (apart a b z)
(let ((x (memv a z))
(y (memv b z)))
(if (memv a y) (memv a (cddr y)) (memv b (cddr x)))))

(define men
`((baker . ,(iota 4))
(cooper . ,(iota 4 1))
(fletcher . ,(iota 3 1))
(miller . ,(lrange 2 5))
(smith . ,(iota 5))))

(dolist (perm (permutations (map car men)))
(when
(and
(% every (memv (index _ perm) (assoc-ref men _)) perm)
(memv 'miller (memv 'cooper perm))
(apart 'smith 'fletcher perm)
(apart 'cooper 'fletcher perm))
(print perm)))

(smith cooper baker fletcher miller)

Given:

;; Anaphoric macro to abbreviate lambdas for higher-order functions.
;; Uses "_" for 1 argument;
;; uses "A:" and "B:" and so on for 2 or more arguments.
;; This version works under both Gauche Scheme
;; and Racket. Racket needs:
;; (require compatibility/defmacro)
;;
(define-macro %
(case-lambda
((func expr List) `(,func (lambda(_) ,expr) ,List))
((func expr . more)
(let* ((n 64)
(nums (map (lambda _ (set! n (+ 1 n)) n) more))
(vnames
(map (lambda(n)
(string->symbol (string (integer->char n) #\:)))
nums)))
`(,func (lambda ,vnames ,expr) ,@more)))))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2