Discussion:
tasters wanted
(too old to reply)
Robert L.
2019-12-23 22:23:09 UTC
Permalink
Victor Kryukov
I would like to submit a recipe to the lisp cookbook (http://cl-
cookbook.sourceforge.net/). So before poisoning the unsuspected, I
thought that the expert tasters could inspect this for obvious
errors.
The routine parses a sorted list and returns a list of duplicates.
Thus, for the following list
(-1 0 0 1 1 2 3 3 3 4 5 8 9 9 10 11 11)
the routine returns
((0 0) (1 1) (3 3 3) (9 9) (11 11)
(defun collect-repeats-simple (sorted-list)
(loop
with repeats = nil
and acc = nil
for a in sorted-list
for b in (cdr sorted-list)
when (and (not repeats)
(equal a b))
do (progn
(setf acc (list a b))
(setf repeats t))
else
when repeats
when (equal a b)
do (push b acc)
else
collect acc into result and
do (progn
(setf acc nil)
(setf repeats nil))
finally (print (if acc (append result (list acc))
result))))
A more complete version would allow for the key and test keywords. My
(defun collect-repeats (sorted-list &key (key #'(lambda (arg) arg))
(test #'equal))
(Is there a more concise way to specify the default key?)
(lambda (arg) arg) is identity is Common Lisp.
However, I don't understand why everybody here seems to be so obsessed
with loop solutions full of non-functional setf's that have so many
lines that they don't fit on my screen while elegant recursive
solutions exist? Is it because Paul Graham's "ANSI Common Lisp" was my
first book that I don't like loops and do like recursion?
(defun collect-repeats-simple (sorted-list &optional (acc nil))
(cond
((null sorted-list)
(remove-if (lambda (l)
(null (cdr l))) (reverse acc)))
((equal (car sorted-list)
(caar acc))
(push (car sorted-list) (car acc))
(collect-repeats-simple (cdr sorted-list) acc))
(t (collect-repeats-simple (cdr sorted-list)
(cons (list (car sorted-list)) acc)))))
Gauche, Chicken, or Scheme

(use srfi-1) ; span for Gauche or Chicken
or
(require srfi/1) ; span for Racket
(require srfi/8) ; receive for Racket

(define (collect-repeats sorted-list)
(if (null? sorted-list)
'()
(receive (fore aft)
(span (lambda (x) (equal? x (car sorted-list))) sorted-list)
(append
(if (null? (cdr fore)) '() fore)
(collect-repeats aft)))))

(collect-repeats '(2 2 3 4 4 4 5 6 6 7))
===>
(2 2 4 4 4 6 6)

(collect-repeats '(2 2 3 4 4 4 5 6 6 7 8 8))
===>
(2 2 4 4 4 6 6 8 8)
Robert L.
2019-12-23 22:39:48 UTC
Permalink
Post by Robert L.
Victor Kryukov
I would like to submit a recipe to the lisp cookbook (http://cl-
cookbook.sourceforge.net/). So before poisoning the unsuspected, I
thought that the expert tasters could inspect this for obvious
errors.
The routine parses a sorted list and returns a list of duplicates.
Thus, for the following list
(-1 0 0 1 1 2 3 3 3 4 5 8 9 9 10 11 11)
the routine returns
((0 0) (1 1) (3 3 3) (9 9) (11 11)
(defun collect-repeats-simple (sorted-list)
(loop
with repeats = nil
and acc = nil
for a in sorted-list
for b in (cdr sorted-list)
when (and (not repeats)
(equal a b))
do (progn
(setf acc (list a b))
(setf repeats t))
else
when repeats
when (equal a b)
do (push b acc)
else
collect acc into result and
do (progn
(setf acc nil)
(setf repeats nil))
finally (print (if acc (append result (list acc))
result))))
A more complete version would allow for the key and test keywords. My
(defun collect-repeats (sorted-list &key (key #'(lambda (arg) arg))
(test #'equal))
(Is there a more concise way to specify the default key?)
(lambda (arg) arg) is identity is Common Lisp.
However, I don't understand why everybody here seems to be so obsessed
with loop solutions full of non-functional setf's that have so many
lines that they don't fit on my screen while elegant recursive
solutions exist? Is it because Paul Graham's "ANSI Common Lisp" was my
first book that I don't like loops and do like recursion?
(defun collect-repeats-simple (sorted-list &optional (acc nil))
(cond
((null sorted-list)
(remove-if (lambda (l)
(null (cdr l))) (reverse acc)))
((equal (car sorted-list)
(caar acc))
(push (car sorted-list) (car acc))
(collect-repeats-simple (cdr sorted-list) acc))
(t (collect-repeats-simple (cdr sorted-list)
(cons (list (car sorted-list)) acc)))))
Gauche, Chicken, or Scheme
(use srfi-1) ; span for Gauche or Chicken
or
(require srfi/1) ; span for Racket
(require srfi/8) ; receive for Racket
(define (collect-repeats sorted-list)
(if (null? sorted-list)
'()
(receive (fore aft)
(span (lambda (x) (equal? x (car sorted-list))) sorted-list)
(append
(if (null? (cdr fore)) '() fore)
(collect-repeats aft)))))
(collect-repeats '(2 2 3 4 4 4 5 6 6 7))
===>
(2 2 4 4 4 6 6)
(collect-repeats '(2 2 3 4 4 4 5 6 6 7 8 8))
===>
(2 2 4 4 4 6 6 8 8)
If grouping is wanted:

(define (collect-repeats sorted-list)
(if (null? sorted-list)
'()
(receive (fore aft)
(span (lambda (x) (equal? x (car sorted-list))) sorted-list)
(append
(if (null? (cdr fore)) '() (list fore))
(collect-repeats aft)))))

(collect-repeats '(2 2 3 4 4 4 5 6 6 7))
===>
((2 2) (4 4 4) (6 6))

Loading...