working on it ...

Filters

snippets
551
followers
4
Published by snip2code

Scheme

This channel collects useful snippets for Scheme language
Sort by

Found 551 snippets

    public by cuhardware modified Jan 6, 2016  186  0  4  0

    Loop 4 times with condition

    try=0
    while [ $try -lt 4 ]; do
    	try=$((try+1))
    done

    external by ceving modified Tuesday at 4:04:32 PM  1  0  1  0

    Permute regular patterns

    Permute regular patterns: perx.scm
    (define (constant c)
      (lambda (state)
        (map (lambda (x) (cons c x)) state)))
    
    (define (sequence first . rest)
      (if (null? rest)
          first
          (lambda (state)
            ((apply sequence rest) (first state)))))
    
    (define (alternation first second . rest)
      (lambda (state)
        (append (first state)
                (if (null? rest)
                    (second state)
                    ((apply alternation (cons second rest)) state)))))
    
    (define-syntax perx
      (syntax-rules ::: ()
        ((_ . expr)
         (letrec-syntax ((p (syntax-rules (or)
                              ((_ (or a ...)) (alternation (p a) ...))
                              ((_ (x ...))    (sequence (p x) ...))
                              ((_ x)          (constant x)))))
           (map (lambda (l) (apply string-append l))
                (map reverse ((p expr) '(()))))))))
    
    ;; (perx (or ("a" (or "b" "c") "d") "e")) => ("abd" "acd" "e")
    
    

    external by ceving modified Tuesday at 4:00:55 PM  1  0  1  0

    Debug Scheme expressions

    Debug Scheme expressions: debug.scm
    (define-syntax ?
      (syntax-rules ()
        ((_ prefix expr)
         (let ((value expr))
           (display ";;;")
           (if prefix
               (begin
                 (display " ")
                 (display prefix)))
           (display ": ")
           (write 'expr)
           (display " => ")
           (write value)
           (newline)
           expr))
        ((_ expr)
         (? #f expr))))
    
    

    external by hardenedapple modified Mar 14, 2017  1  0  1  0

    count-change constant time constant space

    count-change constant time constant space: 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.
    
    
    

    external by Yoxem modified Mar 14, 2017  1  0  1  0

    Find the approximation of pi

    Find the approximation of pi: pi.scm
    (define (pi-iter i max sum)
      (if (= i max)
         (* 4 sum)
         (let ((k (/
                                (^ (- 1) i)
                                (+ (* 2 i) 1))))
         (pi-iter (+ i 1) max (+
                               sum
                               k)))
         ))
    
    
    (define (^ x y)
        (cond ((= y 0) 1)
              ((= y 1) x)
              (else (^-iter x 1 y x)))
      )
    
    (define (^-iter x i max result)
    (if (= i max) result
       (^-iter x (+ i 1) max (* x result))
    ))
    
    (display "pi的近似值:")
    (display (pi-iter 0 50000 0))
    (newline)
    
    

    external by Ichwan Palongengi modified Mar 13, 2017  1  0  1  0

    My solution for the First Exam

    My solution for the First Exam : exam1.scm
    ; Solution to Question 2
    (define (num-of-digits num)
      (let ((remaining-digits (quotient num 10)))
        (cond ((zero? remaining-digits) 1)
              (else (+ 1 (num-of-digits remaining-digits))))))
    
    ; Solution to Question 3
    ; This procedure use num-of-digits procedure from Q2
    (define (transformation num funct)
      
      ; This nested iterative procedure does all the work
      (define (transform-digit num funct power-of-10 output)
        
        ; This helper procedure multiplies the result of applying the input function to the last-digit
        ; currently being processed with the current value of power-of-10 argument which is then
        ; added to the existing value of output
        (define (new-output last-digit)
          (+ output (* (funct last-digit) (expt 10 power-of-10))))
        
        ; Below is the body of the transform-digit procedure
        (let ((remaining-digits (quotient num 10))
              (last-digit (remainder num 10)))
          (cond ((zero? remaining-digits)
                 (new-output last-digit))
                (else(transform-digit remaining-digits funct (num-of-digits(new-output last-digit)) (new-output last-digit))))))
      (transform-digit num funct 0 0))
    
    ; Test procedures for Question 3
    (define (square n)
      (* n n))
    
    (define (cube n)
      (* n n n))
    
    

    external by LouiseBC modified Mar 6, 2017  1  0  1  0

    SICP Ex 2.2: Make-segment

    SICP Ex 2.2: Make-segment: make-segment.scm
    (define (make-point x y)(cons x y))
    (define (x-point point)(car point))
    (define (y-point point)(cdr point))
    
    (define (make-segment pointa pointb)(cons pointa pointb))
    (define (start-segment segment)(car segment))
    (define (end-segment segment)(cdr segment))
    (define (midpoint-segment segment)
      (make-point (/ (+ (x-point (start-segment segment))
                        (x-point (end-segment   segment))) 2)
                  (/ (+ (y-point (start-segment segment))
                        (y-point (end-segment   segment))) 2)))
    
    (define a (make-point 1 2))
    (define b (make-point 1 5))
    (define seg (make-segment a b))
    (display seg)
    (newline)
    (display (end-segment seg))
    (newline)
    (display (midpoint-segment seg))
    
    

    external by Ichwan Palongengi modified Mar 5, 2017  1  0  1  0

    Exercise 1.12 on SICP

    Exercise 1.12 on SICP: ex1_12.scm
    ; Exercise 1.12
    ; Write a procedure that computes elements of Pascal's Triangle by means of a recursive processes
    
    ; OBSERVATION: Pascal's Triangle is simply an arrangement of Binomial Function where nCk (n Chooses k)
    ; nCk can be calculated using the following formula: n!/k!(n-k)!
    ; where n is the row number and k is the column number
    ; In other word, we need to develop factorial procedure first
    
    (define (fact-recursive n)
      (cond ((<= 1) 1)
            (else (* n (fact-recursive (- n 1))))))
    
    (define (fact n)
      (fact-iter n 1 1))
    
    (define (fact-iter input product counter)
      (cond ((> counter input) product)
            (else (fact-iter input
                             (* product counter)
                             (+ counter 1)))))
    
    (define (pascal-triangle row column)
      (/ (fact row) (* (fact column) (fact (- row column)))))
    
    

    external by Ichwan Palongengi modified Mar 4, 2017  1  0  1  0

    Exercise 1.11 on SICP

    Exercise 1.11 on SICP: ex1_11.scm
    ; Exercise 1.11
    ; Write a procedure that computes function f (let's call it 'function') which is defined by the rule that:
    ; f(n) = n, if n < 3
    ; f(n) = f(n - 1) + 2*f(n - 2) + 3*f(n - 3), if n >=3
    
    ; The recursive procedure to calculate f(n) as described above
    (define (function-recursive n)
      (cond ((< n 3) n)
            (else (+ (function-recursive (- n 1)) (* 2 (function-recursive (- n 2))) (* 3 (function-recursive (- n 3)))))))
    
    ; The wrapper function for calculating f(n); it also deals with values of n < 3
    (define (funct n)
      (cond ((< n 3) n)
            (else (function-iter n 2 1 0))))
    
    ; The main function for calculation f(n) where n >= 3
    (define (function-iter count firstVar secondVar thirdVar)
      (cond ((< count 3) firstVar)
            (else (function-iter (- count 1) (+ firstVar (* 2 secondVar) (* 3 thirdVar)) firstVar secondVar))))
    
    

    external by Joel Gustafson modified Mar 4, 2017  1  0  1  0

    MIT Scheme JSON parser

    MIT Scheme JSON parser: json-parser.scm
    (load-option '*parser)
    
    (define (json-vector-list v)
      (vector (vector->list v)))
    
    (define json-object-pair
      (*parser
        (transform
          (lambda (v)
            (vector (cons (string->symbol (vector-ref v 0)) (vector-ref v 1))))
          (seq
            json-string 
            (noise
              (seq
                (* (char-set char-set:whitespace)) 
                ":"
                (* (char-set char-set:whitespace)))) 
            json-value))))
    
    (define json-object
      (*parser
        (transform 
          (lambda (v)
            (pp v)
            (vector (vector->list v)))
          (seq
            "{"
            (? (seq (* (seq json-object-pair ",")) json-object-pair))
            "}"))))
    
    (define json-array
      (*parser
        (transform
          json-vector-list
          (seq
            "["
            (? (seq (+ (seq json-value ",")) json-value))
            "]"))))
    
    (define json-value
      (*parser
        (seq
          (noise (* (char-set char-set:whitespace)))
          (alt 
            json-string
            json-number
            json-object
            json-array
            (transform
              (lambda (v)
                (let ((const (vector-ref v 0)))
                  (cond
                    ((string=? "true" const) #t)
                    ((string=? "false" const) #f)
                    ((string=? "null" const) '()))))
              (match (alt "true" "false" "null"))))
          (noise (* (char-set char-set:whitespace))))))
    
    (define char-set:hex
      (char-set-union
        char-set:numeric
        (string->char-set "abcdefABCDEF")))
    
    (define char-set:unicode
      (char-set-invert
        (scalar-values->char-set '((#xD800 . #xDFFF) #xFFFE #xFFFF))))
    
    (define char-set:json
      (char-set-difference
        char-set:unicode
        (string->char-set "\"\\")))
    
    (define json-string-hex-digit
      (*parser
        (transform
          json-char-map
          (match (char-set char-set:hex)))))
    
    (define (json-digit-map v)
      (integer->char (string->number (list->string (vector->list digits)) 16) 0))
    
    (define json-string-unicode 
      (*parser
        (transform
          json-digit-map
          (seq
            "u"
            json-string-hex-digit
            json-string-hex-digit
            json-string-hex-digit
            json-string-hex-digit))))
    
    (define (json-char-map v)
      (vector-map name->char v))
    
    (define (json-escape char)
      (cond
        ((char=? #\b char) #\backspace)
        ((char=? #\n char) #\newline)
        ((char=? #\f char) #\page)
        ((char=? #\t char) #\tab)
        ((char=? #\r char) #\return)
        (else char)))
    
    (define (json-escape-map v)
      (vector-map json-escape (json-char-map v)))
    
    (define json-string-char
      (*parser
        (alt
          (seq
            "\""
            (alt
              json-string-unicode
              (transform
                json-escape-map
                (match (char-set (string->char-set "bnftr/\"\\"))))))
          (transform
            json-char-map
            (match (char-set char-set:json))))))
    
    (define json-string
      (*parser
        (transform
          (lambda (v)
            (vector (list->string (vector->list v))))
          (seq "\"" (* json-string-char) "\""))))
    
    (define json-number
      (*parser
        (transform
          (lambda (v)
            (vector (string->number (list->string (vector->list (json-char-map v))))))
          (seq
            (? (match "-"))
            (alt
              "0"
              (seq
                (match (char-set (char-set-difference char-set:numeric (char-set #\0))))
                (* (match (char-set char-set:numeric)))))
            (? 
              (seq
                (match ".")
                (+ (match (char-set char-set:numeric)))))
            (?
              (seq
                (match (char-ci #\e))
                (? (match (alt "+" "-")))
                (+ (match (char-set char-set:numeric)))))))))
    
    (define (json-parse json-string)
      (json-value (string->parser-buffer json-string)))
    
    
    
    • Public Snippets
    • Channels Snippets