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))

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

B. Pym 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))

newLISP

(define (get-month xs) (first xs))
(define (get-day xs) (nth 1 xs))
(define single? (curry = 1))
(define multiple? (curry < 1))
(define (count1 x xs) (first (count (list x) xs)))

(define (remove-from xs key pred delete-whole-month?)
(letn (keys (map key xs)
bad-keys '()
bad-months '())
(dolist (birthday xs)
(when (pred (count1 (key birthday) keys))
(push (get-month birthday) bad-months)
(push (key birthday) bad-keys)))
(if delete-whole-month?
(clean
(fn (birthday) (member (get-month birthday) bad-months))
xs)
(clean
(fn (birthday) (member (key birthday) bad-keys))
xs))))

(define (foo)
(let (dates (explode (parse
"May 15 May 16 May 19
June 17 June 18
July 14 July 16
August 14 August 15 August 17")
2))
(setq dates (remove-from dates get-day single? true))
(println dates)
(setq dates (remove-from dates get-day multiple? nil))
(println dates)
(setq dates (remove-from dates get-month multiple? true))))

(foo)

(("July" "14") ("July" "16") ("August" "14") ("August" "15")
("August" "17"))
(("July" "16") ("August" "15") ("August" "17"))
(("July" "16"))