From Newsgroup: comp.lang.scheme

Pierre R. Mai wrote:

Kent M. Pitman <pitman@world.std.com> writes:

edi@agharta.de (Dr. Edmund Weitz) writes:

PS: For the sake of completeness, here's my take on LDIFF

(defun subdivide (list &key (incr 1))
(loop for sublist on list by #'(lambda (list)
(nthcdr incr list))
collect (ldiff sublist (nthcdr incr sublist))))

As far as I can see this version is also in the O(2n) ballpark which I think you anticipated.

I was thinking something more like the following. Doing two identical nthcdrs should make you suspicious...

(defun subdivide (list &optional (increment 1))
(loop with sublist = list
while sublist
for next = (nthcdr increment sublist)
collect (ldiff sublist next)
do (setq sublist next)))

Actually I think you are not allowed to do it this way: LOOP requires
that variable binding clauses appear before main-clauses like while.
The MIT loop code does allow it, and deals with it correctly, and most independent implementations seem to also allow it, though some warn
about this. But sadly the standard doesn't require this (I think
there were reservations about the exact semantics of mixing and
matching such clauses). I say sadly, because this forces portable
code to sometimes be much more convoluted than would otherwise have
been necessary. Interleaving stepping and checking clauses is a very
common idiom, which could have been supported by LOOP.

Gauche Scheme

"!" is similar to "do".

If the length of the list is not divisible by "stride",
there will be an error.

(define (subdivide List stride)
(! (r cons (take xs stride)
xs List (drop xs stride))
(null? xs) @))

(subdivide '(a b c d e f) 2)
===>
((a b) (c d) (e f))

Given:

(define-syntax !-aux
(syntax-rules (<> @ @@ + - cons append cdr :in :across :along
:if :if-else ! :also? :also :to
:let := )
[(_ specs seen lets @)
(!-aux specs seen lets #f @) ]
[(_ (:let id val z ...) seen (lets ...) stuff ...)
(!-aux (z ...) seen (lets ... (id val)) stuff ...) ]
[(_ (:= id val z ...) stuff ...)
(!-aux (:let id #f dummy #f (set! id val) z ...) stuff ...) ]
;;
[(_ (:also? bool op x z ...) (seen ... (v i update)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool (op x update) update)))
stuff ...) ]
[(_ (:also op x z ...) stuff ...)
(!-aux (:also? #t op x z ...) stuff ...) ]
;;
[(_ (:if bool z ...) (seen ... (v i u)) stuff ...)
(!-aux (z ...)
(seen ... (v i (if bool u v))) stuff ...) ]
;;
[(_ (:if-else bool z ...) (seen ... (a b c)(d e f)) stuff ...)
(!-aux (:let yes #f z ...)
(seen ... (a b (begin (set! yes bool) (if yes c a)))
(d e (if (not yes) f d))) stuff ...) ]
[(_ (x :in lst z ...) seen lets bool stuff ...)
(!-aux (:let xs lst x (if (pair? xs)(pop! xs) !-aux) <> z ...)
seen lets (or (eq? x !-aux) bool) stuff ...) ]
[(_ (x :across vec z ...) seen lets bool stuff ...)
(!-aux (:let v vec :let i 0
x (if (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))
!-aux) <>
z ...)
seen lets (or (eq? x !-aux) bool) stuff ...) ]
[(_ (ch :along str z ...) seen lets bool stuff ...)
(!-aux (:let s str :let i 0
ch (and (< i (string-length s))
(begin0 (string-ref s i) (inc! i))) <>
z ...)
seen lets (or (not ch) bool) stuff ...) ]
[(_ (a b <> z ...) stuff ...)
(!-aux (a b b z ...) stuff ...) ]
;;
[(_ (a b + z ...) stuff ...)
(!-aux (a b (+ 1 a) z ...) stuff ...) ]
[(_ (a + n z ...) stuff ...)
(!-aux (a 0 (+ n a) z ...) stuff ...) ]
[(_ (a b - z ...) stuff ...)
(!-aux (a b (- a 1) z ...) stuff ...) ]
[(_ (n lo inc :to hi z ...) seen lets bool stuff ...)
(!-aux (:let i inc :let high hi
n lo (+ n i)
z ...) seen lets
(or (> n high) bool) stuff ...) ]
[(_ (n lo :to hi z ...) stuff ...)
(!-aux (n lo 1 :to hi z ...) stuff ...) ]
;;
[(_ (a cons b z ...) stuff ...)
(!-aux (a '() (cons b a) z ...) stuff ...) ]
[(_ (a append b z ...) stuff ...)
(!-aux (a '() (append b a) z ...) stuff ...) ]
[(_ (a b cdr z ...) stuff ...)
(!-aux (a b (cdr a) z ...) stuff ...) ]
[(_ (a b c z ...) (seen ...) stuff ...)
(!-aux (z ...) (seen ... (a b c)) stuff ...) ]
[(_ (a b) (seen ...) stuff ...)
(!-aux () (seen ... (a b)) stuff ...) ]
[(_ (a) (seen ...) stuff ...)
(!-aux () (seen ... (a '())) stuff ...) ]
;;
[(_ () seen lets bool ! action ...)
(!-aux () seen lets bool #t (action ...)) ]
;;
[(_ () ((a b c) z ...) lets bool)
(!-aux () ((a b c) z ...) lets bool a) ]
[(_ () ((a b c) z ...) lets bool @)
(!-aux () ((a b c) z ...) lets bool (reverse a)) ]
[(_ () seen lets bool @ result stuff ...)
(!-aux () seen lets bool (reverse result) stuff ...) ]
;;
[(_ () seen lets bool @@ (what x ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) ...) stuff ...) ]
[(_ () seen lets bool (what @ x z ...) stuff ...)
(!-aux () seen lets bool (what (reverse x) z ...) stuff ...) ]
[(_ () seen lets bool (what x @ y z ...) stuff ...)
(!-aux () seen lets bool (what x (reverse y) z ...) stuff ...) ]
;;
[(_ () ((a b c) z ...) lets 0 stuff ...)
(!-aux () ((a b c) z ...) lets (= 0 a) stuff ...) ]
[(_ () seen lets bool result stuff ...)
(let lets (do seen (bool result) stuff ...)) ]
))
(define-syntax !
(syntax-rules ()
[(_ specs bool stuff ...)
(!-aux specs () () bool stuff ...) ]
[(_ specs) (! specs #f) ]
))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2