working on it ...

Filters

snippets
556
followers
4
Published by snip2code

Scheme

This channel collects useful snippets for Scheme language
Sort by

Found 557 snippets

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

    Loop 4 times with condition

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

    external by Michael Campagnaro modified 4 hours ago  1  0  1  0

    macro system

    macro system: gistfile1.scm
    ;; outlet code for implementing traditional macro expansion
    
    ;; macros
    
    (define (expand form)
      (cond
       ((variable? form) form)
       ((literal? form) form)
       ((macro? (car form))
        (expand ((macro-function (car form)) form)))
       ((eq? (car form) 'quote)
        form)
       ((eq? (car form) 'lambda)
        `(lambda ,(car (cdr form))
           ,@(map expand (cdr (cdr form)))))   
       (else (map expand form))))
    
    (define _macros_ {})
    
    (define (macro-function name)
      (ref _macros_ (symbol->string name)))
    
    (define (install-macro name func)
      (put! _macros_ (symbol->string name) func))
    
    (define (macro? name)
      (not (eq? (ref _macros_ (symbol->string name))
                undefined)))
    
    ;; compiler
    
    (define (read src)
      (vector-to-list
       (reader grammar src '[begin])))
    
    (install-macro 'define (lambda (form)
                             `(define* ,(car (cdr form))
                                ,@(cdr (cdr form)))))
    
    (let ((src (fs.readFileSync "example.ol" "utf-8")))
      (pretty (expand (read src))))
    
    ;; (define (foo x y z)
    ;;   (+ x y z))
    ;;
    ;; expand to:
    ;;
    ;; (define* (foo x y z)
    ;;   (+ x y z))
    
    
    

    external by Joeb3219 modified yesterday at 8:47:43 PM  1  0  1  0

    For Rutgers Pring Prog S2017

    For Rutgers Pring Prog S2017: dictionary-check.ss
    (define allValid?
      (lambda (check dict)
        (reduce
         (lambda (a b)
           (if (equal? a b)
               a
               #f
           )
         )
         (map check dict)
         #t
        )
      )
    )
    
    

    external by vbuaraujo modified Apr 15, 2017  1  0  1  0

    Extended 'if' syntax, allowing 'else' and 'elif' clauses

    Extended 'if' syntax, allowing 'else' and 'elif' clauses: extended-if.scm
    (define-module (elmord extended-if)
      #:export (if*))
    
    (define-syntax if*
      (syntax-rules (else elif)
        ;; Subsume the standard 'if'.
        [(if* condition form1) (if condition form1)]
        [(if* condition form1 form2) (if condition form1 form2)]
        ;; If more forms present, use extra syntax.
        [(if* condition forms ...)
         (if/sub condition () forms ...)]))
    
    (define-syntax if/sub
      (syntax-rules (else elif)
        [(if/sub condition (then-forms ...) else else-forms ...)
         (if condition (begin then-forms ...) (begin else-forms ...))]
        [(if/sub condition1 (then-forms ...) elif condition2 rest ...)
         (if condition1
             (begin then-forms ...)
           (if/sub condition2 () rest ...))]
        [(if/sub condition (then-forms ...) then-form rest ...)
         (if/sub condition (then-forms ... then-form) rest ...)]))
    
    ;;; Example.
    
    (define (signum x)
      (if* (> x 0)
          (display "positive\n")
          +1
       elif (< x 0)
          (display "negative\n")
          -1
       else
          (display "zero\n")
          0))
    
    (signum 42)
    (signum 0)
    (signum -42)
    
    
    

    external by Oleg modified Apr 13, 2017  1  0  1  0

    A batch for the gimp editor that makes scanned image perfect for me

    A batch for the gimp editor that makes scanned image perfect for me: perfectize.scm
    # ~/.gimp-2.8/scripts/perfectize.scm  
    # usage: gimp -i -b '(batch-perfectize "*.jpg")' -b '(gimp-quit 0)'
    
      (define (batch-perfectize pattern)
      (let* ((filelist (cadr (file-glob pattern 1))))
        (while (not (null? filelist))
               (let* ((filename (car filelist))
                      (image (car (gimp-file-load RUN-NONINTERACTIVE
                                                  filename filename)))
                      (drawable (car (gimp-image-get-active-layer image))))
                 (gimp-levels drawable 0 100 230 1.00 0 255)
                 (gimp-file-save RUN-NONINTERACTIVE
                                 image drawable filename filename)
                 (gimp-image-delete image))
               (set! filelist (cdr filelist)))))
    
    

    external by Edwin Watkeys modified Mar 30, 2017  2  0  1  0

    Extending Chibi Scheme's SHOW: This works, but is it correct?

    Extending Chibi Scheme's SHOW: This works, but is it correct?: extend-show.scm
    (define (range n)
      (λ (env)
         (for-each (λ (i) ((displayed i) env))
                   (iota n))
         env))
    
    (show #f ">>>" (range 10) "<<<" nl) ; => ">>>0123456789<<<\n"
    
    

    external by Roberto Desideri modified Mar 30, 2017  2  0  1  0

    Gimp Script Fu build-miniature - Scales image and resize the canvas to build a miniature without bg color

    Gimp Script Fu build-miniature - Scales image and resize the canvas to build a miniature without bg color: script-fu-build-miniature.scm
    (define (build-miniature image drawable size)
    (let*
    (
    (width (car (gimp-image-width image)))
    (height (car (gimp-image-height image)))
    (my_layer (car (gimp-layer-new image size size RGBA-IMAGE "tmp" 0 NORMAL)))
    )
    (if (> width height)
    (gimp-image-scale image size (* height (/ size width)))
    (gimp-image-scale image (* width (/ size height)) size)
    )
    (gimp-image-resize image size size
    (/ (- size (car (gimp-image-width image))) 2)
    (/ (- size (car (gimp-image-height image))) 2)
    )
    (gimp-image-add-layer image my_layer 0)
    (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)
    )
    )
    (script-fu-register "build-miniature"
    "Build Miniature"
    "Scales image and resize the canvas to build a miniature without bg color"
    "Roberto Desideri"
    "robdesideri.it"
    "April 2017"
    "RGB* GRAY*"
    SF-IMAGE "Image" 0
    SF-DRAWABLE "Drawable" 0
    SF-VALUE "Miniature Size" "32"
    ) 
    (script-fu-menu-register "build-miniature"
                             "<Image>/Image")
    
    

    external by ceving modified Mar 21, 2017  2  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 Mar 21, 2017  2  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  2  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.
    
    
    
    • Public Snippets
    • Channels Snippets