Path: ...!news.nobody.at!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Kaz Kylheku <643-408-1753@kylheku.com>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: Rosetta birthday problem
Date: Sat, 27 Jul 2024 07:43:35 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 99
Message-ID: <20240726235406.930@kylheku.com>
References: <v814ag$30n60$1@dont-email.me>
Injection-Date: Sat, 27 Jul 2024 09:43:35 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="7dc4349931df46a56d4f543b60e1cc03";
	logging-data="3474308"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+vJsYyQie+stK0YrethpoynO7+a9stu7s="
User-Agent: slrn/pre1.0.4-9 (Linux)
Cancel-Lock: sha1:72AvoAcx8wP6QhVWZVb4hVr/+JE=
Bytes: 3782

On 2024-07-26, B. Pym <Nobody447095@here-nor-there.org> wrote:
> 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))

$ txr cheryls-birthday.tl
((July 14) (July 16) (August 14) (August 15) (August 17))
((July 16) (August 15) (August 17))
((July 16))

$ cat cheryls-birthday.tl
(defun munge (groupfn selfn keepfn filfn data)
  (flow data
    (group-by groupfn)
    (mappend (do if-match (@nil @pair) @1 (list [selfn pair])))
    (keepfn (opip filfn (member @1 @@1)) data)))

(flow "May 15,     May 16,     May 19\n   \
       June 17,    June 18\n              \
       July 14,    July 16\n              \
       August 14,  August 15,  August 17\n"
  (remq #\,)
  read-objects
  (tuples 2)
  (munge second first remove-if first)
  prinl
  (munge second second keep-if second)
  prinl
  (munge first second keep-if second)
  prinl)

-- 
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca