Project Euler(with Scheme) Problem 50〜53(44は...俺は...)

続けています。
やる気が出ている間は1日1問ペースで解いていきたいところ。
なんとか脳フル回転で解いていきたい。

Problem 50

(define (sosu? n)
  (define (sub i)
    (cond ((> (* i i) n) #t)
          ((= 0 (modulo n i)) #f)
          (#t (sub (+ i 1)))))
  (sub 2))
        
(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))))

(define (erat-list n) ;n以下の素数のリスト
  (erat (gene 2 n)))

(define (erat-vec n)
  (list->vector (erat-list n)))

(define (sum-head-n n vec);vectorの先頭n個の和を取る
  (define (sub i sum)
    (if (>= i n) sum
        (sub (+ i 1) (+ sum (vector-ref vec i)))))
  (sub 0 0))

(define (sosu-n-sum-search n size vec)
  (define (sub i nowsum)
    (cond ((and (sosu? nowsum) (< nowsum 1000000)) nowsum)
          ((>= (+ i n) size) 0)
          (#t (sub (+ i 1) (+ (- nowsum (vector-ref vec i)) (vector-ref vec (+ i n)))))))
  (let ((headsum (sum-head-n n vec)))
    (if (>= headsum 1000000) 0 (sub 0 headsum))));この行の高速化がデカかった

(define Sosuvec (erat-vec 100000))


(define (solve countdown)
  (if (= countdown 0) "dismiss!!"
      (let ((res (sosu-n-sum-search countdown (vector-length Sosuvec) Sosuvec)))
        (if (> res 0) (begin
                        (display countdown)
                        (newline)
                        res) (solve (- countdown 1))))))

(display (solve (vector-length Sosuvec)))

最初に「1000000未満」という条件を忘れていて、バカでかい答えがでてしまった。
素数って少ないようでなんだかんだいっぱいあるよね。

Problem 51

(define (ntol n)
  (define (numtolist num)
    (if (= num 0) '()
        (cons (modulo num 10) (numtolist (quotient num 10)))))
  (define (rev list)
    (define (sub lista listb)
      (if (null? lista) listb
          (sub (cdr lista) (cons (car lista) listb))))
    (sub list '()))
  (rev (numtolist n)))

(define (lton list)
  (define (sub ans lis)
    (if (null? lis) ans
        (sub (+ (* ans 10) (car lis)) (cdr lis))))
  (sub 0 list))

(define (replace list from to)
  (if (null? list) list
      (let ((head (car list)))
        (cons (if (= head from) to head) (replace (cdr list) from to)))))

(define (getothernumlist fromlist from)
  (define (sub now)
    (if (> now 9) '()
        (cons (lton (replace fromlist from now)) (sub (+ now 1)))))
  (sub (+ from 1)))

(define (sosu? n)
  (define (sub i)
    (cond ((> (* i i) n) #t)
          ((= 0 (modulo n i)) #f)
          (#t (sub (+ i 1)))))
  (sub 2))

(define (sosucount list)
  (if (null? list) 0
      (+ (if (sosu? (car list)) 1 0) (sosucount (cdr list)))))

(define (have? ele list)
  (if (null? list) #f
      (or (= ele (car list)) (have? ele (cdr list)))))

(define (solve start targetcount)
  (if (not (sosu? start)) (solve (+ start 1) targetcount)
      (let* ((nowlist (ntol start))
             (from0 (getothernumlist nowlist 0))
             (from1 (getothernumlist nowlist 1))
             (from2 (getothernumlist nowlist 2)))
        (cond ((and (have? 0 nowlist) (= (sosucount from0) (- targetcount 1))) (cons (lton nowlist) from0))
              ((and (have? 1 nowlist) (= (sosucount from1) (- targetcount 1))) (cons (lton nowlist) from1))
              ((and (have? 2 nowlist) (= (sosucount from2) (- targetcount 1))) (cons (lton nowlist) from2))
              (#t (solve (+ start 1) targetcount))))))

(define (sosuonly list)
  (cond ((null? list) list)
        ((sosu? (car list)) (cons (car list) (sosuonly (cdr list))))
        (#t (sosuonly (cdr list)))))

;(display (sosuonly (solve 1 7)))
;->(56003 56113 56333 56443 56663 56773 56993)

(display (sosuonly (solve 1 8)))

何に対してループ回せばいいんだとかなり悩んだ問題。何桁指定してもいいし、どの位置の桁でもいいという指定のゆるさが上手いなぁと思う。
結局、
全ての数(小さい順)に対して、「0を1,2,3,,,9に」「1を2,3,,,,9に」「2を3,4,,,9に」置き換えて素数が8個作れるかを調べればよいと分かった。
1桁に対して数は10種類あり、そこから8個の素数ができるということは、0,1,2のどれかは必ず使われるため。
また、「2を0に置き換える」などを調べなくてよいのは、今見ているより小さい数で必ず試されているハズだから。
以上。キレイに解けた！！！！

Problem 52

(define (insert a sortedlist)
  (if (or (null? sortedlist) (< a (car sortedlist))) (cons a sortedlist)
      (cons (car sortedlist) (insert a (cdr sortedlist)))))

(define (sort list)
  (define (sub lista listb)
    (if (null? lista) listb
        (sub (cdr lista) (insert (car lista) listb))))
  (sub list '()))

(define (numtolist num)
  (if (= num 0) '()
      (cons (modulo num 10) (numtolist (quotient num 10)))))

(define (listize num) (sort (numtolist num)))

(define (list=? lista listb)
  (cond ((and (null? lista) (null? listb)) #t)
        ((or (null? lista) (null? listb) (not (= (car lista) (car listb)))) #f)
        (#t (list=? (cdr lista) (cdr listb)))))

(define (num=? a b) (list=? (listize a) (listize b)))

;汚い書き方だ・・・
(define (sixok? n) (and (num=? n (* 2 n)) (num=? n (* 3 n)) (num=? n (* 4 n)) (num=? n (* 5 n)) (num=? n (* 6 n))))

(define (solve start)
  (if (sixok? start) (begin (display start) (newline))
      (solve (+ start 1))))

(solve 1)

全探索。「同じ数で構成されているか」はSchemeだと割と調べやすい。

Problem 53

(define (next-pascal list)
  (define (get2 list)
    (if (null? (cdr list)) '()
        (cons (+ (car list) (cadr list)) (get2 (cdr list)))))
  (append (cons (car list) (get2 list)) (cons (car list) '())))

(define (overcount list m)
  (define (sub count list)
    (if (null? list) count
        (sub (+ count (if (> (car list) m) 1 0)) (cdr list))))
  (sub 0 list))

(define (solve endline m)
  (define (sub line lineindex count)
    (if (> lineindex endline) count
        (sub (next-pascal line) (+ lineindex 1) (+ count (overcount line m)))))
  (sub '(1 1) 1 0))

;(solve 23 1000000)->4 23C10,23C11,23C12,23C13の4つ
(solve 100 1000000)

パスカルの三角形を使って。
数をそのまま扱っているが、int幅まで、みたいな言語の場合は「100万超えた数はすべて100万として扱う」などとすればよい。

実はProblem51で結構つまずき、順番としては52→53→51となりました。ちなみに44は解けていない。くそう
44も頭の片隅に置きつつ、とりあえず解いていくぞー！