guile-project-euler-solutions/033/solution.scm

;; https://projecteuler.net/problem=33


;; Digit cancelling fractions
;; Problem 33

;; The fraction 49/98 is a curious fraction, as an
;; inexperienced mathematician in attempting to simplify it
;; may incorrectly believe that 49/98 = 4/8, which is
;; correct, is obtained by cancelling the 9s.

;; We shall consider fractions like, 30/50 = 3/5, to be
;; trivial examples.

;; There are exactly four non-trivial examples of this type
;; of fraction, less than one in value, and containing two
;; digits in the numerator and denominator.

;; If the product of these four fractions is given in its
;; lowest common terms, find the value of the denominator.


(import
 (except (rnrs base) let-values map)
 (only (guile)
       lambda* λ)
 (ice-9 match)
 ;; (srfi srfi-69)  ; hash tables
 (srfi srfi-1)  ; reduce
 (contract)
 (lib math)
 (lib print-utils))


(define-with-contract make-fraction
  (require (integer? numer)
           (integer? denom)
           (not (zero? denom)))
  (ensure (pair? <?>))
  (λ (numer denom)
    (cons numer denom)))


(define fraction-numer
  (λ (frac)
    (car frac)))


(define fraction-denom
  (λ (frac)
    (cdr frac)))


(define fraction?
  (λ (frac)
    (pair? frac)))


(define-with-contract fraction-reduce
  (require (fraction? frac))
  (ensure (fraction? frac))
  (λ (frac)
    (let ([reduced-fraction
           (/ (fraction-numer frac)
              (fraction-denom frac))])
      (make-fraction (numerator reduced-fraction)
                     (denominator reduced-fraction)))))


(define-with-contract common-digit-in-terms
  (require (fraction? frac))
  (ensure (or (integer? <?>)
              (boolean? <?>)))
  (λ (frac)
    "Get the first common digit of the numerator and denominator
of a fraction."
    (let ([numer-digits (digits (fraction-numer frac))]
          [denom (fraction-denom frac)])
      (let iter ([digits° numer-digits])
        (cond
         [(null? digits°) #f]
         [(contains-digit? denom (car digits°)) (car digits°)]
         [else (iter (drop digits° 1))]))
      ;; any
      #;(reduce (λ (cur acc)
                (or acc cur))
              #f
              ;; check if contains digits
              (map (λ (digit)
                     (contains-digit? denom digit))
                   numer-digits)))))


(define trivial?
  (λ (frac)
    (or
     (and (divides? 10 (fraction-numer frac))
          (divides? 10 (fraction-denom frac)))
     (= (fraction-numer frac)
        (fraction-denom frac)))))


(define cancelling-fractions
  (let iter ([numer 10] [denom 10] [found-fractions '()])
    (cond
     [(> denom 99)
      found-fractions]
     [(> numer denom)  ; avoid duplicates
      (iter 10 (+ denom 1) found-fractions)]
     [(> numer 99)
      (iter 10 (+ denom 1) found-fractions)]
     [(not (trivial? (make-fraction numer denom)))
      (let ([common-digit
             (common-digit-in-terms (make-fraction numer denom))])
        #;(print numer "and" denom
               "have the following digit in common:"
               common-digit)
        (cond
         [common-digit
          (cond
           [(zero? (remove-digit denom common-digit))
            (iter 10 (+ denom 1) found-fractions)]
           [else
            (let ([wrongly-simplified-fraction
                 (make-fraction
                  (remove-digit numer common-digit)
                  (remove-digit denom common-digit))])
            (cond
             [(= (/ numer denom)
                 (/ (remove-digit numer common-digit)
                    (remove-digit denom common-digit)))
              (iter (+ numer 1)
                    denom
                    (cons (make-fraction numer denom)
                          found-fractions))]
             [else
              (iter (+ numer 1)
                    denom
                    found-fractions)]))])]
         [else
          (iter (+ numer 1)
                denom
                found-fractions)]))]
     [else
      (iter (+ numer 1)
            denom
            found-fractions)])))


(print cancelling-fractions)


(print
 (let ([frac
        (reduce (λ (frac acc)
                  (make-fraction (* (fraction-numer frac)
                                    (fraction-numer acc))
                                 (* (fraction-denom frac)
                                    (fraction-denom acc))))
                1
                cancelling-fractions)])
   (/ (fraction-numer frac)
      (fraction-denom frac))))