Project Euler(with Scheme) Problem 71〜75

「パッと解けないのは飛ばしていいや」と考えはじめたら、無敵になった。もちろん、よくない意味の無敵です。

Problem 71

(define (search-3-7 n);nが分母ね、ほんで3/7以下で一番3/7に近くなるときの分子を返すよ
  (define (sub left right center); left/7 < 3/7 < right/7と挟むイメージ、3/7に出来るnは入力ではじく
    (let ((center-value (/ center n)))
      (cond ((= (+ left 1) right) left)
            ((< center-value (/ 3 7)) (sub center right (quotient (+ center right) 2)))
            (#t (sub left center (quotient (+ center left) 2))))))
  (cond ((<= n 2) 0)
        ((= 0 (modulo n 7)) (- (* 3 (quotient n 7)) 1))
        (#t (sub 1 n (quotient (+ n 1) 2)))))

(define (solve bunbo-limit)
  (define (sub now-nearest now-index)
    (if (< bunbo-limit now-index) now-nearest
        (let ((now-bunsu (/ (search-3-7 now-index) now-index)))
          (sub (if (< now-nearest now-bunsu) now-bunsu now-nearest) (+ now-index 1)))))
  (sub 0 1))

;(display (numerator (solve 8)))
(display (numerator (solve 1000000)))

二分探索ですぱっと。

あと、今回作った関数を使うと、3/7の小数点以下が結構な桁数でも一瞬で出せることに気付いた。二分探索ってすごい。

> (search-3-7 1000000000000000000000000000000000000000)
428571428571428571428571428571428571428

Problem 72

これもProblem 69,70を解くときに一緒に解けるかと。
トーティエント関数の値を一発で出す方法を模索中。頑張る。

Problem 73

(define (search-over-1-3 n);nが分母ね、ほんで1/3以上で一番1/3に近くなるときの分子を返すよ
  (define (sub left right center); left/3 < 1/3 < right/3と挟むイメージ、1/3ちょうどに出来るnは入力ではじく
    (let ((center-value (/ center n)))
      (cond ((= (+ left 1) right) right)
            ((< center-value (/ 1 3)) (sub center right (quotient (+ center right) 2)))
            (#t (sub left center (quotient (+ center left) 2))))))
  (cond ((= n 2) 1)
        ((= 0 (modulo n 3)) (quotient n 3))
        (#t (sub 1 n (quotient (+ n 1) 2)))))

(define (search-under-1-2 n);nが分母ね、ほんで1/2以下で一番1/2に近くなるときの分子を返すよ
  (define (sub left right center); left/2 < 1/2 < right/2と挟むイメージ、1/2ちょうどに出来るnは入力ではじく
    (let ((center-value (/ center n)))
      (cond ((= (+ left 1) right) left)
            ((< center-value (/ 1 2)) (sub center right (quotient (+ center right) 2)))
            (#t (sub left center (quotient (+ center left) 2))))))
  (cond ((= n 2) 1)
        ((= 0 (modulo n 2)) (quotient n 2))
        (#t (sub 1 n (quotient (+ n 1) 2)))))

(define (get-kiyaku-count bunbo)
  (define (sub start end count)
    (if (> start end) count
        (sub (+ start 1) end (+ count (if (and (= 1 (gcd start bunbo)) (< (/ 1 3) (/ start bunbo) (/ 1 2))) 1 0)))))
  (sub (search-over-1-3 bunbo) (search-under-1-2 bunbo) 0))

(define (solve end-bunbo)
  (define (sub nowbunbo ans)
    (if (> nowbunbo end-bunbo) ans
        (sub (+ nowbunbo 1) (+ ans (get-kiyaku-count nowbunbo)))))
  (sub 2 0))

二分探索。内側の関数subで処理をしているので、 (search-over-1-3 n)をコピペしてちょっといじるだけですぐ(search-under-1-2 n)が作れた。
こういうの意識して自分用の関数を作っていくといいんだろうなぁ。

Problem 74

(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1)))))
(define (nextnum n)
  (define (sub num sum)
    (if (= num 0) sum
        (sub (quotient num 10) (+ sum (fact (modulo num 10))))))
  (sub n 0))

(define (loop-length start)
  (define (list-in? ele list)
    (cond ((null? list) #f)
          ((= ele (car list)) #t)
          (#t (list-in? ele (cdr list)))))
  (define (sub nownum checkedlist)
    (if (list-in? nownum checkedlist) (length checkedlist)
        (sub (nextnum nownum) (cons nownum checkedlist))))
  (sub start '()))

;solveやと1,000,000未満の数を調べるのに7分くらいかかった(402)
(define (solve limit)
  (define (sub nowstart count)
    (if (>= nowstart limit) count
        (sub (+ nowstart 1) (+ count (if (= 60 (loop-length nowstart)) 1 0)))))
  (sub 1 0))

(define memo-vec (make-vector (+ 1 (max 1000000 (* 6 (fact 9)))) 100))

(define (loop-length2 start)
  (define (list-in? ele list)
    (cond ((null? list) #f)
          ((= ele (car list)) #t)
          (#t (list-in? ele (cdr list)))))
  (define (sub nownum checkedlist)
    (let ((memo-value (vector-ref memo-vec nownum)))
      (cond ((< memo-value 100) (+ memo-value (length checkedlist)))
            ((list-in? nownum checkedlist) (length checkedlist))
            (#t (sub (nextnum nownum) (cons nownum checkedlist))))))
  (sub start '()))

;solve2だと15秒くらい
(define (solve2 limit)
  (define (sub nowstart count)
    (if (>= nowstart limit) count
        (let ((now-length (loop-length2 nowstart)))
          (begin (vector-set! memo-vec nowstart now-length)
                 (sub (+ nowstart 1) (+ count (if (= now-length 60) 1 0)))))))
  (sub 1 0))

全探索でもある程度現実的な時間で解けたが、せっかくなのでメモ化で高速化。

Problem 75

鋭意解き解き中