続けています。
Problem 54
(define (string->card st) (list (tonum (string-ref st 0)) (string-ref st 1))) (define (tonum ch) (cond ((char=? ch #\a) 14) ((char=? ch #\k) 13) ((char=? ch #\q) 12) ((char=? ch #\j) 11) ((char=? ch #\t) 10) (#t (- (char->integer ch) 48)))) ;(define l (read)) ;(display (string->card (symbol->string l))) (define (insert card sorted) (if (or (null? sorted) (<= (car card) (caar sorted))) (cons card sorted) (cons (car sorted) (insert card (cdr sorted))))) (define (sortcard list) (define (sub lista listb) (if (null? lista) listb (sub (cdr lista) (insert (car lista) listb)))) (sub list '())) ;手札は番号小さい順に並ぶ、(数字 スート(char))です、スート順は気にせず ;2番目をとるのはcadr (define (read-card) (define (sub count) (if (> count 5) '() (let* ((nowcard (string->card (symbol->string (read))))) (insert nowcard (sub (+ count 1)))))) (sub 1)) (define (score cl) (let* ((n1 (caar cl)) (n2 (caar (cdr cl))) (n3 (caar (cdr (cdr cl)))) (n4 (caar (cdr (cdr (cdr cl))))) (n5 (caar (cdr (cdr (cdr (cdr cl)))))) (s1 (cadar cl)) (s2 (cadadr cl)) (s3 (cadadr (cdr cl))) (s4 (cadadr (cdr (cdr cl)))) (s5 (cadadr (cdr (cdr (cdr cl)))))) (cond ((and (char=? s1 s2 s3 s4 s5) (= n1 10) (= n2 11) (= n3 12) (= n4 13) (= n5 14)) (list 9 100 (list 100 100 100 100 100)));RSF ((and (char=? s1 s2 s3 s4 s5) (= (+ n1 4) (+ n2 3) (+ n3 2) (+ n4 1) n5)) (list 8 n5 (list n5 n4 n3 n2 n1)));SF ((or (= n1 n2 n3 n4) (= n2 n3 n4 n5)) (list 7 n2 (list n5 n4 n3 n2 n1)));4cards ((or (and (= n1 n2 n3) (= n4 n5)) (and (= n1 n2) (= n3 n4 n5))) (list 6 n3 (list n5 n4 n3 n2 n1)));fullhouseは3枚ある方が構成要素らしい ((char=? s1 s2 s3 s4 s5) (list 5 n5 (list n5 n4 n3 n2 n1)));Flash ((= (+ n1 4) (+ n2 3) (+ n3 2) (+ n4 1) n5) (list 4 n5 (list n5 n4 n3 n2 n1)));straight ((or (= n1 n2 n3) (= n2 n3 n4) (= n3 n4 n5)) (list 3 n3 (list n5 n4 n3 n2 n1)));3cards ((and (= n1 n2) (= n3 n4)) (list 2 n4 (list n5 n4 n3 n2 n1)));2pair1 ((or (and (= n1 n2) (= n4 n5)) (and (= n2 n3) (= n4 n5))) (list 2 n5 (list n5 n4 n3 n2 n1))) ((or (= n1 n2) (= n2 n3)) (list 1 n2 (list n5 n4 n3 n2 n1)));1pair1 ((or (= n3 n4) (= n4 n5)) (list 1 n4 (list n5 n4 n3 n2 n1)));1pair2 (#t (list 0 0 (list n5 n4 n3 n2 n1)))))) ;もし2人のプレイヤーが同じ役の場合には, 役を構成する中で値が最も大きいカードによってランクが決まる: ;例えば, 8のペアは5のペアより強い (下の例1を見よ). それでも同じランクの場合には (例えば, 両者ともQのペアの場合), 一番値が大きいカードによってランクが決まる (下の例4を見よ). ;一番値が大きいカードが同じ場合には, 次に値が大きいカードが比べれられ, 以下同様にランクを決定する. ;0 = 役無し(ハイカード): 一番値が大きいカード ;1 =ワン・ペア: 同じ値のカードが2枚 ;2 =ツー・ペア: 2つの異なる値のペア ;3 =スリーカード: 同じ値のカードが3枚 ;4 =ストレート: 5枚の連続する値のカード ;5 =フラッシュ: 全てのカードが同じスート (注: スートとはダイヤ・ハート・クラブ/スペードというカードの絵柄のこと) ;6 =フルハウス: スリーカードとペア ;7 =フォーカード: 同じ値のカードが4枚 ;8 =ストレートフラッシュ: ストレートかつフラッシュ ;9 =ロイヤルフラッシュ: 同じスートの10, J, Q, K, A (define (list> lista listb) (cond ((> (car lista) (car listb)) #t) ((< (car lista) (car listb)) #f) (#t (list> (cdr lista) (cdr listb))))) (define (battle) (let* ((p1 (read-card)) (p2 (read-card)) (s1 (score p1)) (s2 (score p2)) (yaku1 (car s1)) (yaku2 (car s2)) (max1 (car (cdr s1))) (max2 (car (cdr s2))) (cards1 (car (cdr (cdr s1)))) (cards2 (car (cdr (cdr s2))))) (cond ((> yaku1 yaku2) 1) ((< yaku1 yaku2) 0) ((> max1 max2) 1) ((< max1 max2) 0) ((list> cards1 cards2) 1) (#t 0)))) (define (solve count) (define (sub i ans) (if (> i count) ans (sub (+ i 1) (+ ans (battle))))) (sub 1 0)) (display (solve 1000))
こういう問題は本当に好きじゃない。ProjectEulerで出さなくてもいいじゃんね・・・
あと、フルハウスのときの「役を構成する中で値が最も大きいカード」の定義が曖昧。
フルハウスのときは「2枚-3枚でそろったときの3枚の方が構成するカードになる」ルールの模様。
一発で正解できてよかったけど、こういうのやりたくない・・・
Problem 55
(define (numtolist n) (if (= n 0) '() (cons (modulo n 10) (numtolist (quotient n 10))))) (define (listtonum list) (define (sub lis ans) (if (null? lis) ans (sub (cdr lis) (+ (* ans 10) (car lis))))) (sub list 0)) (define (rev list) (define (sub lista listb) (if (null? lista) listb (sub (cdr lista) (cons (car lista) listb)))) (sub list '())) (define (kaibun num) (listtonum (numtolist num))) (define (kaibun? num) (let ((lis (numtolist num))) (= (listtonum lis) (listtonum (rev lis))))) (define (lychrel? num) (define (sub count nownum) (cond ((>= count 50) #t) ((kaibun? nownum) #f) (#t (sub (+ count 1) (+ nownum (kaibun nownum)))))) (sub 1 (+ num (kaibun num)))) (define (solve lim) (define (sub count now) (if (>= now lim) count (sub (+ count (if (lychrel? now) 1 0)) (+ now 1)))) (sub 0 1)) (display (solve 10000))
普通に探索。ちゃんと書いてくれているけど、「回文数でLychrel数という数もある」ことに注意。
Problem 56
(define (ruijo a b) (if (= b 0) 1 (* a (ruijo a (- b 1))))) (define (sujiwa n) (if (= n 0) 0 (+ (modulo n 10) (sujiwa (quotient n 10))))) (define (getsujiwa list) (sujiwa (ruijo (car list) (car (cdr list))))) (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 (getmax list) (define (sub kouho lis) (if (null? lis) kouho (sub (if (> (car lis) kouho) (car lis) kouho) (cdr lis)))) (sub -9999999999 list)) (define (generate start end) (if (> start end) '() (cons start (generate (+ start 1) end)))) (display (getmax (map (lambda (x) (getsujiwa x)) (p-generate 2 (generate 1 99)))))
重複組み合わせの関数を使って候補を生成したけど、普通にループ的書き方してもよかったかなぁ。重複を許す組み合わせの書き方、せっかくできるようになったから使いたくなっちゃう・・・
Problem 57
(define (renbunsu n) (define (sub count now) (if (= count 0) now (sub (- count 1) (/ 1 (+ 2 now))))) (sub n 0)) (define (ketasu n) (if (= n 0) 0 (+ 1 (ketasu (quotient n 10))))) ;numerator ->分子を返す関数 ;denominator ->分母を返す関数 (define (test? bunsu) (> (ketasu (+ (numerator bunsu) (denominator bunsu))) (ketasu (denominator bunsu)))) (define (solve lim) (define (sub count i) (if (> i lim) count (sub (+ count (if (test? (renbunsu i)) 1 0)) (+ i 1)))) (sub 0 1)) (display (solve 1000))
schemeは分数をそのまま計算できるし、再帰は書きやすいし、numeratorもdenominatorもあるし、この問題にはうってつけ！
schemeだからこそ簡単に解けた問題もあり、テンション上がってます。続けます〜
