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" ())'. $