続けています。人生も、Project Eulerも。
Problem33
(define (yakubun ls) (if (= 0 (car (cdr ls))) (list 10000 9999) (let* ((bunshi (car ls)) (bunbo (car (cdr ls))) (nowgcd (gcd bunshi bunbo))) (list (quotient bunshi nowgcd) (quotient bunbo nowgcd))))) ;30/50みたいなのはハジきたいよね ;共通点ない場合もハジきたいよね→分母に1足すか (define (remove-num ls) (let* ((bunshi (car ls)) (bunbo (car (cdr ls))) (bunshi10 (quotient bunshi 10)) (bunshi1 (modulo bunshi 10)) (bunbo10 (quotient bunbo 10)) (bunbo1 (modulo bunbo 10))) (cond ((= bunshi1 bunbo1 0) (list bunshi (+ bunbo 1))) ((= bunshi1 bunbo1) (list bunshi10 bunbo10)) ((= bunshi1 bunbo10) (list bunshi10 bunbo1)) ((= bunshi10 bunbo1) (list bunshi1 bunbo10)) ((= bunshi10 bunbo10) (list bunshi1 bunbo1)) (#t (list bunshi (+ bunbo 1)))))) (define (yakubun? ls) (yakubun (remove-num ls))) (define (list=? ls1 ls2) (and (= (car ls1) (car ls2)) (= (car (cdr ls1)) (car (cdr ls2))))) (define (target? ls) (list=? (yakubun ls) (yakubun? ls))) ;どんな数か見たいので解答ついでに出力する仕組みにした (define (ans bunshi bunbo nowbunshi nowbunbo) (if (= bunshi 99) (car (cdr (yakubun (list nowbunshi nowbunbo)))) (let* ((nextbunshi (if (>= (+ bunshi 1) bunbo) 10 (+ bunshi 1))) (nextbunbo (if (>= (+ bunshi 1) bunbo) (+ bunbo 1) bunbo))) (ans nextbunshi nextbunbo (if (target? (list bunshi bunbo)) (let* ((a (display (list bunshi bunbo))) (b (newline))) (* nowbunshi bunshi)) nowbunshi) (if (target? (list bunshi bunbo)) (* nowbunbo bunbo) nowbunbo))))) (display (ans 10 11 1 1)) (newline)
あまりキレイに書けず・・・
String使った方がキレイに書けるのかも。
Problem 34
(define (fact n) (cond ((= n 0) 1) ((= n 1) 1) (#t (* n (fact (- n 1)))))) (define (myfact n) (if (= n 0) 0 (+ (fact (modulo n 10)) (myfact (quotient n 10))))) (define (target? n) (= n (myfact n))) (define (solve start) (define (sub now ans) (if (= now 2) ans (sub (- now 1) (+ ans (if (target? now) now 0))))) (sub start 0)) (display (solve 1000000)) (newline)
fact大好き！
Problem 35
うお、と思ったが、調べる候補が実はそんなに多くないことに気づき、候補のみ生成して調べる形で正解。
候補の生成にはこの記事のときの関数を使った。
自分の成長が分かって嬉しい！！！
(define (e-l ele lislis) (if (null? lislis) '() (cons (cons ele (car lislis)) (e-l ele (cdr lislis))))) (define (multi-list listA listB) (if (null? listA) '() (append (e-l (car listA) listB) (multi-list (cdr listA) listB)))) (define (p-list count base ans) (if (= count 0) ans (p-list (- count 1) base (multi-list base ans)))) (define (p-generate count list) (p-list count list '(()))) (define (numgenerate list) (define (sub lis num) (if (null? lis) num (sub (cdr lis) (+ (* num 10) (car lis))))) (sub list 0)) ;ゼロは左端から見ていって左端から連続で出ている場合のみOK ;例えば"000575733"はOKだが、"000305755"はアウト (define (zero-check list) (define (sub lis sum) (cond ((null? lis) #t) ((and (= (car lis) 0) (> sum 0)) #f) (#t (sub (cdr lis) (+ sum (car lis)))))) (sub list 0)) ;各桁が奇数の数のみ調べる(正しくは0と奇数のみで構成された数のみ調べている) (define (sosu? n) (define (sub checker) (if (> (* checker checker) n) #t (if (= 0 (modulo n checker)) #f (sub (+ checker 1))))) (if (< n 2) #f (sub 2))) (define (ketasu n) (if (= n 0) 0 (+ 1 (ketasu (quotient n 10))))) (define (base10 n) (if (= n 1) 1 (* 10 (base10 (- n 1))))) ;高々6桁までしか対象でないことを利用したコード ;6回循環したらクリア (define (junkansosu? n) (define (sub nownum count) (if (> count 6) #t (and (sosu? nownum) (sub (+ (* (base10 (ketasu n)) (modulo nownum 10)) (quotient nownum 10)) (+ count 1))))) (sub n 0)) (define (solve ls) (if (null? ls) 1 ;2をカウント (+ (if (junkansosu? (numgenerate (car ls))) 1 0) (solve (cdr ls))))) (display (solve (p-generate 6 '(0 1 3 5 7 9)))) (newline)
一瞬で答えが出た！よしよし。
Problem 36
文字列系か〜〜〜〜Scheme苦手そ〜〜〜と思って調べてみたら、意外と関数が充実してた。いいね！
;(number->string 460288)で"460288"という文字列になり ;(number->string 460288 2)で2進数表記の文字列になる ;(string-length s)という関数もあり ;(string-ref s idx)という関数もあるぞ ;文字の比較は(char=? ch1 ch2)だ (define (kaibun? str) (define (sub left right) (if (> left right) #t (and (char=? (string-ref str left) (string-ref str right)) (sub (+ left 1) (- right 1))))) (sub 0 (- (string-length str) 1))) (define (solve start) (define (sub ans now) (if (= now 0) ans (sub (+ ans (if (and (kaibun? (number->string now)) (kaibun? (number->string now 2))) now 0)) (- now 1)))) (sub 0 start)) (display (solve 999999)) (newline)
キレイキレイ。
Problem 37
こちらの問題も、候補の数を生成して解答。
素数判定系の問題では重複を許す組み合わせ、大活躍！！！
(define (sosu? n) (define (sub now) (cond ((> (* now now) n) #t) ((= 0 (modulo n now)) #f) (#t (sub (+ now 1))))) (if (< n 2) #f (sub 2))) (define (e-l ele lislis) (if (null? lislis) '() (cons (cons ele (car lislis)) (e-l ele (cdr lislis))))) (define (multi-list listA listB) (if (null? listA) '() (append (e-l (car listA) listB) (multi-list (cdr listA) listB)))) (define (p-list count base ans) (if (= count 0) ans (p-list (- count 1) base (multi-list base ans)))) (define (p-generate count list) (p-list count list '(()))) (define (numgenerate list) (define (sub lis num) (if (null? lis) num (sub (cdr lis) (+ (* num 10) (car lis))))) (sub list 0)) ;ここから今回の問題用に書いた関数 (define (base10 n) (if (= n 1) 1 (* 10 (base10 (- n 1))))) (define (ketasu n) (if (= n 0) 0 (+ 1 (ketasu (quotient n 10))))) (define (left-sosu? n) (if (< n 10) (sosu? n) (and (sosu? n) (left-sosu? (quotient n 10))))) (define (right-sosu? n) (if (< n 10) (sosu? n) (and (sosu? n) (right-sosu? (modulo n (base10 (ketasu n))))))) (define (good-sosu? n) (and (>= n 10) (left-sosu? n) (right-sosu? n))) ;25とかオッケーだもんな、2は含んでもよし。0も含んでよし。 (define (count-filter func list) (cond ((null? list) 0) ((func (car list)) (+ 1 (count-filter func (cdr list)))) (#t (count-filter func (cdr list))))) ;テスト用。6桁とかで足りるんかな？ ;(display (count-filter (lambda (x) (good-sosu? (numgenerate x))) (p-generate 6 '(0 1 2 3 5 7 9)))) ;この結果が11でした。よって、6桁まで調べたらOKでした。 (define (solve list) (cond ((null? list) 0) ((good-sosu? (numgenerate (car list))) (+ (numgenerate (car list)) (solve (cdr list)))) (#t (solve (cdr list))))) (display (solve (p-generate 6 '(0 1 2 3 5 7 9)))) (newline)
今回は一旦ここまでで。
愚直に書いたらアウトそうな問題をしっかり解けてるの嬉しい！このやろー！
