Project Euler(with Scheme) Problem 12〜15

さて、やっかいなProblem 11が終わったのでグイグイやっていきます。
ほんまに11が鬼門でした。
今回は12〜15。

Problem 12

(define (devide-count n)
  (define (sub i)
    (cond ((> (* i i) n) 0)
          ((= (* i i) n) 1)
          (#t (+ (sub (+ i 1)) (if (= (modulo n i) 0) 2 0)))))
  (sub 1))

(define (solve n i)
  (if (> (devide-count n) 500) n
      (solve (+ n i) (+ i 1))))

(display (solve 1 2))

(devide-count n)は我ながらすっきりな書き方な気がする。

Problem 13

(define (keta n)
  (if (= n 0) 0
      (+ 1 (keta (quotient n 10)))))
(define (power n m)
  (if (= m 0) 1
      (* n (power n (- m 1)))))
(define (top10 n)
  (quotient n (power 10 (- (keta n) 10))))
;(display (top10 1234567890123))

(define (input-answer n)
  (define (sub count sum)
    (if (= count n) sum
        (let* ((num (read)))
          (sub (+ count 1) (+ sum num)))))
  (top10 (sub 0 0)))

(display (input-answer 100))
(newline)

巨大な数には強いぜScheme。
他の言語だと151個(あれば十分か)の配列を整数に見立てて足し算を実装するのかしら。

Problem 14

(define (collatz n)
  (define (sub now count)
    (if (= now 1) count
        (sub (if (= 0 (modulo now 2)) (quotient now 2) (+ (* now 3) 1)) (+ count 1))))
  (sub n 0))
(define (ans n)
  (define (sub now maxnum maxind)
    (if (= now 0) maxind
        (let* ((nowcoll (collatz now))
               (nextind (- now 1)))
          (if (> nowcoll maxnum)
              (sub nextind nowcoll now)
              (sub nextind maxnum maxind)))))
  (sub n 0 -1))

(display (ans 1000000))
(newline)

単純に計算。
メモ化するにも100万個のメモ可はしんどいよね？
高速化できるのだろうか。

Problem 15

(define (fact n)
  (if (= n 0) 1
      (* n (fact (- n 1)))))

(display (quotient (fact 40) (* (fact 20) (fact 20))))
(newline)

巨大な数には強いぜScheme(2回目)。
通常の言語だと、longで、経路の交点に数字振って上と左の隣接を足し上げていく形かな？

一旦以上です。
楽しい〜