Rosetta birthday problem

[B. Pym]

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

[Kaz Kylheku]

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

[B. Pym]

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