[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Nov 12:
; phil harvey's puzzle

(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 (square x) (* x x))

(define (cube x) (* x x x))

(define (choose n k)
  (if (zero? k) 1
    (* n (/ k) (choose (- n 1) (- k 1)))))

(display (choose 16 8)) (newline)

(define (combs n xs)
  (define (comb x xs)
    (if (null? xs) xs
      (if (pair? (car xs))
          (cons (append (list x) (car xs)) (comb x (cdr xs)))
          (cons (list x (car xs)) (comb x (cdr xs))))))
  (if (or (zero? n) (null? xs)) (list)
    (if (= n 1) xs
      (append (comb (car xs) (combs (- n 1) (cdr xs)))
              (combs n (cdr xs))))))

(display
  (let loop ((xss (combs 8 (range 1 17))))
    (let* ((xs (car xss))
           (s1 (apply + xs))
           (s2 (apply + (map square xs)))
           (s3 (apply + (map cube xs))))
    (if (and (= s1 68) (= s2 748) (= s3 9248)) xs
      (loop (cdr xss))))))


Output:
1
2
12870
(1 4 6 7 10 11 13 16)


Create a new paste based on this one


Comments: