Project Euler(with Scheme) Problem 66〜70

やってく。飛ばしながらも。

Problem 66

飛ばしてます、へへへ

これ、ペル方程式について調べてみたら、ルートの連分数表示が絡むのね。数学的だ。

Problem 67

すでにProblem 18のコードで解いているため省略。

Problem 68

(define (magic? list)
  (let ((n1 (list-ref list 0))
        (n2 (list-ref list 1))
        (n3 (list-ref list 2))
        (n4 (list-ref list 3))
        (n5 (list-ref list 4))
        (n6 (list-ref list 5))
        (n7 (list-ref list 6))
        (n8 (list-ref list 7))
        (n9 (list-ref list 8))
        (n10 (list-ref list 9)))
  (and (< n1 n4) (< n1 n5) (< n1 n7) (< n1 n9)
       (= (+ n1 n2 n3) (+ n4 n3 n6) (+ n5 n6 n8) (+ n7 n8 n10) (+ n9 n10 n2)))))

(define (tonum list)
  (let ((n1 (number->string (list-ref list 0)))
        (n2 (number->string (list-ref list 1)))
        (n3 (number->string (list-ref list 2)))
        (n4 (number->string (list-ref list 3)))
        (n5 (number->string (list-ref list 4)))
        (n6 (number->string (list-ref list 5)))
        (n7 (number->string (list-ref list 6)))
        (n8 (number->string (list-ref list 7)))
        (n9 (number->string (list-ref list 8)))
        (n10 (number->string (list-ref list 9))))
    (string->number (string-append n1 n2 n3 n4 n3 n6 n5 n6 n8 n7 n8 n10 n9 n10 n2))))

(define (fold-right fn a ls . args)
  (if (null? args)
      (letrec ((recr
                 (lambda (a ls)
                   (if (null? ls)
                       a
                     (fn (car ls) (recr a (cdr ls)))))))
        (recr a ls))
    (letrec ((recr
               (lambda (a xs)
                 (if (member? '() xs)
                     a
                   (apply fn (append (map car xs)
                                     (list (recr a (map cdr xs)))))))))
      (recr a (cons ls args)))))

(define (permutations-list ls)
    (define (perm ls a b)
        (if (null? ls)
            (cons (reverse a) b)
            (fold-right
                (lambda (x y)
                    (perm (remove-item x ls) (cons x a) y))
                b
                ls)))
    (perm ls '() '()))

(define (remove-item x ls)
    (remove (lambda (a) (equal? a x)) ls))

(define (remove func list)
  (cond ((null? list) list)
        ((func (car list)) (remove func (cdr list)))
        (#t (cons (car list) (remove func (cdr list))))))

(define (solve listlist)
  (define (sub max lists)
    (if (null? lists) max
        (if (magic? (car lists))
            (let ((nownum (tonum (car lists))))
              (if (< max nownum 10000000000000000) (sub nownum (cdr lists))
                  (sub max (cdr lists))))
            (sub max (cdr lists)))))
  (sub 0 listlist))

(display (solve (permutations-list '(1 2 3 4 5 6 7 8 9 10))))

普通に全探索。解けた。

Problem 69

Problem 70

トーティエント関数の値を一発で出す方法を模索中。頑張る。