[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Mar 21:
; jumping jack

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define (jack n)
  (define (diff-parity? t n)
    (not (= (modulo t 2) (modulo n 2))))
  (let loop ((k 0) (t 0))
    (if (or (< t (abs n)) (diff-parity? t (abs n)))
        (loop (+ k 1) (+ t k 1))
        k)))

(define (jacks n)
  (define (diff-parity? t n)
    (not (= (modulo t 2) (modulo n 2))))
  (if (negative? n)
      (map (lambda (x) (- x)) (jacks (- n)))
      (let loop ((k 0) (t 0))
        (if (or (< t n) (diff-parity? t n))
            (loop (+ k 1) (+ t k 1))
            (let loop ((d (/ (- t n) 2)) (xs (range k 0)) (zs (list)))
              (if (null? xs) zs
                (if (<= (car xs) d)
                    (loop (- d (car xs)) (cdr xs) (cons (- (car xs)) zs))
                    (loop d (cdr xs) (cons (car xs) zs)))))))))

(do ((n -24 (+ n 1))) ((= n 25))
  (display n) (display #\tab) (display (jack n))
  (display #\tab) (display (jacks n)) (newline))


Output:
-24	7	(-1 2 -3 -4 -5 -6 -7)
-23	9	(-1 2 -3 -4 -5 -6 -7 -8 9)
-22	7	(-1 -2 3 -4 -5 -6 -7)
-21	6	(-1 -2 -3 -4 -5 -6)
-20	7	(-1 -2 -3 4 -5 -6 -7)
-19	6	(1 -2 -3 -4 -5 -6)
-18	7	(-1 -2 -3 -4 5 -6 -7)
-17	6	(-1 2 -3 -4 -5 -6)
-16	7	(-1 -2 -3 -4 -5 6 -7)
-15	5	(-1 -2 -3 -4 -5)
-14	7	(-1 -2 -3 -4 -5 -6 7)
-13	5	(1 -2 -3 -4 -5)
-12	7	(1 -2 -3 -4 -5 -6 7)
-11	5	(-1 2 -3 -4 -5)
-10	4	(-1 -2 -3 -4)
-9	5	(-1 -2 3 -4 -5)
-8	4	(1 -2 -3 -4)
-7	5	(-1 -2 -3 4 -5)
-6	3	(-1 -2 -3)
-5	5	(-1 -2 -3 -4 5)
-4	3	(1 -2 -3)
-3	2	(-1 -2)
-2	3	(-1 2 -3)
-1	1	(-1)
0	0	()
1	1	(1)
2	3	(1 -2 3)
3	2	(1 2)
4	3	(-1 2 3)
5	5	(1 2 3 4 -5)
6	3	(1 2 3)
7	5	(1 2 3 -4 5)
8	4	(-1 2 3 4)
9	5	(1 2 -3 4 5)
10	4	(1 2 3 4)
11	5	(1 -2 3 4 5)
12	7	(-1 2 3 4 5 6 -7)
13	5	(-1 2 3 4 5)
14	7	(1 2 3 4 5 6 -7)
15	5	(1 2 3 4 5)
16	7	(1 2 3 4 5 -6 7)
17	6	(1 -2 3 4 5 6)
18	7	(1 2 3 4 -5 6 7)
19	6	(-1 2 3 4 5 6)
20	7	(1 2 3 -4 5 6 7)
21	6	(1 2 3 4 5 6)
22	7	(1 2 -3 4 5 6 7)
23	9	(1 -2 3 4 5 6 7 8 -9)
24	7	(1 -2 3 4 5 6 7)


Create a new paste based on this one


Comments: