guile-project-euler-solutions/lib/math.scm

(library (lib math)
  (export even?
          odd?
          sum
          sum-up-to
          range-sum
          square
          factorial
          factorial-linear
          digits
          digit?
          contains-digit?
          remove-digit
          count-digits
          digits-sum
          digits-unique?
          digits->real
          integer->digits
          digits->integer
          +decimal-digits+
          divides?
          factors
          fib
          int/
          integer-divide-arbitrary-precision
          rational-repeating-decimals-length
          natural-number?)

  (import
   (except (rnrs base) let-values map odd? even?)
   (only (guile)
         lambda* λ
         map
         ;; math stuff
         remainder
         inexact->exact
         display
         simple-format
         string-join
         string-append
         null?
         memv)
   (only (srfi srfi-1) reduce)
   (srfi srfi-69)  ; hash tables
   (srfi srfi-1)  ; remove
   (lib list-helpers)
   (contract)
   (lib print-utils))

  (define inc
    (λ (num)
      (+ num 1)))

  (define sum
    (λ (nums)
      "Sum all numbers in the given list nums."
      (reduce + 0 nums)))


  (define sum-up-to
    (λ (n)
      "Sums up integers from including 1 to including the given
number n."
      (/ (* n (+ n 1))
         2)))


  (define range-sum
    (λ (start end)
      "Calculate the sum of all integers from including start to
including end."
      (+ (- (sum-up-to end)
            (sum-up-to start))
         start)))


  (define even?
    (λ (num)
      "Check, if a number is even."
      (= (remainder num 2) 0)))


  (define odd?
    (λ (num)
      "Check, if a number is odd."
      (= (remainder num 2) 1)))


  (define square
    (λ (num)
      "Calculate the square of a number."
      (* num num)))


  (define factorial
    (λ (num)
      "Calculate the factorial of a number using a linear recursive
process."
      (if (= num 1)
          1
          (* num
             (factorial (- num 1))))))


  (define factorial-linear
    (λ (num)
      "Calculate the factorial of a number using a linear iterative
process."
      (let iter ([current-num 1]
                 [product 1])
        (cond
         [(> current-num num) product]
         [else
          (iter (+ current-num 1)
                (* product current-num))]))))


  (define char->number
    (λ (char)
      (string->number
       (list->string
        (list char)))))


  (define digits
    (λ (num)
      "Get the digits of a number."
      (map char->number
           (string->list (number->string num)))))


  (define integer->digits digits)


  (define digit?
    (λ (num)
      (and (natural-number? num)
           (< num 10))))


  (define contains-digit?
    (λ (num digit)
      "Check whether the number contains the digit."
      ;; `memv` returns a list, if the item is in the list
      ;; and #f otherwise.
      (pair?
       (memv digit (digits num)))))


  (define-with-contract remove-digit
    (require (integer? num)
             (digit? digit))
    (ensure (integer? <?>))
    (λ (num digit)
      (digits->integer
       (let iter ([digits° (digits num)])
         (cond
          [(null? digits°) '()]
          [(= (first digits°) digit)
           (drop digits° 1)]
          [else
           (cons (first digits°)
                 (iter (drop digits° 1)))])))))


  (define-with-contract count-digits
    (require (integer? num))
    (ensure (integer? <?>) (positive? <?>))
    (λ (num)
      "Get the number of digits in an integer number."
      (string-length (number->string num))))


  (define digits-sum
    (λ (num)
      "Calculate the sum of the digits of a number."
      (sum (digits num))))


  (define divides?
    (λ (a b)
      "Check, whether the given number a divides the given number b."
      (= (remainder b a) 0)))


  (define factors
    (lambda* (num #:key (trivial-factors #f))
      "Calculate the list of all factors of the given number num."
      (let ([limit (inexact->exact (floor (/ num 2)))]
            [start 2])
        (let iter ([potential-factor start]
                   [factors-lst (if trivial-factors '(1) '())])
          (cond
           [(> potential-factor limit)
            (if trivial-factors
                (cons num factors-lst)
                factors-lst)]
           [(divides? potential-factor num)
            (iter (+ potential-factor 1)
                  (cons potential-factor factors-lst))]
           [else
            (iter (+ potential-factor 1)
                  factors-lst)])))))


  (define digits-unique?
    (λ (num)
      (unique-items? (digits num))))


  (define +decimal-digits+
    '(0 1 2 3 4 5 6 7 8 9))


  (define-with-contract fib
    (require (positive? n) (integer? n))
    (ensure (positive? <?>) (integer? <?>))
    (λ (n)
      (let iter ([prev-prev-fib 0] [prev-fib 1] [counter 1])
        (cond
         [(= counter n)
          prev-fib]
         [else
          (iter prev-fib (+ prev-prev-fib prev-fib) (+ counter 1))]))))


  (define int/
    (λ (numer denom)
      "Perform a whole integer division of a/b."
      (/ (- numer (remainder numer denom))
         denom)))


  (define-with-contract digits->real
    (require (list? digits)
             (not (null? digits))
             (integer? (car digits)))
    (ensure (real? <?>))
    (λ (digits)
      (string->number
       (string-append (number->string (car digits))
                      "."
                      (string-join (map number->string (cdr digits)) "")))))


  (define-with-contract digits->integer
    (require (list? digits)
             (not (null? digits))
             (integer? (car digits)))
    (ensure (integer? <?>))
    (λ (digits)
      (string->number
       (string-join (map number->string digits)
                    ""))))


  (define-with-contract integer-divide-arbitrary-precision
    (require (integer? numer)
             (integer? denom)
             (not (zero? denom)))
    (ensure (list? <?>))
    (lambda* (numer denom #:key (precision 16))
      (let iter ([numer numer]
                 [numer-digits° (cdr (digits numer))]
                 [counter 0])
        (let ([rem (remainder numer denom)]
              [factor (int/ numer denom)]
              [next-numer-part
               (if (null? numer-digits°)
                   0
                   (car numer-digits°))]
              [next-numer-digits
               (if (null? numer-digits°)
                   '()
                   (cdr numer-digits°))])
          ;; (print denom "fits into" numer factor "times." "remainder" rem)
          (cond
           [(> counter precision) '()]
           [(= rem 0) (list factor)]
           [else
            (cons factor
                  (iter (+ (* rem 10) next-numer-part)
                        next-numer-digits
                        (+ counter 1)))])))))

  ;; EXAMPLE:
  ;; 1 : 17 = 0.05...
  ;; 0
  ;; -v
  ;; 10
  ;;  0
  ;; --v
  ;; 100
  ;;  85
  ;; ---v
  ;;  150
  (define-with-contract rational-repeating-decimals-length
    (require (rational? fraction)
             (= (numerator fraction) 1)
             (not (zero? (denominator fraction))))
    (ensure (integer? <?>)
            (or (positive? <?>)
                (zero? <?>)))
    (λ (fraction)
      (print "fraction:" fraction "=" "...")
      (let ([denom (denominator fraction)])
        (let iter ([numer (numerator fraction)]
                   ;; Create a hash table storing how many digits ago
                   ;; a pair of factor and remainder was seen.
                   [seen-table (make-hash-table equal?)])
          (let ([rem (remainder numer denom)]
                [factor (int/ numer denom)])
            (print numer "/" denom "=" factor "R" rem)
            (cond
             ;; If the remainder ever becomes 0, then the digits end
             ;; there. There is no infinitely repeating digit
             ;; sequence.
             [(= rem 0) 0]
             ;; If the remainder has already been seen, then we know
             ;; the digits will repeat.
             [(hash-table-exists? seen-table rem)
              ;; The remainder has already been seen, but how many
              ;; digits ago was it? Look it up in the hash table.
              (hash-table-ref seen-table rem)]
             ;; If the remainder has not yet been seen, mark it as
             ;; seen, and increase the distance of all previously seen
             ;; factor-remainder pairs by 1.
             [else
              ;; (display (simple-format #f "seen remainder: ~a\n" rem))
              (hash-table-set! seen-table rem 0)
              (hash-table-walk seen-table
                               (λ (key val)
                                 ;; (print "increasing distance for:" key)
                                 (hash-table-update! seen-table key inc)))
              ;; Iterate. Times 10 for the next position in the
              ;; decimals.
              (iter (* rem 10) seen-table)]))))))


  (define natural-number?
    (λ (num)
      (and (integer? num)
           (or (zero? num)
               (positive? num))))))