Project Euler(with Scheme) Problem 47〜49(44はまだ解けてない・・・)

ひっさびさの更新。

計算時間がかかりすぎて手こずる。高速化、楽しい〜〜〜！！！

Problem 47

(define (warikiru n m)
  (if (> (modulo n m) 0) n
      (warikiru (quotient n m) m)))

;素因数が5個以上あったら'()を返す
(define (make-yakusu n)
  (define (sub i num list)
    (cond ((= num 1) list)
          ((> (length list) 4) '())
          ((= 0 (modulo num i)) (sub (+ i 1) (warikiru num i) (cons i list)))
          (#t (sub (+ i 1) num list))))
  (sub 2 n '()))

;素因数が5個以上あったら'()を返す、ふるいver
(define (get-yakusu n sosulist)
  (define (sub anslist sosus)
    (cond ((null? sosus) anslist)
          ((> (length anslist) 4) '())
          ((= 0 (modulo n (car sosus))) (sub (cons (car sosus) anslist) (cdr sosus)))
          (#t (sub anslist (cdr sosus)))))
  (sub '() sosulist))

(define (remove sosu list)
  (cond ((null? list) list)
        ((= 0 (modulo (car list) sosu)) (remove sosu (cdr list)))
        (#t (cons (car list) (remove sosu (cdr list))))))

(define (make-erat list)
  (if (null? list) list
      (cons (car list) (make-erat (remove (car list) list)))))
(define (genelist n)
  (define (sub i)
    (if (> i n) '()
        (cons i (sub (+ i 1)))))
  (sub 2))

(define (make-furui n) (make-erat (genelist n)))

(define (answer start erat-start)
  (define (sub minind l1 l2 l3 l4 eratnum erattable)
    (cond ((= (length l1) (length l2) (length l3) (length l4) 4) minind)
          ((> (+ minind 5) (* 30 eratnum)) (sub (+ minind 1) l2 l3 l4 (get-yakusu (+ minind 4) erattable) (* eratnum 2) (make-furui (* eratnum 2))))
          (#t (sub (+ minind 1) l2 l3 l4 (get-yakusu (+ minind 4) erattable) eratnum erattable))))
  (sub start (make-yakusu start) (make-yakusu (+ start 1)) (make-yakusu (+ start 2)) (make-yakusu (+ start 3)) erat-start (make-furui erat-start)))

(display (answer 1 10))
(newline)

素因数分解の高速化のためにエラトステネスのふるいを書いたり、そのふるいを最初から大きく持つのではなく必要に応じて大きくしていくなどして、最終的に数秒で答えの出るコードにできた。
楽しい！このコードにたどりつくまで2時間くらいかかった。

Problem 48

(define (ruijo-10cut n m)
  (define (sub count ans)
    (if (= count 0) ans
        (sub (- count 1) (modulo (* ans n) 10000000000))))
  (sub m 1))

(define (under10 n) (ruijo-10cut n n))

(define (solve max)
  (define (sub i ans)
    (if (> i max) (modulo ans 10000000000)
        (sub (+ i 1) (+ ans (under10 i)))))
  (sub 1 0))

(display (solve 1000))
(newline)

でかい数系はScheme得意。
これは随所で桁カットしていけばいいから、Schemeに限らず解けるか。

Problem 49

(define (gene start end)
  (if (> start end) '()
      (cons start (gene (+ start 1) end))))

(define (remove-ns n list)
  (if (null? list) list
      (if (= 0 (modulo (car list) n)) (remove-ns n (cdr list))
          (cons (car list) (remove-ns n (cdr list))))))

(define (erat list)
  (if (null? list) list
      (cons (car list) (erat (remove-ns (car list) (cdr list))))))

(define (low-cut line list)
  (if (<= line (car list)) list
      (low-cut line (cdr list))))

;(low-cut 1000 (erat (gene 2 10000)))で4桁の素数のリスト

;置換ってのが面倒だけど、まぁ各桁の和が合ってりゃだいたいOKじゃね
;→全然そうじゃなかった、反省
(define (ketawa n)
  (if (= n 0) 0
      (+ (modulo n 10) (ketawa (quotient n 10)))))

(define (insert a sortedlist)
  (cond ((null? sortedlist) (cons a sortedlist))
        ((<= a (car sortedlist)) (cons a sortedlist))
        (#t (cons (car sortedlist) (insert a (cdr sortedlist))))))
(define (insert-sort list)
  (define (sub lista listb)
    (if (null? lista) listb
        (sub (cdr lista) (insert (car lista) listb))))
  (sub list '()))
(define (num4tolist n)
  (define (sub count num)
    (if (= count 0) '()
        (cons (modulo num 10) (sub (- count 1) (quotient num 10)))))
  (insert-sort (sub 4 n)))
(define (list=? lista listb)
  (cond ((and (null? lista) (null? listb)) #t)
        ((= (car lista) (car listb)) (list=? (cdr lista) (cdr listb)))
        (#t #f)))
(define (num4=? a b) (list=? (num4tolist a) (num4tolist b)))

(define (search-and-display first second list)
;  (begin (display "chance!!") (newline)
  (cond ((null? list) #f)
        ((and (= (car list) (+ second (- second first))) (num4=? first (car list)))
         (begin
           (display (+ (* first 100000000) (* second 10000) (car list)))
           (newline)
           #f))
        (#t (search-and-display first second (cdr list)))))

(define (get-first-second n list)
  (cond ((null? list) #f)
        ((num4=? n (car list)) (search-and-display n (car list) (cdr list)))
        (#t (get-first-second n (cdr list)))))

(define (solve sosu-list)
  (if (null? sosu-list) "Finish!!!"
      (or (get-first-second (car sosu-list) (cdr sosu-list)) (solve (cdr sosu-list)))))

今回は例を含むと答えが2つあるので、"答えが出ても探索を最後までやめない"ように書いた。
#t、#fで制御しながら、beginも使い、上手く書けたのでは！？
そして、無事正答。
ただ、出てくるハズだった例のパターンがなぜか出てこない。1パターンしか答えが出ない。
なぜだ・・・

次はいよいよProblem 50。いやそのまえにProblem 44やらな・・・いやでもめんどうやな・・・解けんのおもしろくないし・・・