chunky list reversals


Define list reverse functions that group a list into sublists of various sizes and reverses the sublist contents but not the order of the sublists in the list.

 (use-modules (ice-9 format)) 
 (include-from-path "srfi-78/srfi-78.scm") 
  
 (define (pair-reverse l) 
  
   (define (rezip fstl sndl l) 
     (if (null? fstl) 
       l 
       (rezip (cdr fstl) (cdr sndl) (cons (car sndl) (cons (car fstl) l))))) 
  
   (define (unzip-equal l fstl sndl) 
     ; (assert (= (length (cons e fstl)) (length sndl))) 
     (if (null? l) 
       (rezip fstl sndl '()) 
       (unzip-unequal (cdr l) (car l) fstl sndl))) 
  
   (define (unzip-unequal l e fstl sndl) 
     ; (assert (= (length (cons e fstl)) (+ (length sndl) 1))) 
     (if (null? l) 
       (rezip fstl sndl (list e)) 
       (unzip-equal (cdr l) (cons e fstl) (cons (car l) sndl)))) 
  
   (unzip-equal l '() '())) 
  
  
 (check (pair-reverse '()) => '()) 
 (check (pair-reverse '(1)) => '(1)) 
 (check (pair-reverse '(1 2)) => '(2 1)) 
 (check (pair-reverse '(1 2 3)) => '(2 1 3)) 
 (check (pair-reverse '(1 2 3 4)) => '(2 1 4 3)) 
  
  
 (define (k-reverse k l) 
  
   (define (chunkify l i chunk chunks) 
     (cond  
      ((null? l) 
         (dechunkify chunk chunks))  
      ((= i 0) 
         (chunkify l k '() (cons chunk chunks))) 
      (#t 
         (chunkify (cdr l) (- i 1) (cons (car l) chunk) chunks)))) 
  
   (define (dechunkify l chunks) 
     (if (null? chunks) 
       l 
       (dechunkify (append (car chunks) l) (cdr chunks)))) 
  
   (if (< k 1) 
     '() 
     (chunkify l k '() '()))) 
  
  
 (check (k-reverse 1 '(1 2 3 4 5 6)) => '(1 2 3 4 5 6)) 
 (check (k-reverse 2 '(1 2 3 4 5 6)) => (pair-reverse '(1 2 3 4 5 6))) 
 (check (k-reverse 3 '(1 2 3 4 5 6)) => '(3 2 1 6 5 4)) 
 (check (k-reverse 4 '(1 2 3 4 5 6)) => '(4 3 2 1 6 5)) 
 (check (k-reverse 5 '(1 2 3 4 5 6)) => '(5 4 3 2 1 6)) 
 (check (k-reverse 6 '(1 2 3 4 5 6)) => '(6 5 4 3 2 1)) 
 (check (k-reverse 7 '(1 2 3 4 5 6)) => '(6 5 4 3 2 1)) 
  
  
 (define (halves-reverse l) 
   (k-reverse (ceiling (/ (length l) 2)) l)) 
  
 (check (halves-reverse '()) => '()) 
 (check (halves-reverse '(1)) => '(1)) 
 (check (halves-reverse '(1 2)) => '(1 2)) 
 (check (halves-reverse '(1 2 3)) => '(2 1 3)) 
 (check (halves-reverse '(1 2 3 4)) => '(2 1 4 3)) 
 (check (halves-reverse '(1 2 3 4 5)) => '(3 2 1 5 4)) 
 (check (halves-reverse '(1 2 3 4 5 6)) => '(3 2 1 6 5 4)) 
 (check (halves-reverse '(1 2 3 4 5 6 7)) => '(4 3 2 1 7 6 5)) 

Because the tools are already defined:

 (define (pair-reverse l) 
   (k-reverse 2 l)) 
  
  
 (check (pair-reverse '()) => '()) 
 (check (pair-reverse '(1)) => '(1)) 
 (check (pair-reverse '(1 2)) => '(2 1)) 
 (check (pair-reverse '(1 2 3)) => '(2 1 3)) 
 (check (pair-reverse '(1 2 3 4)) => '(2 1 4 3)) 

What's all this stuff about tail recursion, anyway?

 (define (linear-pair-reverse l) 
  
   (define (fst l) 
     (if (null? l) 
       l 
       (snd (cdr l) (car l)))) 
  
   (define (snd l e) 
     (if (null? l) 
       (list e) 
       (cons (car l) (cons e (fst (cdr l)))))) 
  
   (fst l)) 
  
  
 (define (time-it fun n label) 
   (let ((l (vector->list (make-vector n 1))) 
         (s (current-time))) 
     (fun l)     
     (format #t  
       "\n~a pair reverse on a ~d-element list: ~d sec.\n"  
       label n (- (current-time) s)))) 
  
 (define (time-them n) 
   (time-it pair-reverse n "tail-recursive") 
   (time-it linear-pair-reverse n "non-tail-recursive")) 
  
 (time-them 20000) 

In the end

$ guile lreverse.scm

(pair-reverse (quote ())) => () ; correct
(pair-reverse (quote (1))) => (1) ; correct
(pair-reverse (quote (1 2))) => (2 1) ; correct
(pair-reverse (quote (1 2 3))) => (2 1 3) ; correct
(pair-reverse (quote (1 2 3 4))) => (2 1 4 3) ; correct

(k-reverse 1 (quote (1 2 3 4 5 6))) => (1 2 3 4 5 6) ; correct
(k-reverse 2 (quote (1 2 3 4 5 6))) => (2 1 4 3 6 5) ; correct
(k-reverse 3 (quote (1 2 3 4 5 6))) => (3 2 1 6 5 4) ; correct
(k-reverse 4 (quote (1 2 3 4 5 6))) => (4 3 2 1 6 5) ; correct
(k-reverse 5 (quote (1 2 3 4 5 6))) => (5 4 3 2 1 6) ; correct
(k-reverse 6 (quote (1 2 3 4 5 6))) => (6 5 4 3 2 1) ; correct
(k-reverse 7 (quote (1 2 3 4 5 6))) => (6 5 4 3 2 1) ; correct

(halves-reverse (quote ())) => () ; correct
(halves-reverse (quote (1))) => (1) ; correct
(halves-reverse (quote (1 2))) => (1 2) ; correct
(halves-reverse (quote (1 2 3))) => (2 1 3) ; correct
(halves-reverse (quote (1 2 3 4))) => (2 1 4 3) ; correct
(halves-reverse (quote (1 2 3 4 5))) => (3 2 1 5 4) ; correct
(halves-reverse (quote (1 2 3 4 5 6))) => (3 2 1 6 5 4) ; correct
(halves-reverse (quote (1 2 3 4 5 6 7))) => (4 3 2 1 7 6 5) ; correct

(pair-reverse (quote ())) => () ; correct
(pair-reverse (quote (1))) => (1) ; correct
(pair-reverse (quote (1 2))) => (2 1) ; correct
(pair-reverse (quote (1 2 3))) => (2 1 3) ; correct
(pair-reverse (quote (1 2 3 4))) => (2 1 4 3) ; correct

tail-recursive pair reverse on a 20000-element list: 0 sec.

Backtrace:
In /mnt/projects/programming-problems/guile/lreverse.scm:
  96: 19 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 18 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 17 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 16 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 15 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 14 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 13 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 12 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 11 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 10 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 9 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 8 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 7 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 6 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 5 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 4 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 3 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 2 [fst (1 1 1 1 1 1 1 1 1 ...)]
  96: 1 [fst (1 1 1 1 1 1 1 1 1 ...)]
  88: 0 [fst (1 1 1 1 1 1 1 1 1 ...)]

/mnt/projects/programming-problems/guile/lreverse.scm:88:2: In procedure fst:
/mnt/projects/programming-problems/guile/lreverse.scm:88:2: Throw to key `vm-error' with args `(vm-run "VM: Stack overflow" ())'.

$