codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; hett's problem 1.28 (define sort #f) (define merge #f) (let () (define dosort (lambda (pred? ls n) (if (= n 1) (list (car ls)) (let ((i (quotient n 2))) (domerge pred? (dosort pred? ls i) (dosort pred? (list-tail ls i) (- n i))))))) (define domerge (lambda (pred? l1 l2) (cond ((null? l1) l2) ((null? l2) l1) ((pred? (car l2) (car l1)) (cons (car l2) (domerge pred? l1 (cdr l2)))) (else (cons (car l1) (domerge pred? (cdr l1) l2)))))) (set! sort (lambda (pred? l) (if (null? l) l (dosort pred? l (length l))))) (set! merge (lambda (pred? l1 l2) (domerge pred? l1 l2)))) (define (mappend f . xss) (apply append (apply map f xss))) (define (identity x) x) (define (group-by eql? xs) (let loop ((xs xs) (ys '()) (zs '())) (cond ((null? xs) (reverse (if (null? ys) zs (cons (reverse ys) zs)))) ((null? (cdr xs)) (reverse (cons (reverse (cons (car xs) ys)) zs))) ((eql? (car xs) (cadr xs)) (loop (cdr xs) (cons (car xs) ys) zs)) (else (loop (cddr xs) (list (cadr xs)) (cons (reverse (cons (car xs) ys)) zs)))))) (define (lsort xss) (define (lt? a b) (< (length a) (length b))) (sort lt? xss)) (define (lfsort xss) (map cdr (mappend identity (lsort (group-by (lambda (a b) (= (car a) (car b))) (sort (lambda (a b) (< (car a) (car b))) (map (lambda (x) (cons (length x) x)) xss))))))) (define xss '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o))) (display (lsort xss)) (newline) (display (lfsort xss)) (newline)
Private
[
?
]
Run code
Submit