Skip to content

Instantly share code, notes, and snippets.

@hardenedapple

hardenedapple/count-change.scm

Last active March 14, 2017 18:52
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save hardenedapple/a82ba1c70997ac3c54aa8d94ac794d62 to your computer and use it in GitHub Desktop.
Save hardenedapple/a82ba1c70997ac3c54aa8d94ac794d62 to your computer and use it in GitHub Desktop.
Download ZIP
count-change constant time constant space
Raw
count-change.scm
;; COUNT-CHANGE challenge (throwaway comment in SICP along the lines of coming
;; up with a better solution is left as a challenge to the reader).
;; Find a better way of calculating the following.
;; I don't think this challenge allows memoization.
(define (first-denomination kinds-of-coins)
(cond ((= kinds-of-coins 1) 1)
((= kinds-of-coins 2) 5)
((= kinds-of-coins 3) 10)
((= kinds-of-coins 4) 25)
((= kinds-of-coins 5) 50)))
(define (cc amount kinds-of-coins)
(cond ((or (= kinds-of-coins 1) (= amount 0)) 1)
((or (< amount 0) (= kinds-of-coins 0)) 0)
(else (+ (cc amount
(- kinds-of-coins 1))
(cc (- amount
(first-denomination kinds-of-coins))
kinds-of-coins)))))
(define (count-change amount)
(cc amount 5))
;;; NOTE:
;;; There are quite a few places where I could simplify the code with
;;; macros. Most on my mind right now are all the many places where I've
;;; written variations on the same loop checking something is true for all
;;; values between 0 and X.
;;; Similarly, the many places where I wrote down the same definition for
;;; 'A', 'B', 'div', 'mod', and 'dm' should be made cleaner so that reading
;;; is easier.
;;;
;;; I just haven't gotten round to doing it.
;; Notation:
;; All division here is integer division.
;; (f x [5, 1]) => # of ways to change x using denominations 5 and 1
;; (g x [cdr ...]) => all ways to change x using denominations [cdr ...]
;; [{count1, type1}, {count2, type2}] => countN times each coin typeN
;;
;; Lemma:
;; (f x [1]) == 1
;;
;; Note that for (f x [car, cdr ...]), the ways to make 'x' are as follows:
;; [{(/ x car), car}, (g (modulo x car) [cdr ...])]
;; [{(- (/ x car) 1), car}, (g (+ (modulo x car) car) [cdr ...])]
;; [{(- (/ x car) 2), car}, (g (+ (modulo x car) (* 2 car)) [cdr ...])]
;; ...
;;
;; Which means the *number* of ways to make 'x' is:
;; \sum_{i=0}^{i=(/ x car)} (f (+ (modulo x car) (* car i)) [cdr ...])
;;
;; For [car, cdr ...] = [5, 1], this expands to
;; \sum_{i=0}^{i=(/ x 5)} (f (+ (modulo x 10) (* 5 i)) [1])
;;
;; which, because (f <anything> [1]) == 1, is
;; (1+ (/ x 5))
;;
;; For [car, cdr ...] = [10, 5, 1], this expands to
;; \sum_{i=0}^{i=(/ x 10)} (f (+ (modulo x 10) (* 10 i)) [5, 1])
;;
;; which, because (f <anything> [5, 1]) == (1+ (/ x 5)), is
;; (+ (* (1+ (/ x 10)) (1+ (/ (modulo x 10) 5))) (\sum_{i=0}^{i=(/ x 10)} (* 2 i)))
;; ==
;; (* (1+ (/ x 10)) (+ 1 (/ (modulo x 10) 5) (/ x 10)))
;;
;;
;; For [car, cdr ...] = [25, 10, 5, 1], we have
;; \sum ... (f (+ (modulo x 25) (* 25 i)) [10, 5, 1])
;; ==
;; (+ (* (1+ (/ (modulo x 25) 10)) (+ (/ (modulo (modulo x 25) 10) 5) 1 (/ (modulo x 25) 10)))
;; (* (1+ (/ (+ 5 (modulo x 25)) 10)) (+ (/ (modulo (+ 5 (modulo x 25)) 10) 5) 1 (/ (+ 5 (modulo x 25)) 10) 2))
;; ...)
;;
;; setting A = (/ (modulo x 25) 10)
;; B = (/ (modulo (modulo x 25) 10) 5)
;;
;; we notice that there are two options...
;; either B = 0, and (/ (modulo (+ 5 (modulo x 25)) 10) 5) = 1
;; or B = 1, and (/ (modulo (+ 5 (modulo x 25)) 10) 5) = 0
;;
;; in these cases,
;; either (/ (+ 5 (modulo x 25)) 10) = A + 1
;; or (/ (+ 5 (modulo x 25)) 10) = A
;;
;; Which means the total sum is
;; either (+ (* (+ A 1) (A + 2)) (* (A + 4)(A + 4)) (* (A + 6)(A +7)) ...)
;; or (+ (* (+ A 1)(A + 1)) (* (A + 3)(A + 4)) (* (A + 6)(A + 6)) ...)
;;
;; which expands into
;; (+ (* (1+ (/ x 25)) (* A A)) (\sum_{i=0}^{i=(/ x 25)} (5i + B) * A) +
;; (* B (sum 1 (1+3) (1+3+2) (1+3+2+3) (1+3+2+3+2) ...))
;; (* 1 (* (1+3) (1+2)) (* (1+3+2) (1+2+3)) (* (1+3+2+3) (1+2+3+2)) ,,,))
(define (int/ x y) (floor (/ x y)))
(define (calc-10 amount)
(let ((div (int/ amount 10))
(mod (modulo amount 10)))
(* (1+ div) (+ (int/ mod 5) 1 div))))
;;; First step: show that the splitting and summing is a valid technique.
;; \sum_{i=0}^{i=(/ x 25)} (f (+ (modulo x 25) (* 25 i)) [10, 5, 1])
(define (temp-25-helper div mod i accum)
(if (> i div) accum
(temp-25-helper div mod (1+ i)
(+ accum (calc-10 (+ mod (* 25 i)))))))
(define (temp-25 amount)
(let ((div (int/ amount 25))
(mod (modulo amount 25)))
(temp-25-helper div mod 0 0)))
;;; Use the below to sanity-check that our expansion works
(define (check-alternate amount kinds-of-coins new-version)
(= (cc amount kinds-of-coins) (new-version amount)))
(define (check-many kinds-of-coins new-version)
(let loop ((amount 0))
;; Only use 500 because much more than that and the original version takes a
;; long time.
(cond ((= amount 500) #t)
((check-alternate amount kinds-of-coins new-version)
(loop (1+ amount)))
(else (cons amount #f)))))
(check-many 4 temp-25)
;;; Next, start expanding and cancelling.
;; either (+ (* (+ A 1) (A + 2)) (* (A + 4)(A + 4)) (* (A + 6)(A + 7)) ...)
;; or (+ (* (+ A 1) (A + 1)) (* (A + 3)(A + 4)) (* (A + 6)(A + 6)) ...)
;; depending on if (floor (/ (modulo mod 10) 5)) is 1 or 0
(define (option-element prevA add3)
(if add3
(* prevA (1+ prevA))
(* prevA prevA)))
(define (temp-25-helper prevA div i accum add3)
(if (> i div) accum
(temp-25-helper (+ prevA (if add3 3 2))
div
(1+ i)
(+ accum (option-element prevA add3))
(not add3))))
(define (temp-25 amount)
(let* ((div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5)))
(temp-25-helper (1+ A) div 0 0 (= B 1))))
(check-many 4 temp-25)
;;; The above can be simplified
;;; (+ (* (1+ (/ x 25)) A A)
;;; (\sum_{i=0}^{i=(/ x 25)} (* A (+ (* 5 i) B 2)))
;;; (+ (either (1 (* (+ 1 3) (+ 1 2))
;;; (* (+ 1 3 2) (+ 1 2 3))
;;; (* (+ 1 3 2 3) (+ 1 2 3 2))
;;; ...)
;;; or (2 (* (+ 1 3) (+ 2 2))
;;; (* (+ 1 3 2) (+ 2 2 3))
;;; (* (+ 1 3 2 3) (+ 2 2 3 2))
;;; ...))))
(define (temp-25-helper1 A B div i accum)
(if (> i div) accum
(temp-25-helper1 A B div (1+ i)
(+ accum (* A (+ (* 5 i) B 2))))))
(define (temp-25-helper2-loop left right div i accum add3)
(if (> i div) accum
(temp-25-helper2-loop
(+ left (if add3 3 2))
(+ right (if add3 2 3))
div
(1+ i)
(+ accum (* left right))
(not add3))))
(define (temp-25-helper2 div two-start)
(temp-25-helper2-loop 1 (if two-start 2 1) div 0 0 #t))
(define (temp-25 amount)
(let* ((div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5)))
(+ (* A A (1+ div))
(temp-25-helper1 A B div 0 0)
(temp-25-helper2 div (= B 1)))))
(check-many 4 temp-25)
;;; Expand out the sum rule for (temp-25-helper1 ...)
;;; (\sum_{i=0}^{i=(/ x 25)} (* A (+ (* 5 i) B 2)))
;;; ==
;;; (+ (* (/ x 25) A (+ B 2))
;;; (* 5 A (/ (* (/ x 25) (1+ (/ x 25)) 2))))
(define (temp-25 amount)
(let* ((div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5)))
(+ (* A A (1+ div))
(* (1+ div) (+ 2 B) A)
(* 5 A (/ (* div (1+ div)) 2))
(temp-25-helper2 div (= B 1)))))
(check-many 4 temp-25)
;;; Expand out the sum rule for (temp-25-helper2 ...)
;;; (+ (either (1 (* (+ 1 3) (+ 1 2))
;;; (* (+ 1 3 2) (+ 1 2 3))
;;; (* (+ 1 3 2 3) (+ 1 2 3 2))
;;; ...)
;;; or (2 (* (+ 1 3) (+ 2 2))
;;; (* (+ 1 3 2) (+ 2 2 3))
;;; (* (+ 1 3 2 3) (+ 2 2 3 2))
;;; ...))))
;;; ==
;;; (+ 1 (* (+ 1 3) (+ 1 2))
;;; (* (+ 1 3 2) (+ 1 2 3))
;;; (* (+ 1 3 2 3) (+ 1 2 3 2))
;;; ...
;;; (either 0 or (+ 1 (+ 1 3) (+ 1 3 2) (+ 1 3 2 3) ...)))
(define (base-series div)
(let loop ((i 0) (left 1) (right 1) (add3 #t) (accum 0))
(if (> i div) accum
(loop (1+ i)
(+ left (if add3 3 2))
(+ right (if add3 2 3))
(not add3)
(+ accum (* left right))))))
(define (add-series div)
(let loop ((i 0) (addval 1) (add3 #t) (accum 0))
(if (> i div) accum
(loop (1+ i)
(+ addval (if add3 3 2))
(not add3)
(+ accum addval)))))
(define (temp-25 amount)
(let* ((div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5))
(n (int/ div 2)))
(+ (* A A (1+ div))
(* (1+ div) (+ 2 B) A)
(* 5 A (/ (* div (1+ div)) 2))
(base-series div)
(if (= B 1) (add-series div) 0))))
(check-many 4 temp-25)
;;; Replace the add-series calculation with a simple form
;;; (+ 1 (+ 1 3) (+ 1 3 2) (+ 1 3 2 3) (+ 1 3 2 3 2) ...)
;;; ==
;;; (+ 1 4 6 9 11 14 ...)
;;; ==
;;; (+ 1 (+ 4 9 14 19 ...) (+ 6 11 16 21 ...))
;;; ==
;;; (+ 1 (sum_{i=1}^{i=n} (1- (* 5 i))) (sum_{i=1}^{i=n} (1+ (* 5 i)))
;;; (extra-terms-account-for-last-element))
;;; where n = (floor (/ (floor (/ x 25)) 2))
;;; ==
;;; (+ 1 (* 5 n n) (* 5 n) (extra-terms-account-for-last-element))
;;;
;;; extra-terms-account-for-last-element is:
;;; (if (= 1 (modulo (/ x 25) 2))
;;; (* (+ 4 (* 5 n)) (+ 3 (* 5 n)))
;;; 0)
(define (temp-25 amount)
(let* ((div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5))
(n (int/ div 2)))
(+ (* A A (1+ div))
(* (1+ div) (+ 2 B) A)
(* 5 A (/ (* div (1+ div)) 2))
(base-series div)
(if (= B 1)
(+ 1 (* 5 n) (* 5 n n)
(if (= 1 (modulo div 2))
(+ 4 (* 5 n))
0))
0))))
(check-many 4 temp-25)
;;; Replace the base-series calculation with our equation
;;; (+ 1 (* (+ 1 3) (+ 1 2))
;;; (* (+ 1 3 2) (+ 1 2 3))
;;; (* (+ 1 3 2 3) (+ 1 2 3 2))
;;; ...)
;;; ==
;;; (+ (* 1 1) (* 4 3) (* 6 6) (* 9 8) (* 11 11) ...)
;;; ==
;;; (+ (* 1 1)
;;; (+ (* 6 6) (* 11 11) (* 16 16) ...)
;;; (+ (* 4 4) (* 9 9) (* 14 14) ...)
;;; (- 0 4 9 14 ...))
;;; ==
;;; (+ (* 1 1)
;;; (+ (+ (* 5 5) 5 6) (+ (* 10 10) 10 11) ...)
;;; (+ (- (* 5 5) 5 4) (- (* 10 10) 10 9) ...)
;;; (- 0 4 9 14 ...))
;;; ==
;;; (+ 1
;;; (* 2 (\sum (* 5 i 5 i)))
;;; (\sum 2)
;;; (- 0 (\sum (- (* 5 i) 1))))
;;;
;;; using sum rules and summing up to n = (/ (/ x 25) 2)
;;;
;;; (- 0 (\sum (- (* 5 i) 1))) == (* 5 (/ n (1+ n)) 2)
;;;
;;; (\sum 2) == (2 n)
;;;
;;; (* 2 (\sum (* 5 i 5 i))) ==
;;; (+ (/ (* 50 n n n) 3)
;;; (/ (* 50 n n) 2)
;;; (/ (* 50 n) 6))
;;;
;;; and accounting for the last term (if (/ x 25) is divisible by 2, then there
;;; is no extra term, otherwise there is one.
;;; (if (= 1 (modulo (/ x 25) 2))
;;; (* (+ 4 (* 5 n))
;;; (+ 3 (* 5 n)))
;;; 0)
;;; The division here doesn't always come out as an integer, but the end result
;;; of the function should be an integer.
(define (sum-of-squares val)
(let ((result (+ (/ (* val val val) 3)
(/ (* val val) 2)
(/ val 6))))
(if (integer? result)
result
(error "sum-of-squares returned non integer" val result))))
(define (temp-25 amount)
(let* ((div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5))
(n (int/ div 2)))
(+ (* A A (1+ div))
(* (1+ div) (+ 2 B) A)
;; Division must give an integer as one of div and (1+ div) must be
;; even.
(* 5 A (/ (* div (1+ div)) 2))
(+ 1
(* 50 (sum-of-squares n))
(* 3 n)
;; Division has to give integer as one of n and (1+ n) must be even.
(- (* 5 (/ (* n (1+ n)) 2)))
(if (= 1 (modulo div 2))
(* (+ 4 (* 5 n))
(+ 3 (* 5 n)))
0))
(if (= B 1)
(+ 1 (* 5 n) (* 5 n n)
(if (= 1 (modulo div 2))
(+ 4 (* 5 n))
0))
0))))
(check-many 4 temp-25)
;;; Make a nice iterative process function to test the next stage against.
;;; we're already much faster than the naive version.
;;; Just uses the rules above and the new temp-25 function.
(define (calc-50-helper div mod i accum)
(if (> i div) accum
(calc-50-helper div mod (1+ i)
(+ accum (temp-25 (+ mod (* 50 i)))))))
(define (calc-50 amount)
(let ((div (int/ amount 50))
(mod (modulo amount 50)))
(calc-50-helper div mod 0 0)))
(define (my-count-change amount)
(calc-50 amount))
;;; Take the temp-25 equation from above, and use it to get a nice simple
;;; equation for the final version.
;;;
;;; We have as the temp-25 equation:
;;;
;;; (f x [25, 10, 5, 1]) =
;;; (let* ((div (floor (/ amount 25)))
;;; (mod (modulo amount 25))
;;; (A (floor (/ mod 10)))
;;; (B (floor (/ (modulo mod 10) 5)))
;;; (n (floor (/ div 2))))
;;; (+ (* A A (1+ div))
;;; (* (1+ div) (+ 2 B) A)
;;; (* 5 A (/ (* div (1+ div)) 2))
;;; (+ 1
;;; ;; Here we use fractional division instead of integer division
;;; ;; It's all good because scheme has rational numbers, and it has to
;;; ;; end up with an integer number as it represents the sum of all
;;; ;; square integers up to n
;;; (/ (* 50 n n n) 3)
;;; (* 25 n n)
;;; (/ (* 25 n) 3)
;;; (* 3 n)
;;; (- (* 5 (/ (* n (1+ n)) 2)))
;;; (if (= 1 (modulo div 2))
;;; (* (+ 4 (* 5 n))
;;; (+ 3 (* 5 n)))
;;; 0))
;;; (if (= B 1)
;;; (+ 1 (* 5 n) (* 5 n n)
;;; (if (= 1 (modulo div 2))
;;; (+ 4 (* 5 n))
;;; 0))
;;; 0)))
;;;
;;; Adding the extra layer of using [50, 25, 10, 5, 1], we now want to calculate
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (f (+ (modulo x 5) (* i 50)) [25, 10, 5, 1])
;;;
;;; In the following equations, we notice that:
;;;
;;; a)
;;; A == (floor (/ (modulo amount 25) 10))
;;; amount == (+ (modulo x 50) (* 50 i))
;;; in modulo 25 the term (* 50 i) is irrelevant, so
;;; A == (floor (/ (modulo (modulo x 50) 25) 10))
;;; which is a constant
;;; (let's call it A)
;;;
;;; b)
;;; B == (floor (/ (modulo (modulo amount 25) 10) 5))
;;; amount == (+ (modulo x 50) (* 50 i))
;;; ==> B == (floor (/ (modulo (modulo (modulo x 50) 25) 10) 5))
;;; which is a constant
;;; (let's call it B)
;;;
;;; c)
;;; n == (floor (/ (floor (/ amount 25)) 2))
;;; == (floor (/ amount 50))
;;; amount == (+ (modulo x 50) (* 50 i))
;;; ==> n == i
;;;
;;; d)
;;; div = (floor (/ amount 25)) == (+ (* i 2) (floor (/ (modulo x 50) 25)))
;;; lets call (floor (/ (modulo x 50) 25)) 'dm'
;;;
;;; For convenience, call (floor (/ x 50)) 50div.
;;;
;;; Looking at the first term in the 25 version
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (* A A (1+ 50div))
;;; ==
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (* A A (+ (* 2 i) dm 1))
;;; ==
;;; (* (+ 50div 1) A A (+ 50div dm 1))
;;;
(define (check-final-eq new-version)
(let loop ((amount 0))
(cond ((= amount 500) #t)
((check-alternate amount 5 new-version)
(loop (1+ amount)))
(else (cons amount #f)))))
;;; Not really to confident with this macro (I'm a CL guy trying out scheme),
;;; but it appears to work.
;;;
;;; In each invocation of (calc-50-helper) we print the amount that was
;;; calculated from the simple sum. This helps show our progress in
;;; simplification, as the numbers get smaller with each substitution.
;;; We'll know we've finished when all numbers printed are 0.
;;;
;;; NOTE:
;;; It's a little confusing (and I should neaten it up but haven't bothered
;;; yet) that I use 'div' for both the 'div' definition in temp-25 and the
;;; new 'div' definition, similarly for mod.
;;; e.g. in the first element of `with-substitutions', 'div' means x/50, in
;;; the second it means (floor (/ (+ (modulo x 50) (* 50 i)))).
;;;
;;; Similarly, I should put the definitions of 'A' and 'B' higher up to show
;;; they're the same between the forms at the end and each element in the
;;; sum.
(define-syntax with-substitutions
(lambda (form)
(syntax-case form ()
((with-substitutions ((closed-forms to-replace) ...))
(with-syntax ((A (datum->syntax form 'A))
(mod (datum->syntax form 'mod))
(div (datum->syntax form 'div))
(B (datum->syntax form 'B))
(n (datum->syntax form 'n))
(dm (datum->syntax form 'dm)))
#'(begin (define (calc-50-helper div mod i accum)
(if (> i div)
;; Print out the value of the accumulater -- should get
;; to zero by the time I've finished the substitutions.
(+ (begin (display accum) (newline) accum)
(let* ((A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(+ closed-forms ...)))
(calc-50-helper div mod (1+ i)
(+ accum (temp-25 (+ mod (* 50 i)))
(- (let* ((amount (+ mod (* 50 i)))
(div (int/ amount 25))
(mod (modulo amount 25))
(A (int/ mod 10))
(B (int/ (modulo mod 10) 5))
(n (int/ div 2)))
(if (= n i)
(+ to-replace ...)
(error "n is not equal to i"
n i amount))))))))
(check-final-eq my-count-change)))))))
(with-substitutions (((* (+ div 1) A A (+ div dm 1))
(* A A (1+ div)))))
(define (this-substitution amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(dm (int/ mod 25)))
(* (+ div 1) A A (+ div dm 1))))
(define (simplified-substitution amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(dm (int/ mod 25)))
(+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))))
(define (check-substitution)
(let loop ((amount 0))
(cond ((> amount 999999) #t)
((= (this-substitution amount)
(simplified-substitution amount))
(loop (1+ amount)))
(else (cons amount #f)))))
(check-substitution)
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (* (1+ div) (+ 2 B) A)
;;; ==
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (* (+ 1 (* i 2) dm) (+ 2 B) A)
;;; ==
;;; (* (1+ (int/ x 50)) A (+ B 2) (+ dm 1 (int/ x 50)))
(define (this-substitution amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(* (1+ div) A (+ B 2) (+ dm 1 div))))
(define (simplified-substitution amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))))
(check-substitution)
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((* (1+ div) A (+ B 2) (+ dm 1 div))
(* (1+ div) (+ 2 B) A))))
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (* 5 A (int/ (* (1+ div) div) 2))
;;; ==
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (* (int/ (+ (* 4 i i) (* 4 i dm) (* dm dm)
;;; (* 2 i) dm)
;;; 2)
;;; 5 A)
;;; ==
;;; \sum_{i = 0}^{i = (floor (/ x 50))} (+ (* 10 A i i) (* 10 A dm i) (* 5 A i))
;;; +
;;; (* (1+ (int/ x 50)) (/ (* 5 A dm (1+ dm)) 2))
;;; ==
;;; (+ (* 10 A (sum-of-squares div))
;;; (* (1+ (int/ x 50))
;;; (+ (* (int/ x 50) (+ (* 5 A dm) (/ (* 5 A) 2)))
;;; (/ (* 5 A dm (1+ dm)) 2)))
;;;
;;; Using
;;; dm == (int/ (modulo x 50) 25) == 0 or 1
;;; ==> (* dm (1+ dm)) is either 0 or 2
;;; we know that (/ (* 5 A dm (1+ dm)) 2) == (* 5 A dm)
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((+ (* 10 A (sum-of-squares div))
(* (1+ div)
(+ (* div (+ (* 5 A dm) (/ (* 5 A) 2)))
(* 5 A dm))))
(* 5 A (int/ (* (1+ div) div) 2)))))
;; Neatening this up
(define (this-substitution amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(dm (int/ mod 25)))
(+ (* 10 A (sum-of-squares div))
(* (1+ div)
(+ (* div (+ (* 5 A dm) (/ (* 5 A) 2)))
(* 5 A dm))))))
(define (simplified-substitution amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(dm (int/ mod 25)))
(* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))))
(check-substitution)
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))))
;;; \sum_{i = 0}^{i = (floor (/ x 50))} 1
;;; ==
;;; (1+ (int/ x 50))
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((* (1+ div) A (+ B 2) (+ dm 1 div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)))
;;; \sum_{n = 0}^{n = (floor (/ x 50))} (* 50 (+ (/ (* n n n) 3)
;;; (/ (* n n) 2)
;;; (/ n 6)))
;;; ==
;;; (* 50 (+ (\sum_{n = 0}^{n = (floor (/ x 50))} (/ (* n n n) 3))
;;; (/ (sum-of-squares (int/ x 50)) 2)
;;; (/ (* div (1+ div)) 12)))
;;; ==
;;; (* 50 (+ (/ (* div div (1+ div) (1+ div)) 12)
;;; (/ (sum-of-squares (int/ x 50)))
;;; (/ (* div (1+ div)) 12)))
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)
((* 50 (+ (/ (* div div (1+ div) (1+ div)) 12)
(/ (sum-of-squares div) 2)
(/ (* div (1+ div)) 12)))
(* 50 (+ (/ (* n n n) 3)
(/ (* n n) 2)
(/ n 6))))))
(define (this-substitution div)
(+ (/ (* div div (1+ div) (1+ div)) 12)
(/ (sum-of-squares div) 2)
(/ (* div (1+ div)) 12)))
(define (sum-of-sum-of-squares div)
(+ (/ (* div div div div) 12)
(/ (* div div div) 3)
(/ (* 5 div div) 12)
(/ div 6)))
(define simplified-substitution sum-of-sum-of-squares)
(check-substitution)
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)
((* 50 (sum-of-sum-of-squares div))
(* 50 (+ (/ (* n n n) 3)
(/ (* n n) 2)
(/ n 6))))))
;;; \sum_{n = 0}^{n = (floor (/ x 50))} (* 3 n)
;;; ==
;;; (/ (* 3 div (1+ div)) 2)
;;; ==
;;; (+ (/ (* 3 div div) 2)
;;; (/ (* 3 div) 2))
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)
((* 50 (sum-of-sum-of-squares div))
(* 50 (+ (/ (* n n n) 3)
(/ (* n n) 2)
(/ n 6))))
((+ (* (/ 3 2) div div)
(* (/ 3 2) div))
(* 3 n))))
;;; \sum_{n = 0}^{n = (floor (/ x 50))} (- (* 5 (/ (* n (1+ n)) 2)))
;;; ==
;;; (/ (* 5 (+ (sum-of-squares div) (/ (* div (1+ div)) 2))) 2)
(define (this-substitution div)
(/ (* 5 (+ (sum-of-squares div)
(/ (* div (1+ div)) 2)))
2))
(define (simplified-substitution div)
(+ (* (/ 5 6) div div div)
(* (/ 5 2) div div)
(* (/ 5 3) div)))
(check-substitution)
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)
((* 50 (sum-of-sum-of-squares div))
(* 50 (+ (/ (* n n n) 3)
(/ (* n n) 2)
(/ n 6))))
((+ (* (/ 3 2) div div)
(* (/ 3 2) div))
(* 3 n))
((- (+ (* (/ 5 6) div div div)
(* (/ 5 2) div div)
(* (/ 5 3) div)))
(- (* 5 (/ (* n (1+ n)) 2))))))
;;; \sum_{n = 0}^{n = (floor (/ x 50))} (if (= 1 (modulo div 2))
;;; (* (+ 4 (* 5 n))
;;; (+ 3 (* 5 n)))
;;; 0)
;;; ==
;;; (if dm (\sum_{n = 0}^{n = (floor (/ x 50))} (+ (* 25 i i) (35 i) 12))
;;; 0)
;;; ==
;;; (if dm (+ (* 25 (sum-of-squares div))
;;; (/ (* 35 div (1+ div)) 2)
;;; (* 12 (1+ div)))
;;; 0)
;;; ==
;;; [because dm is either 1 or 0]
;;; (* dm (+ (* 25 (sum-of-squares div))
;;; (/ (* 35 div (1+ div)) 2)
;;; (* 12 (1+ div))))
(define (this-substitution div)
(+ (* 25 (sum-of-squares div))
(/ (* 35 div (1+ div)) 2)
(* 12 (1+ div))))
(define (simplified-substitution div)
(+ (* (/ 25 3) div div div)
(* 30 div div)
(* (/ 101 3) div)
12))
(check-substitution)
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)
((* 50 (sum-of-sum-of-squares div))
(* 50 (+ (/ (* n n n) 3)
(/ (* n n) 2)
(/ n 6))))
((+ (* (/ 3 2) div div)
(* (/ 3 2) div))
(* 3 n))
((- (+ (* (/ 5 6) div div div)
(* (/ 5 2) div div)
(* (/ 5 3) div)))
(- (* 5 (/ (* n (1+ n)) 2))))
((* dm (+ (* (/ 25 3) div div div)
(* 30 div div)
(* (/ 101 3) div)
12))
(if (= 1 (modulo div 2))
(* (+ 4 (* 5 n))
(+ 3 (* 5 n)))
0))))
;;; \sum_{n = 0}^{n = (floor (/ x 50))}
;;; (if (= B 1)
;;; (+ 1 (* 5 n) (* 5 n n)
;;; (if (= 1 (modulo div 2))
;;; (+ 4 (* 5 n))
;;; 0))
;;; 0)))
;;; ==
;;; [because B is either 0 or 1, and dm is either 0 or 1]
;;; (* B (\sum_{n = 0}^{n = (floor (/ x 50))}
;;; (+ (* 5 i) (* 5 i i) 1
;;; (* dm (+ 4 (* 5 i))))))
;;; ==
;;; (* B (+ (/ (* 5 div (1+ div)) 2)
;;; (* 5 (sum-of-squares div))
;;; (1+ div)
;;; (* dm (1+ div) (+ 4 (/ (* div 5) 2)))))
(with-substitutions (((+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div))
(* A A (1+ div)))
((+ (* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div))
(* (1+ div) (+ 2 B) A))
((* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
(* 5 A (int/ (* (1+ div) div) 2)))
((1+ div)
1)
((* 50 (sum-of-sum-of-squares div))
(* 50 (+ (/ (* n n n) 3)
(/ (* n n) 2)
(/ n 6))))
((+ (* (/ 3 2) div div)
(* (/ 3 2) div))
(* 3 n))
((- (+ (* (/ 5 6) div div div)
(* (/ 5 2) div div)
(* (/ 5 3) div)))
(- (* 5 (/ (* n (1+ n)) 2))))
((* dm (+ (* (/ 25 3) div div div)
(* 30 div div)
(* (/ 101 3) div)
12))
(if (= 1 (modulo div 2))
(* (+ 4 (* 5 n))
(+ 3 (* 5 n)))
0))
((* B (+ (/ (* 5 div (1+ div)) 2)
(* 5 (sum-of-squares div))
div 1
(* dm (+ (* 4 (1+ div)) (/ (* 5 div (1+ div)) 2)))))
(if (= B 1)
(+ 1 (* 5 n) (* 5 n n)
(if (= 1 (modulo div 2))
(+ 4 (* 5 n))
0))
0))))
;;; Using the debugging information, we see that the accumulator is 0 at the end
;;; of each iteration, which means the substitutions we have made are complete.
;;; Let's make a function that just uses these substitutions and ensure it works
;;; with (check-final-eq count-change-fast).
;;;
;;; After that we'll get into simplifying the expression (all the way checking
;;; that the simplification gives the same answer as the previous version).
(define (count-change-fast amount)
(let* ((div (int/ amount 50))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(+ (* A A div div)
(* A A (1+ dm))
(* A A (+ 2 dm) div)
(* A (+ 2 B) div div)
(* A (+ 2 B) (1+ dm))
(* A (+ 2 B) (+ 2 dm) div)
(* 5 A (+ (* (/ 2 3) div div div)
(* (+ dm (/ 3 2)) div div)
(* (+ (/ 5 6) (* 2 dm)) div)
dm))
div
1
(* 50 (sum-of-sum-of-squares div))
(+ (* (/ 3 2) div div)
(* (/ 3 2) div))
(- 0
(* (/ 5 6) div div div)
(* (/ 5 2) div div)
(* (/ 5 3) div))
(* dm (+ (* (/ 25 3) div div div)
(* 30 div div)
(* (/ 101 3) div)
12))
(* B (+ (/ (* 5 div (1+ div)) 2)
(* 5 (sum-of-squares div))
div 1
(* dm (+ (* 4 (1+ div)) (/ (* 5 div (1+ div)) 2))))))))
;;; Combining terms in pretty much a haphazard way (how I wrote it down on my
;;; piece of paper when thinking).
(define (count-change-final amount)
(let* ((div (int/ amount 50))
(div2 (* div div))
(div3 (* div2 div))
(div4 (* div3 div))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(+ (* (/ 50 12) div4)
(* (+ (* A (/ 10 3)) (/ 95 6)) div3)
(* (+ (* A A) (* A (/ 19 2)) (/ 119 6)) div2)
(* (+ (* 2 A A) (* A (/ 49 6)) (/ 55 6)) div)
(* A A) (* A 2) 1
(* dm (+ (* (/ 25 3) div3)
(* (+ (* A 5) 30) div2)
(* (+ (* A A) (* A 12) (/ 101 3)) div)
(* A A) (* A 7) 12))
(* B (+ (* (/ 5 3) div3)
(* (+ A 5) div2)
(* (+ (* 2 A) (/ 13 3)) div)
A 1
(* dm (+ (* (/ 5 2) div2)
(* (+ A (/ 13 2)) div)
A 4)))))))
;;; Combining so that terms which are reasonably likely to be zero are joined
;;; together.
(define (count-change-final-alt amount)
(let* ((div (int/ amount 50))
(div2 (* div div))
(div3 (* div2 div))
(div4 (* div3 div))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(+ (* (/ 50 12) div4)
(* (/ 95 6) div3)
(* (/ 119 6) div2)
(* (/ 55 6) div)
1
;;; A is either 0, 1, or 2
;;; because it may be zero, put them all in the same place so that if
;;; it's zero the function can skip the calculation of everything else.
(* A (+ (* (/ 10 3) div3)
(* (+ A (/ 19 2)) div2)
(* (+ (* 2 A) (/ 49 6)) div)
(+ A 2)))
;; dm is either 1 or 0
(* dm (+ (* (/ 25 3) div3)
(* (+ (* A 5) 30) div2)
(* (+ (* A A) (* A 12) (/ 101 3)) div)
(* A A) (* A 7) 12))
;; B is either 1 or 0
(* B (+ (* (/ 5 3) div3)
(* (+ A 5) div2)
(* (+ (* 2 A) (/ 13 3)) div)
A 1
(* dm (+ (* (/ 5 2) div2)
(* (+ A (/ 13 2)) div)
A 4)))))))
;;; Combined by powers of 'div'
(define (count-change-final-alt2 amount)
(let* ((div (int/ amount 50))
(div2 (* div div))
(div3 (* div2 div))
(div4 (* div3 div))
(mod (modulo amount 50))
(A (int/ (modulo mod 25) 10))
(B (int/ (modulo (modulo mod 25) 10) 5))
(dm (int/ mod 25)))
(+ (* (/ 50 12) div4)
(* (+ (* A (/ 10 3))
(/ 95 6)
(* dm (/ 25 3))
(* B (/ 5 3))) div3)
(* (+ (* A A)
(* A (/ 19 2))
(/ 119 6)
(* dm (+ 30 (* 5 A)))
(* B (+ A 5))
(* B dm (/ 5 2))) div2)
(* (+ (* 2 A A)
(* A (/ 49 6))
(/ 55 6)
(* dm (+ (* A A) (* 12 A) (/ 101 3)))
(* B (+ (* 2 A) (/ 13 3)))
(* B dm (+ A (/ 13 2)))) div)
(* A A) (* A 2) 1
(* dm (+ (* A A) (* 7 A) 12))
(* B (1+ A))
(* B dm (+ A 4)))))
(check-final-eq count-change-fast)
(define (check-same-equation left right)
(let loop ((amount 0))
;; N.B. look at how much larger a number I can calculate for!
(cond ((= amount 99999) #t)
((= (left amount) (right amount))
(loop (1+ amount)))
(else (cons amount #f)))))
(check-same-equation count-change-fast count-change-final-alt2)
(check-same-equation count-change-fast count-change-final-alt)
(check-same-equation count-change-fast count-change-final)
;;; Out of curiosity, I had a look at the time of each.
(define (time-once-1)
(let loop ((amount 0))
(if (> amount 999999)
'finished
(begin (count-change-final amount)
(loop (1+ amount))))))
(define (time-once-2)
(let loop ((amount 0))
(if (> amount 999999)
'finished
(begin (count-change-final-alt amount)
(loop (1+ amount))))))
(define (time-once-3)
(let loop ((amount 0))
(if (> amount 999999)
'finished
(begin (count-change-final-alt2 amount)
(loop (1+ amount))))))
;; scheme@(guile-user)> ,time (time-once-1)
;; $36 = finished
;; ;; 9.846763s real time, 10.232429s run time. 1.494645s spent in GC.
;; scheme@(guile-user)> ,time (time-once-1)
;; $37 = finished
;; ;; 9.817615s real time, 10.212286s run time. 1.519580s spent in GC.
;; scheme@(guile-user)> ,time (time-once-1)
;; $38 = finished
;; ;; 9.823060s real time, 10.213059s run time. 1.456141s spent in GC.
;; scheme@(guile-user)> ,time (time-once-2)
;; $39 = finished
;; ;; 10.821426s real time, 11.220550s run time. 1.694752s spent in GC.
;; scheme@(guile-user)> ,time (time-once-2)
;; $40 = finished
;; ;; 10.974992s real time, 11.321160s run time. 1.719529s spent in GC.
;; scheme@(guile-user)> ,time (time-once-2)
;; $41 = finished
;; ;; 10.995621s real time, 11.371717s run time. 1.762033s spent in GC.
;; scheme@(guile-user)> ,time (time-once-3)
;; $42 = finished
;; ;; 8.622643s real time, 9.056384s run time. 1.594864s spent in GC.
;; scheme@(guile-user)> ,time (time-once-3)
;; $43 = finished
;; ;; 8.659645s real time, 9.094310s run time. 1.608153s spent in GC.
;; scheme@(guile-user)> ,time (time-once-3)
;; $44 = finished
;; ;; 8.632404s real time, 9.056888s run time. 1.584955s spent in GC.
;; scheme@(guile-user)>
;;; So the fastest (by two seconds over one less than a million calculations is
;;; (count-change-final-alt2), which combines terms into div, div2, div3, and
;;; div4 before into terms that may be zero.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment