Project Euler(with Scheme) Problem 19〜23

ガンガン行きます。
また数学的でない(正しく言うと「そのアルゴリズムを問うなら入力が数字でも同じようなことできるやろ」という)問題が。

さて、数学的でない(と僕が考えている)Problem 19から。

Problem 19

;tsuitachi = 月曜日なら1、火曜日なら2、、、日曜日なら0
(define (solve year month tsuitachi count)
  (cond ((= year 2001) count)
        ((= month 12) (solve (+ year 1) 1 (modulo (+ tsuitachi 31) 7) (+ count (if (= (modulo tsuitachi 7) 0) 1 0))))
        ((and (= month 2) (= 0 (modulo year 4)) (not (and (> (modulo year 400) 0) (= (modulo year 100) 0))))
         (solve year 3 (modulo (+ tsuitachi 29) 7) (+ count (if (= (modulo tsuitachi 7) 0) 1 0))))
        ((= month 2) (solve year 3 (modulo (+ tsuitachi 28) 7) (+ count (if (= (modulo tsuitachi 7) 0) 1 0))))
        ((or (= month 4) (= month 6) (= month 9) (= month 11)) (solve year (+ month 1) (modulo (+ tsuitachi 30) 7) (+ count (if (= (modulo tsuitachi 7) 0) 1 0))))
        (#t (solve year (+ month 1) (modulo (+ tsuitachi 31) 7) (+ count (if (= (modulo tsuitachi 7) 0) 1 0))))))

(display (solve 1901 1 2 0));1901/1/1は火曜日
(newline)

もうこういう「たくさん場合分けすればいいだけ」みたいなのはやめてくれ。

Problem 20

(define (fact n)
  (if (= n 0) 1
      (* n (fact (- n 1)))))
(define (ketawa n)
  (if (= n 0) 0
      (+ (modulo n 10) (ketawa (quotient n 10)))))

(display (ketawa (fact 100)))
(newline)

でかい数は俺に任せろって言ったろ？

Problem 21

(define (yakusuwa n)
  (define (sub i sum)
    (cond ((>= (* i i) n) sum)
          ((= (* i i) n) (+ i sum))
          ((= (modulo n i) 0) (sub (+ i 1) (+ sum i (quotient n i))))
          (#t (sub (+ i 1) sum))))
  (+ 1 (sub 2 0)))

(define (solve n)
  (define (sub i sum)
    (if (< i 10) sum
        (sub (- i 1) (+ sum (let ((ba (yakusuwa i))) (if (and (= i (yakusuwa ba)) (not (= i ba))) i 0))))))
  (sub n 0))

(display (solve 9999))
(newline)

ちなみに、d(n) = n となるa(つまりは完全数)は結構あるので注意。

Problem 22

前処理はシェルでやりました。","が邪魔だったので、" "に置換します。

$ sed -e 's/","/" "/g' ./name.txt > ./newname.txt

そしてSchemeのコードはこちら。

(define (insert a sorted hikaku)
  (cond ((null? sorted) (cons a sorted))
        ((hikaku a (car sorted)) (cons a sorted))
        (#t (cons (car sorted) (insert a (cdr sorted) hikaku)))))

(define (char< a b) (< (- (char->integer a) (char->integer b)) 0))
(define (char= a b) (= (- (char->integer a) (char->integer b)) 0))
(define (cdrstr str) (substring str 1 (string-length str)))
(define (carstr str) (string-ref str 0))

(define (str< a b);文字数はaよりbの方が同じもしくは長い
  (cond ((< (string-length b) (string-length a)) (not (str< b a)))
        ((= (string-length a) 0) #t)
        ((char= (carstr a) (carstr b)) (str< (cdrstr a) (cdrstr b)))
        (#t (char< (carstr a) (carstr b)))))

;最後の名前が"ALONSO"だったので、それを目印に
(define (input)
  (define (sub list)
    (let* ((a (read)))
      (if (string=? a "ALONSO") (insert a list str<)
          (sub (insert a list str<)))))
  (sub '()))

(define (namescore str)
  (if (= (string-length str) 0) 0
      (+ (- (char->integer (carstr str)) (char->integer #\A)) 1 (namescore (cdrstr str)))))

(define (ans list)
  (define (sub sum list index)
    (if (null? list) sum
        (sub (+ sum (* index (namescore (car list)))) (cdr list) (+ index 1))))
  (sub 0 list 1))

(display (ans (input)))
(newline)

いやほんま、文字列で出題するのやめてほしい。数字で問題出してよ。

Problem 23

直感的にバーッと書いたコードがコチラ。

(define (insert ele sortedlist)
  (cond ((> ele 28123) sortedlist)
        ((null? sortedlist) (cons ele sortedlist))
        ((= ele (car sortedlist)) sortedlist)
        ((< ele (car sortedlist)) (cons ele sortedlist))
        (#t (cons (car sortedlist) (insert ele (cdr sortedlist))))))

(define (walist ele list)
  (if (null? list) list
      (let ((wa (+ ele (car list))))
        (if (> wa 28123) '() (cons wa (walist ele (cdr list)))))))

(define (union lista listb)
  (if (null? lista) listb
      (union (cdr lista) (insert (car lista) listb))))

(define (choufuku list)
  (define (listsum lista listb ans)
      (if (null? lista) ans
          (listsum (cdr lista) (cdr listb) (union (walist (car lista) listb) ans))))
  (listsum list list '()))

;過剰数の話だし、2以上でちゃんと動作すりゃいいか
(define (yakusuwa n)
  (define (sub i sum)
    (cond ((> (* i i) n) sum)
          ((= (* i i) n) (+ i sum))
          ((= 0 (modulo n i)) (sub (+ i 1) (+ i (quotient n i) sum)))
          (#t (sub (+ i 1) sum))))
  (sub 2 1))

(define (kajou? n) (> (yakusuwa n) n))

(define (generate-kajou)
  (define (sub i)
    (cond  ((> i 28123) '())
           ((kajou? i) (cons i (sub (+ i 1))))
           (#t (sub (+ i 1)))))
  (sub 2))

(define (have? i sortedlist)
  (cond ((null? sortedlist) #f)
        ((> i (car sortedlist)) #f)
        ((< i (car sortedlist)) (have? i (cdr sortedlist)))
        (#t #t)))

(define (ans list)
  (define (sub i sum)
    (if (> i 28123) sum (sub (+ i 1) (+ sum (if (have? i list) 0 i)))))
  (sub 1 0))

(display (ans (let*
                  ((kajoulist (generate-kajou))
                   (a (display "geerate OK, "));1,2秒
                   (cho (choufuku kajoulist))
                   (b (display "choufuku OK"))) cho)));ここまでがそもそも完了しない
(newline)

配列を扱うのが苦手だから、効率悪いけどリストで書いちゃう。としたら、全然計算が終わらない・・・
28123以下の過剰数の数をnとして、O(n^2)。これがあかんのやね。分かった分かった。

ということで、二分探索にしてO(n * log(n))で書き直す。そしたら無事、数十秒で答えが出た。よかったよかった。

(define (insert ele sortedlist)
  (cond ((> ele 28123) sortedlist)
        ((null? sortedlist) (cons ele sortedlist))
        ((= ele (car sortedlist)) sortedlist)
        ((< ele (car sortedlist)) (cons ele sortedlist))
        (#t (cons (car sortedlist) (insert ele (cdr sortedlist))))))

(define (walist ele list)
  (if (null? list) list
      (let ((wa (+ ele (car list))))
        (if (> wa 28123) '() (cons wa (walist ele (cdr list)))))))

(define (union lista listb)
  (if (null? lista) listb
      (union (cdr lista) (insert (car lista) listb))))

(define (choufuku list)
  (define (listsum lista listb ans)
      (if (null? lista) ans
          (listsum (cdr lista) (cdr listb) (union (walist (car lista) listb) ans))))
  (listsum list list '()))

;過剰数の話だし、2以上でちゃんと動作すりゃいいか
(define (yakusuwa n)
  (define (sub i sum)
    (cond ((> (* i i) n) sum)
          ((= (* i i) n) (+ i sum))
          ((= 0 (modulo n i)) (sub (+ i 1) (+ i (quotient n i) sum)))
          (#t (sub (+ i 1) sum))))
  (sub 2 1))

(define (kajou? n) (> (yakusuwa n) n))

(define (generate-kajou)
  (define (sub i)
    (cond  ((> i 28123) '())
           ((kajou? i) (cons i (sub (+ i 1))))
           (#t (sub (+ i 1)))))
  (sub 12))

(define (have? i left right vec) ;二分探索
  (cond ((= left right) (= i (vectoer-ref vec left)))
        ((= (+ left 1) right) (or (= i (vector-ref vec left)) (= i (vector-ref vec right))))
        (#t (let* ((center (quotient (+ left right) 2))
                   (centernum (vector-ref vec center)))
              (cond ((= i centernum) #t)
                    ((< i centernum) (have? i left center vec))
                    (#t (have? i center right vec)))))))

(define (canmake? i vec)
  (define (sub index)
    (if (> (* 2 (vector-ref vec index)) i) #f
        (or (have? (- i (vector-ref vec index)) index (- (vector-length vec) 1) vec);自身同士を足すのもOKだから左端はindex+1ではなくindexから
            (sub (+ index 1)))))
  (sub 0))

(define (ans vec)
  (define (sub i sum)
    (if (> i 28123) sum
        (sub (+ i 1) (+ sum (if (canmake? i vec) 0 i)))))
  (sub 1 0))

(display (let* ((kajoulist (generate-kajou))
                (kajouvec (list->vector kajoulist)))
           (ans kajouvec)))
(newline)

ついに計算量でNGになる問題にぶつかる。競技プログラミングが好きな人間としては、とても楽しい。
というわけで、続けていくぞー！
for-eachとか使えるようになりたいね。
www.shido.info
終わり！！！