Path: ...!weretis.net!feeder8.news.weretis.net!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,comp.lang.scheme
Subject: Rosetta birthday problem
Date: Fri, 26 Jul 2024 21:26:41 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 69
Message-ID: <v814ag$30n60$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Fri, 26 Jul 2024 23:26:42 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="747fa0f9e4f56b6369e69e3bde11dd7d";
	logging-data="3169472"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+hUOEhEsmKKTfoDDX1pqNo"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:0Oa3HGm3ngtcJIOyL89b6OyKgCc=
Bytes: 2743

http://rosettacode.org/wiki/Cheryl%27s_birthday

> Cheryl's birthday
> 
> Albert and Bernard just became friends with Cheryl, and they
> want to know when her birthday is.
> 
> Cheryl gave them a list of ten possible dates:
> 
>      May 15,     May 16,     May 19
>      June 17,    June 18
>      July 14,    July 16
>      August 14,  August 15,  August 17
> 
> Cheryl then tells Albert the   month   of birth,   and Bernard
> the   day   (of the month)   of birth.
> 
> 1)  Albert:   I don't know when Cheryl's birthday is, but I
> know that Bernard does not know, too.
> 
> 2)  Bernard:  At first I didn't know when Cheryl's birthday is,
> but I know now.
> 
> 3)  Albert:   Then I also know when Cheryl's birthday is.


Gauche Scheme

(use gauche.generator)
(use gauche.collection)

(define (remove-from xs key pred  group?)
  (let* ((keys (map key xs))
         (bad
           (filter
             (lambda (k)
               (let ((cnt (count (lambda(x) (equal? x k)) keys)))
                 (pred cnt)))
             keys)))
    (append-map
      (lambda(g)
        (if (any (lambda(x) (member (key x) bad)) g) '() g))
      (if group?
        (group-collection xs :key car :test equal?)
        (map list xs)))))

(define (foo)
  (define dates
    (slices
      (with-input-from-string
        "May 15     May 16     May 19
        June 17    June 18
        July 14    July 16
        August 14  August 15  August 17"
        (cut  generator->list read))
      2))
  (set! dates (remove-from dates cadr (^c (= c 1)) #t))
  (print dates)
  (set! dates (remove-from dates cadr (^c (> c 1)) #f))
  (print dates)
  (set! dates (remove-from dates car (^c (> c 1)) #t))
  dates)

  ===>
((July 14) (July 16) (August 14) (August 15) (August 17))
((July 16) (August 15) (August 17))
((July 16))