guile-project-euler-solutions/012.scm

;;; Highly divisible triangular number

;;; Problem 12

;;; The sequence of triangle numbers is generated by adding the
;;; natural numbers. So the 7th triangle number would be 1 + 2 + 3 + 4
;;; + 5 + 6 + 7 = 28. The first ten terms would be:

;;; 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

;;; Let us list the factors of the first seven triangle numbers:

;;;      1: 1
;;;      3: 1,3
;;;      6: 1,2,3,6
;;;     10: 1,2,5,10
;;;     15: 1,3,5,15
;;;     21: 1,3,7,21
;;;     28: 1,2,4,7,14,28

;;; We can see that 28 is the first triangle number to have over five
;;; divisors.

;;; What is the value of the first triangle number to have over five
;;; hundred divisors?


(import
 (except (rnrs base)
         let-values
         map)
 (only (guile)
       lambda* λ)
 (segment)
 #;(ice-9 match)
 (ice-9 futures))


(define divides?
  (λ (num div)
    (= (remainder num div) 0)))


;; Gaussian sum allows to efficiently calculate sums without
;; calculating the sum for the previous number. This will help with
;; big sums.
(define gaussian-sum
  (λ (n)
    "Calculate the sum from 1 to n using Gauß' sum formula."
    (/ (* n (+ n 1))
       2)))


(define calculate-triangular-number
  (λ (n)
    (gaussian-sum n)))


(define number-of-factors
  (λ (n)
    (let ([limit (floor (sqrt n))])
      (let loop ([potential-factor 1] [factors 0])
        (cond
         [(> potential-factor limit) factors]
         [else
          (if (divides? n potential-factor)
              (loop (+ potential-factor 1)
                    ;; If the number is divisable by the
                    ;; potential-factor, it means that there is a
                    ;; second factor, with which multiplied, the
                    ;; potential-factor will result in the
                    ;; number. This second factor must be greater than
                    ;; the square root of the number. The existence of
                    ;; the second factor greater than the square root
                    ;; allows us to add 2 to the number of factors,
                    ;; without actually looking at the second factor
                    ;; and stopping to check for more factors at a
                    ;; potential-factor greater than the square
                    ;; root. Without this optimization, the
                    ;; calculation needs too much time.
                    (+ factors 2))
              (loop (+ potential-factor 1)
                    factors))])))))


(define sufficient-factors?
  (λ (n target-num-factors)
    (let ([factors-count (number-of-factors n)])
      ;; (display (simple-format #f "~a has ~a factors\n" n factors-count))
      (> factors-count target-num-factors))))


(define next
  (λ (n)
    (+ n 1)))


(define find-triangular-number
  (lambda* (num-factors #:key (limit #f) (num-procs 8))
    "Find the smallest triangular number, which has more than
NUM-FACTORS factors."

    (define find-from-to
      (lambda* (nth limit #:key (default +inf.0))
        "Find the smallest triangular number, which has more than
NUM-FACTORS factors, within the specified range of NTH and LIMIT."
        ;; (when (= (remainder nth 1000) 0)
        ;;   (display (simple-format #f "nth: ~a\n" nth)))
        (let ([triangular-number (calculate-triangular-number nth)])
          (cond
           ;; Return the given default value, if within the specified
           ;; range, no triangular number with sufficient factors can
           ;; be found.
           [(> nth limit) default]
           ;; If a triangular number with sufficient factors is found,
           ;; return that and do not recur.
           [(sufficient-factors? (calculate-triangular-number nth)
                                 num-factors)
            triangular-number]
           ;; Otherwise continue with the next triangular number.
           [else
            (find-from-to (next nth) limit)]))))

    (cond
     [limit
      (display (simple-format #f "limit specified, running in parallel\n"))
      (let ([segments (segment 1 limit num-procs)])
        (let ([futures
               (map (λ (seg)
                      (make-future
                       (λ ()
                         (display (simple-format #f "segment ~a starting\n" seg))
                         (find-from-to (segment-start seg)
                                       (segment-end seg)))))
                    segments)])
          (apply min (map touch futures))))]
     [else
      (display (simple-format #f "no limit given, running sequentially\n"))
      (find-from-to 1 +inf.0)])))


(display
 (simple-format
  #f "~a\n"
  (find-triangular-number 500
                          #:limit (* 2 (expt 10 5))
                          #:num-procs 12)))