[ create a new paste ] login | about

Link: http://codepad.org/ltak2soB    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Aug 31: 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

; longest increasing subsequence

(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))))))

(display (deal '(4 2 9 1 3 6 7 8 5))) (newline)

(define (make-new-pile deck selip) (list (car deck)))

(define (lt? deck piles) (< (car deck) (caar piles)))

(define (add-current-pile deck piles selip) (list (cons (car deck) (car piles))))

(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 (make-new-pile deck selip) selip))))
          ((lt? deck piles) ; found correct pile
            (loop (cdr deck) (list)
                  (append (reverse selip)
                          (add-current-pile deck piles selip)
                          (cdr piles))))
          (else ; continue search for correct pile
            (loop deck (cons (car piles) selip) (cdr piles))))))

(display (deal '(4 2 9 1 3 6 7 8 5))) (newline)

(define (make-new-pile deck selip)
  (list (if (null? selip) (list (car deck)) (cons (car deck) selip))))

(define (lt? deck piles) (< (car deck) (caaar piles)))

(define (add-current-pile deck piles selip)
  (list (if (null? selip)
            (cons (list (car deck)) (car piles))
            (cons (cons (car deck) selip) (car piles)))))

(display (deal '(4 2 9 1 3 6 7 8 5))) (newline)

(define (lis deck)
  (let loop ((dealt (car (reverse (deal deck)))) (result (list)))
    (if (null? (cdar dealt)) (cons (caar dealt) result)
      (loop (cadar dealt) (cons (caar dealt) result)))))

(display (lis '(4 2 9 1 3 6 7 8 5))) (newline)
(display (lis '(3 2 6 4 5 1))) (newline)
(display (lis '(0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))) (newline)


Output: 
1
2
3
4
5
6

((1 2 4) (3 9) (5 6) (7) (8))
((1 2 4) (3 9) (5 6) (7) (8))
(((1) (2) (4)) ((3 ((1) (2) (4))) (9 ((2) (4)))) ((5 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4))) (6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))) ((7 ((6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))) ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))) ((8 ((7 ((6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))) ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))) ((6 ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))) ((3 ((1) (2) (4))) (9 ((2) (4)))) ((1) (2) (4)))))
(1 3 6 7 8)
(2 4 5)
(0 2 6 9 11 15)


Create a new paste based on this one


Comments: