Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #59520

Re: Rosetta Code: Dinesman's multiple-dwelling problem

Show all headers | View raw

On 5/18/2017, Robert L. wrote:

> > The problem
> > 
> >   Baker, Cooper, Fletcher, Miller, and Smith live on different
> >   floors of an apartment house that contains only five floors.
> > 
> >   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. 
> > 
> > Where does everyone live?
> 
> (use srfi-1)
> 
> (define (any. lst fun) (any fun lst))
> 
> (let* ((floors '(0 1 2 3 4))
>        (b (delete 4 floors))
>        (c (delete 0 floors))
>        (f (lset-difference = floors '(0 4)))
>        (m floors)
>        (s floors)
>        (answer
>          (any. b (lambda(B)
>            (any. m (lambda(M)
>              (any. c (lambda(C)
>                (any. f (lambda(F)
>                  (any. s (lambda(S)
>                    (and
>                      (> M C)
>                      (< 1 (abs (- S F)))
>                      (< 1 (abs (- C F)))
>                      (let ((result (list B C F M S)))
>                        (and
>                          (equal? (delete-duplicates result) result)
>                          result)))))))))))))))
>   (for-each
>     print
>     '(Baker Cooper Fletcher Miller Smith) (circular-list ": ") answer))
> 
> Baker: 2
> Cooper: 1
> Fletcher: 3
> Miller: 4
> Smith: 0
> 
> In Forth?

(use gauche.sequence :only (sequence-contains))
(use util.combinations :only (permutations))
(use srfi-1 :only (first))

(remove
  (lambda(xs)
    (or
      (eq? 'Baker (last xs))
      (eq? 'Cooper (first xs))
      (eq? 'Fletcher (last xs))
      (eq? 'Fletcher (first xs))
      (sequence-contains xs '(Smith Fletcher))
      (sequence-contains xs '(Fletcher Smith))
      (sequence-contains xs '(Cooper Fletcher))
      (sequence-contains xs '(Fletcher Cooper))
      (member 'Cooper (member 'Miller xs))))
  (permutations '(Baker Cooper Fletcher Miller Smith)))

 ===>
((Smith Cooper Baker Fletcher Miller))


-- 
He has nothing but kind sentiments for those who would destroy his home and
family....  He is universally tolerant....  If he has any principles, he keeps
them well concealed....  He is, to the extent of his abilities, exactly like
the next citizen, who, he trusts, is trying to be exactly like him: a faceless,
characterless putty-man. --- Father Feeney; "Should Hate Be Outlawed?"

Back to comp.lang.forth | Previous | Next — Previous in thread | Find similar | Unroll thread

Thread

Rosetta Code: Dinesman's multiple-dwelling problem "Robert L." <No_spamming@noWhere_7073.org> - 2017-05-18 19:24 +0000
  Re: Rosetta Code: Dinesman's multiple-dwelling problem "Robert L." <No_spamming@noWhere_7073.org> - 2017-05-18 21:57 +0000

csiph-web