codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; patience sorting (define (deal deck) (let loop ((deck deck) (selip (list)) (piles (list))) (cond ((null? deck) piles) ; no more cards in deck ((null? piles) ; add card to new pile (loop (cdr deck) (list) (reverse (cons (list (car deck)) selip)))) ((< (car deck) (caar piles)) ; found correct pile (loop (cdr deck) (list) (append (reverse selip) (list (cons (car deck) (car piles))) (cdr piles)))) (else ; continue search for correct pile (loop deck (cons (car piles) selip) (cdr piles)))))) (define (sort deck) (let loop1 ((xs (list)) (piles (deal deck))) (if (null? piles) (reverse xs) (let ((x (apply min (map car piles)))) (let loop2 ((piles piles) (selip (list))) (if (= (caar piles) x) (loop1 (cons x xs) (append (reverse selip) (if (null? (cdar piles)) (list) (list (cdar piles))) (cdr piles))) (loop2 (cdr piles) (cons (car piles) selip)))))))) (display (sort '(4 2 9 1 3 6 7 8 5))) (newline) (define (insert xs xss) (if (null? xs) xss (let loop ((xss xss) (rev (list))) (if (null? xss) (reverse (cons xs rev)) (if (< (car xs) (caar xss)) (append (reverse rev) (list xs) xss) (loop (cdr xss) (cons (car xss) rev))))))) (define (sort deck) (let loop ((xs (list)) (piles (deal deck))) (if (null? piles) (reverse xs) (loop (cons (caar piles) xs) (insert (cdar piles) (cdr piles)))))) (display (sort '(4 2 9 1 3 6 7 8 5))) (newline)
Private
[
?
]
Run code
Submit