Project Euler(with Scheme) Problem 24〜27

続けています。

Problem 24

"指定された番目のものを生成していく"というコード。高速。

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

(define (pick list index)
  (cond ((null? list) (display "index error"))
        ((= index 0) (cdr list))
        (#t (cons (car list) (pick (cdr list) (- index 1))))))

(define (get list index)
  (cond ((null? list) (display "index error"))
        ((= index 0) (car list))
        (#t (get (cdr list) (- index 1)))))

(define (listlen list)
  (if (null? list) 0
      (+ 1 (listlen (cdr list)))))

(define (over-i base target)
  (define (sub i)
    (if (and (<= (* i base) target) (< target (* (+ i 1) base))) i 
        (sub (+ i 1))))
  (sub 0))

(define (solve base leftindex);baseはsorted前提
  (if (null? base) base
      (let* ((cdrpattern (fact (listlen (cdr base))))
             (pickup (over-i cdrpattern leftindex)))
        (cons (get base pickup) (solve (pick base pickup) (- leftindex (* pickup cdrpattern)))))))

(define (ans base indexnum) (solve base (- indexnum 1))) ;1ズレてたから
(define (listtonum list)
  (define (sub now list)
    (if (null? list) now
        (sub (+ (* now 10) (car list)) (cdr list))))
  (sub (car list) (cdr list)))

(display (listtonum (ans '(0 1 2 3 4 5 6 7 8 9) 1000000)))
(newline)

Problem 25

(define (ketasu n)
  (if (< n 10) 1
      (+ 1 (ketasu (quotient n 10)))))
(define (solve first second index)
  (if (= (ketasu first) 1000) index
      (solve second (+ first second) (+ index 1))))

(display (solve 1 1 1))
(newline)

オレ、デカイカズ、トクイ。

Problem 26

割り算やっていって、これまでで出たことある数が出たら止まるプログラム。

(define (lookup num list)
  (define (sub count lis)
    (cond ((null? lis) 0)
          ((= num (car lis)) count)
          (#t (sub (+ count 1) (cdr lis)))))
  (sub 1 list))

(define (junkan n)
  (define (sub now list)
    (let* ((sho (quotient (* now 10) n))
           (yo (modulo (* now 10) n))
           (looknum (lookup sho list))
           (nextlist (cons sho list)))
      (if (= looknum 0) (sub yo nextlist) looknum)))
  (sub 1 '()))

(define (ans jougen)
  (define (sub max maxindex now)
    (if (= now 0) maxindex
        (let ((kouho (junkan now)))
          (if (> kouho max) (sub kouho now (- now 1))
              (sub max maxindex (- now 1))))))
  (sub 0 #f jougen))

(display (ans 999))
(newline)

これでやってみるも、ダメ。どうやら、もっとややこしい循環節を持つような小数があるらしい？

今思うと、割り算やっていくとき割る数が10以上だったら、余りにかける数は10じゃなくて100とか1000とかになるよね。
ということで一部変更。

(define (lookup num list)
  (define (sub count lis)
    (cond ((null? lis) 0)
          ((= num (car lis)) count)
          (#t (sub (+ count 1) (cdr lis)))))
  (sub 1 list))

(define (junkan1 n)
  (define (sub now list)
    (let* ((sho (quotient (* now 10) n))
           (yo (modulo (* now 10) n))
           (looknum (lookup sho list))
           (nextlist (cons sho list)))
      (if (= looknum 0) (sub yo nextlist) looknum)))
  (sub 1 '()))

(define (junkan2 n)
  (define (sub now list)
    (let* ((sho (quotient (* now 100) n))
           (yo (modulo (* now 100) n))
           (looknum (lookup sho list))
           (nextlist (cons sho list)))
      (if (= looknum 0) (sub yo nextlist) looknum)))
  (sub 1 '()))

(define (junkan3 n)
  (define (sub now list)
    (let* ((sho (quotient (* now 1000) n))
           (yo (modulo (* now 1000) n))
           (looknum (lookup sho list))
           (nextlist (cons sho list)))
      (if (= looknum 0) (sub yo nextlist) looknum)))
  (sub 1 '()))

(define (junkan num)
  (cond ((= num 1) (lambda (x) (junkan1 x)))
        ((= num 2) (lambda (x) (junkan2 x)))
        ((= num 3) (lambda (x) (junkan3 x)))))

(define (ketasu num)
  (if (< num 10) 1
      (+ 1 (ketasu (quotient num 10)))))

(define (ans jougen)
  (define (sub max maxindex now)
    (if (= now 0) maxindex
        (let ((kouho ((junkan (ketasu now)) now)))
          (if (> kouho max) (sub kouho now (- now 1))
              (sub max maxindex (- now 1))))))
  (sub 0 #f jougen))

(display (ans 999))
(newline)

これで正解。よかったよかった。

Problem 27

(define (2jishiki a b n)
  (+ (* n n) (* n a) b))
(define (sosu? n)
  (define (sub now)
    (cond  ((> (* now now) n) #t)
           ((= (modulo n now) 0) #f)
           (#t (sub (+ now 1)))))
  (if (<= n 1) #f (sub 2)))
(define (countsosu a b)
  (define (sub now count)
    (if (not (sosu? (2jishiki a b now))) count
        (sub (+ now 1) (+ count 1))))
  (sub 0 0))

(define (solve alim blim)
  (define (sub a b max maxans)
    (if (>= a alim) maxans
        (let ((nowcount (countsosu a b))
              (nextb (if (= b blim) (- 0 blim) (+ b 1)))
              (nexta (if (= b blim) (+ a 1) a)))
          (if (> nowcount max) (sub nexta nextb nowcount (* a b))
              (sub nexta nextb max maxans)))))
  (sub (- 1 alim) (- 0 blim) 0 #f))

(display (solve 1000 1000))
(newline)

単純に全探索。多分、数学的に考えたらもう少し高速になるのだろうけど、(a, b)の組み合わせ1つに対してかかる時間はたいしたことないし、まぁいっか、と。

意外とちゃんと続けてて偉い！学生(5年以上前)のときに解いたとこまであと数問！
頑張るぞーい！