[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/TaCSCQAW    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on May 9:
; partitions

(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 (set-cons x xs)
  (if (member x xs) xs
    (cons x xs)))

(define (parts n)
  (if (zero? n) (list (list))
    (let ((xs (list)))
      (do ((x 1 (+ x 1))) ((= x n) (cons (list n) xs))
        (do ((yss (parts (- n x)) (cdr yss))) ((null? yss))
          (set! xs (set-cons (sort < (cons x (car yss))) xs)))))))

(display (parts 0)) (newline)
(display (parts 1)) (newline)
(display (parts 2)) (newline)
(display (parts 3)) (newline)
(display (parts 4)) (newline)
(display (parts 5)) (newline)
(display (parts 6)) (newline)

(newline)

(define (parts n)
  (if (zero? n) (list (list))
    (let x-loop ((x 1) (xs (list)))
      (if (= x n) (cons (list n) xs)
        (let y-loop ((yss (parts (- n x))) (xs xs))
          (if (null? yss) (x-loop (+ x 1) xs)
            (y-loop (cdr yss)
                    (set-cons (sort < (cons x (car yss)))
                              xs))))))))

(display (parts 0)) (newline)
(display (parts 1)) (newline)
(display (parts 2)) (newline)
(display (parts 3)) (newline)
(display (parts 4)) (newline)
(display (parts 5)) (newline)
(display (parts 6)) (newline)


Output:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
(())
((1))
((2) (1 1))
((3) (1 1 1) (1 2))
((4) (2 2) (1 1 2) (1 1 1 1) (1 3))
((5) (2 3) (1 1 3) (1 1 1 1 1) (1 1 1 2) (1 2 2) (1 4))
((6) (3 3) (2 2 2) (2 4) (1 1 4) (1 1 2 2) (1 1 1 1 2) (1 1 1 1 1 1) (1 1 1 3) (1 2 3) (1 5))

(())
((1))
((2) (1 1))
((3) (1 1 1) (1 2))
((4) (2 2) (1 1 2) (1 1 1 1) (1 3))
((5) (2 3) (1 1 3) (1 1 1 1 1) (1 1 1 2) (1 2 2) (1 4))
((6) (3 3) (2 2 2) (2 4) (1 1 4) (1 1 2 2) (1 1 1 1 2) (1 1 1 1 1 1) (1 1 1 3) (1 2 3) (1 5))


Create a new paste based on this one


Comments: