[ create a new paste ] login | about

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

Scheme, pasted on Apr 10:
; mcnugget numbers, revisited

(define-syntax fold-of
  (syntax-rules (range in is)
    ((_ "z" f b e) (set! b (f b e)))
    ((_ "z" f b e (v range fst pst stp) c ...)
      (let* ((x fst) (p pst) (s stp)
             (le? (if (positive? s) <= >=)))
        (do ((v x (+ v s))) ((le? p v) b)
          (fold-of "z" f b e c ...))))
    ((_ "z" f b e (v range fst pst) c ...)
      (let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
        (fold-of "z" f b e (v range x p s) c ...)))
    ((_ "z" f b e (v range pst) c ...)
      (fold-of "z" f b e (v range 0 pst) c ...))
    ((_ "z" f b e (x in xs) c ...)
      (do ((t xs (cdr t))) ((null? t) b)
        (let ((x (car t)))
          (fold-of "z" f b e c ...))))
    ((_ "z" f b e (x is y) c ...)
      (let ((x y)) (fold-of "z" f b e c ...)))
    ((_ "z" f b e p? c ...)
      (if p? (fold-of "z" f b e c ...)))
    ((_ f i e c ...)
      (let ((b i)) (fold-of "z" f b e c ...)))))

(define-syntax list-of (syntax-rules ()
  ((_ arg ...) (reverse (fold-of
    (lambda (d a) (cons a d)) '() arg ...)))))

(define (mcnugget-list n)
  (list-of (list a b c)
    (a range (+ (ceiling (/ n 6)) 1))
    (b range (+ (ceiling (/ n 9)) 1))
    (c range (+ (ceiling (/ n 20)) 1))
    (= (+ (* 6 a) (* 9 b) (* 20 c)) n)))

(display (mcnugget-list 100)) (newline)

(define (mcnugget-count n)
  (let ((cs (make-vector (+ n 1) 0)))
    (vector-set! cs 0 1)
    (do ((xs (list 6 9 20) (cdr xs)))
        ((null? xs) (vector-ref cs n))
      (do ((x (car xs) (+ x 1))) ((< n x))
        (vector-set! cs x
          (+ (vector-ref cs x)
             (vector-ref cs (- x (car xs)))))))))

(time (display (mcnugget-count 1000000)) (newline))

(define (counts xs n)
  (let ((cs (make-vector (+ n 1) 0)))
    (vector-set! cs 0 1)
    (do ((xs xs (cdr xs)))
        ((null? xs) (vector-ref cs n))
      (do ((x (car xs) (+ x 1))) ((< n x))
        (vector-set! cs x (+ (vector-ref cs x)
          (vector-ref cs (- x (car xs)))))))))

(display (counts '(1 5 10 25 50 100) 100)) (newline)


Output:
1
2
3
4
((0 0 5) (1 6 2) (4 4 2) (7 2 2) (10 0 2))
462964815
cpu time: 300 real time: 1516 gc time: 0
293


Create a new paste based on this one


Comments: