Project Euler(with Scheme) Problem 62〜65(問題を飛ばすのは恥ずかしいことじゃない)

あー44解けてない。俺は色々な問題を抱きながら、最終的に44と結婚するのか？
あと、面倒な問題はモチベーション維持のため後回しにすることにした。
一旦、解いた問題数を増やしていきたい。
飛ばしたところは後で加筆するため、記事の中にスペースを確保しておくことにする。

Problem 62

(define (cuben n) (* n n n))

(define (groupen n)
  (define (sort list)
    (define (insert ele sortedlist)
      (if (null? sortedlist) (cons ele '())
          (if (<= ele (car sortedlist)) (cons ele sortedlist)
              (cons (car sortedlist) (insert ele (cdr sortedlist))))))
    (define (insert-sort lista listb)
      (if (null? lista) listb (insert-sort (cdr lista) (insert (car lista) listb))))
    (insert-sort list '()))
  (define (listen n);n>0
    (if (= n 0) '() (cons (modulo n 10) (listen (quotient n 10)))))
  (sort (listen n)))

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

(define (solve checkedlist nowindex targetcount);targetcountは2以上にすること
  (define (check? list nownum countdown)
    (if (null? list) #f
        (let ((nowgroup (groupen nownum))
              (anothergroup (groupen (car list))))
          (cond ((not (= (length nowgroup) (length anothergroup))) #f)
                ((and (list=? nowgroup anothergroup) (= countdown 2)) (begin (display (car list)) (newline) #t))
                ((list=? nowgroup anothergroup) (check? (cdr list) nownum (- countdown 1)))
                (#t (check? (cdr list) nownum countdown))))))
  (if (check? checkedlist (cuben nowindex) targetcount ) "Finish!!!"
      (solve (cons (cuben nowindex) checkedlist) (+ nowindex 1) targetcount)))

(solve '() 1 3);1秒
(solve '() 1 4);25秒
(solve '() 1 5);かかった

数分かかったけど、まぁいいかということでこのコードで終わり。単純な全探索。
探すときにPriorityQueueを使って、同じ組み合わせの数をlog(n)で探すようにすればもう一段高速化が可能。

Problem 63

;まず、m^nにおいて、m>=10のときにはm^nがn桁になることはない
;証明は容易。m>=10のときはm^nは(n+1)桁以上になる。m=10のときを考えるとよい。
;この問題ではどこまで調べればいいのか分からなくなりそうだが、
;9^nがn桁未満になるようなnまで調べればよいことがわかる。

(define (power n m);n^m、log(m)で求められる
  (cond ((= m 0) 1)
        ((= m 1) n)
        ((= (modulo m 2) 0) (let ((half (power n (quotient m 2)))) (* half half)))
        (#t (let ((half (power n (quotient (- m 1) 2)))) (* n half half)))))

(define (ketasu n);n>0
  (if (= n 0) 0 (+ 1 (ketasu (quotient n 10)))))

(define (solve startcount startketa)
  (if (< (ketasu (power 9 startketa)) startketa) startcount
      (solve (+ startcount (samecount startketa)) (+ startketa 1))))

(define (same-plus index keta) (if (= (ketasu (power index keta)) keta) 1 0))
(define (samecount keta) (+ (same-plus 1 keta) (same-plus 2 keta) (same-plus 3 keta)
                             (same-plus 4 keta) (same-plus 5 keta) (same-plus 6 keta)
                              (same-plus 7 keta) (same-plus 8 keta) (same-plus 9 keta)))


(solve 0 1)

え？無限に調べなきゃいけないの・・・？と思わせる問題文。素敵。
実際に調べる上限の条件は明確だし、その証明も容易。

Problem 64

飛ばしてます、へへへ

Problem 65

;numerator ->分子を返す関数
;denominator ->分母を返す関数
;e = [2; 1,2,1, 1,4,1, 1,6,1 , ... , 1,2k,1, ...].

(define (make-num list)
  (define (sub now lis)
    (if (null? lis) now
        (sub (+ (car lis) (/ 1 now)) (cdr lis))))
  (if (null? list) 0 (sub (car list) (cdr list))))

(define (make-list count);count >= 1
  (if (= count 1) '(2)
      (cons (if (= 0 (modulo count 3)) (* 2 (quotient count 3)) 1) (make-list (- count 1)))))

(define (near-e count) (make-num (make-list count)))

(define (ketawa n) (if (= n 0) 0 (+ (modulo n 10) (ketawa (quotient n 10)))))

(display (ketawa (numerator (near-e 100))))

キレイに解けた！再帰も使える、分数の扱いもしやすい。Scheme最高！！！

一旦ここまで。解いていくぞ〜！