ChucK のマニュアルを翻訳してみるテスト
ちょっくらオーディオプログラミング言語の ChucK を触ってみているところ。
リファレンスにさらっと目を通してはいるものの理解がちょっと怪しい気がするので、気分転換にマニュアルを翻訳してみるテスト。
Project Euler: Problem 19
You are given the following information, but you may prefer to do some research for yourself.
* 1 Jan 1900 was a Monday.
* Thirty days has September,
April, June and November.
All the rest have thirty-one,
Saving February alone,
Which has twenty-eight, rain or shine.
And on leap years, twenty-nine.
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?
http://projecteuler.net/index.php?section=problems&id=19
与えられたいくつかの情報を元に、1901年1月1日から2000年12月31日までの間に月の最初の日(=>1日)が日曜日であった数を求めよとのこと。
このところ勉強している Haskell で解いてみようかと思ったが…30 分くらいで挫折して、例のごとく Gauche で書いてみた。
#!/usr/bin/env gosh (define (leap? year) (and (zero? (remainder year 4)) (or (zero? (remainder year 400)) (not (zero? (remainder year 100)))))) (define-class <date> () [(year :init-keyword :year :init-value 0) (mon :init-keyword :mon :init-value 1) (day :init-keyword :day :init-value 1)]) ;; return a date which is n days after from self (define-method + ((self <date>) (n <integer>)) (if (<= 0 n) (let loop ((n n) (y (slot-ref self 'year)) (m (slot-ref self 'mon)) (d (slot-ref self 'day))) (if (< n 1) (make <date> :year y :mon m :day d) (if (< d 28) (loop (- n 1) y m (+ d 1)) (case m [(1 3 5 7 8 10 12) (cond [(< d 31) (loop (- n 1) y m (+ d 1))] [(= d 31) (if (= m 12) (loop (- n 1) (+ y 1) 1 1) (loop (- n 1) y (+ m 1) 1))] [else (error "invalid date")])] [(4 6 9 11) (cond [(< d 30) (loop (- n 1) y m (+ d 1))] [(= d 30) (loop (- n 1) y (+ m 1) 1)] [else (error "invalid date")])] [(2) (if (leap? y) (case d [(28) (loop (- n 1) y m 29)] [(29) (loop (- n 1) y 3 1)] [else (error "invalid date")]) (case d [(28) (loop (- n 1) y 3 1)] [else (error "invalid date")]))] [else (error "invalid date")])))) (- self (abs n)))) ;; return a date which is n days before from self (define-method - ((self <date>) (n <integer>)) (if (<= 0 n) (let loop ((n n) (y (slot-ref self 'year)) (m (slot-ref self 'mon)) (d (slot-ref self 'day))) (if (< n 1) (make <date> :year y :mon m :day d) (cond [(< 1 d) (loop (- n 1) y m (- d 1))] [(= 1 d) (case m [(2 4 6 8 9 11) (loop (- n 1) y (- m 1) 31)] [(5 7 10 12) (loop (- n 1) y (- m 1) 30)] [(3) (if (leap? y) (loop (- n 1) y 2 29) (loop (- n 1) y 2 28))] [(1) (loop (- n 1) (- y 1) 12 31)])] [else (error "invalid date")]))) (+ self (abs n)))) (define-method equal? ((self <date>) (other <date>)) (and (= (slot-ref self 'year) (slot-ref other 'year)) (= (slot-ref self 'mon) (slot-ref other 'mon)) (= (slot-ref self 'day) (slot-ref other 'day)))) (define-method < ((self <date>) (other <date>)) (or (< (slot-ref self 'year) (slot-ref other 'year)) (and (= (slot-ref self 'year) (slot-ref other 'year)) (or (< (slot-ref self 'mon) (slot-ref other 'mon)) (and (= (slot-ref self 'mon) (slot-ref other 'mon)) (< (slot-ref self 'day) (slot-ref other 'day))))))) (define-method <= ((self <date>) (other <date>)) (or (equal? self other) (< self other))) (define-method > ((self <date>) (other <date>)) (and (not (equal? self other)) (< self other))) (define-method >= ((self <date>) (other <date>)) (or (equal? self other) (< self other))) ;; *epoc-date* should be a Monday, and *enough* old. (define *epoc-date* (let1 date (make <date> :year 1900 :mon 1 :day 1) ; 1900/1/1 is Monday date)) ;; 0 is Monday (define-method wday ((self <date>)) (remainder (x->number self) 7)) (define-method x->string ((self <date>)) (format #f "~a/~a/~a(~a)" (slot-ref self 'year) (slot-ref self 'mon) (slot-ref self 'day) (list-ref '(Mon Tue Wed Thu Fri Sat Sun) (wday self)))) ;; convert a date into a number of days count from *epoc-date* (define-method x->number ((self <date>)) (if (< self *epoc-date*) (error "given date too old") (let loop ((num 0) (prv #f) (stp 1024)) (if (< (+ *epoc-date* num) self) (loop (+ num stp) num stp) (if (< 1 stp) (loop prv #f (ash stp -1)) num))))) (define (main args) (let ((min-date (make <date> :year 1901 :mon 1 :day 1)) (max-date (make <date> :year 2000 :mon 12 :day 31))) (let loop ((y (slot-ref min-date 'year)) (m (slot-ref min-date 'mon)) (n 0)) (let1 date (make <date> :year y :mon m :day 1) ; first day of the month (display ".") (flush) ; display the progress (if (<= date max-date) (if (< m 12) (loop y (+ m 1) ; increment month (if (= (wday date) 6) (+ 1 n) n)) ; 6 is Sun (loop (+ y 1) ; increment year 1 (if (= (wday date) 6) (+ 1 n) n))) ; 6 is Sun (begin (newline) (print n)))))) 0)
よく考えるとこれまで日付計算を真面目にやったことがなかったような気がするので、効率的な計算方法がいまいち思いつかない。とりあえず、1901年から計算しないといけないので、Unix 時間を普通に使うのは無理なことくらいは分かる。
ひとまず、問題文から与えられた情報のみから曜日を求めるため、1900年1月1日をエポック日として定義したうえ、エポック日との差を元に特定の日の曜日を計算できるようにしてみた。
効率は死ぬ程悪いもののひとまず動くようにはなった。解き終わってから他の人がどんな風に解いてるのかと思って調べてみたら、曜日計算を行なうための公式なんてものがあったことを知る。(=> ツェラーの公式 - Wikipedia) …もっと精進しなきゃいかんですね。
Project Euler: Problem 36
The decimal number, 585 = 1001001001_(2) (binary), is palindromic in both bases.
Find the sum of all numbers, less than one million, which are palindromic in base
10 and base 2.(Please note that the palindromic number, in either base, may not include leading zeros.)
1000000 以下の整数の中で、10進数で書いても2進数で書いても回文になってる数字を全て探してその合計を求めよ、とのこと。
Gauche で書いてみた。
#!/usr/bin/env gosh (define (reverse-string str) (list->string (reverse (string->list str)))) (define (number-palindromic? num) (and (number-palindromic-decimal? num) (number-palindromic-binary? num))) (define (number-palindromic-decimal? num) (let1 str (number->string num 10) (equal? str (reverse-string str)))) (define (number-palindromic-binary? num) (let1 str (number->string num 2) (equal? str (reverse-string str)))) (define (main args) (let loop ((num 1) (sum 0)) (if (< num 1000000) (loop (+ num 1) (if (number-palindromic? num) (+ sum num) sum)) (print sum))) 0)
10進数をひっくり返すのは以前に作ったものを流用しようかと思ったけど、2進数をうまい具合に逆順にする方法が思いつかず。1 bitづつコピーするのもアホっぽいので、とりあえず、文字列にして処理してる。やっぱりアホっぽい。
Project Euler: Problem 25
The Fibonacci sequence is defined by the recurrence relation:
F(n) = F(n−1) + F(n−2), where F(1) = 1 and F(2) = 1.
Hence the first 12 terms will be:
F(1) = 1
F(2) = 1
F(3) = 2
F(4) = 3
F(5) = 5
F(6) = 8
F(7) = 13
F(8) = 21
F(9) = 34
F(10) = 55
F(11) = 89
F(12) = 144The 12th term, F(12), is the first term to contain three digits.
What is the first term in the Fibonacci sequence to contain 1000 digits?
http://projecteuler.net/index.php?section=problems&id=25
1000 桁を越える最初のフィボナッチ数は第何項目のものであるか求めよ、とのこと。
Gauche で書いてみた。
#!/usr/bin/env gosh (define (fibonacci n) (if (< n 1) 0 (let loop ((n n) (r 1) (m 0)) (if (< 1 n) (loop (- n 1) (+ r m) r) r)))) (define (number-length num) (string-length (number->string num))) (define (main args) (let loop ((num 1) (prv 0) (stp 1000)) (let1 len (number-length (fibonacci num)) (if (< len 1000) ; if not reached, do normal way; add step to num (loop (+ num stp) num stp) (if (= stp 1) ; step = 1 means that this count-up have been already backtracked (print num) (loop prv ; otherwise, divide the step by 10, and try backtrack. prv (quotient stp 10)))))) 0)
(fibonacci n) は以前に書いたものを使いまわした。
1 番目のフィボナッチ数から始めて、適当に桁数を調べ上げる。そのまんまループを回してみたら時間がかかりそうだったので、適当にステップ数を段階的に調整するようにしてみた。
10進数での桁数はめんどいので文字列にしてから長さを調べたけど、ちょっと無駄な気もするが、とりあえず動いた。
Project Euler: Problem 20
数を稼ぐために、ひとまず簡単そうなのから先に潰していく方針に変更。Problem 20。
n! means n * (n - 1) * ... * 3 * 2 * 1
Find the sum of the digits in the number 100!
http://projecteuler.net/index.php?section=problems&id=20
100! の計算結果に含まれる数字の合計を求めよとのこと。
Gauche で書いた。
#!/usr/bin/env gosh (define (fact n) (let loop ((n n) (r 1)) (if (zero? n) r (loop (- n 1) (* r n))))) (define (main args) (let loop ((num (fact 100)) (sum 0)) (if (< 0 num) (loop (quotient num 10) (+ sum (remainder num 10))) (print sum))) 0)
適当に (fact n) を求めたうえで、適当に各桁の合計を足し込んでみた、だけ。
Project Euler: Problem 14
Problem 14 をやってなかったのでやってみた。
The following iterative sequence is defined for the set of positive integers:
n -> n/2 (n is even)
n -> 3n + 1 (n is odd)Using the rule above and starting with 13, we generate the following sequence:
13 -> 40 -> 20 -> 10 -> 5 -> 16 -> 8 -> 4 -> 2 -> 1
It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.
Which starting number, under one million, produces the longest chain?
NOTE: Once the chain starts the terms are allowed to go above one million.
http://projecteuler.net/index.php?section=problems&id=14
ある自然数 n を、n が偶数のときにn/2、奇数のときに 3n + 1 に変形させていくと、最終的に 1 が得られることが知られている(=> コラッツの問題 - Wikipedia)。100 万以下の自然数を同様に変形させた場合、変形に要する回数が最も多い数はどれか求めよ、でいいのかな。
Gauche で書いてみた。
#!/usr/bin/env gosh (define (collatz num) (let loop ((num num) (lis '())) (if (= num 1) (reverse (cons num lis)) (loop (if (even? num) (quotient num 2) (+ 1 (* 3 num))) (cons num lis))))) (define (main args) (let loop ((n 1) (m '())) (if (< n 1000000) (let1 x (length (collatz n)) (loop (+ n 1) (if (or (null? m) (< (cdr m) x)) (cons n x) m))) (print (car m)))) 0)
コラッツの問題の定義通りに変形させた結果をリストで返す (collatz) を定義してから、安直に 1000000 以下の自然数に対してリストの長さを調べている。
とりあえず動いたのでひとまず良しとしてしまったけど、実行にはけっこう時間がかかる。参考までに手元の MacBook で実行した結果は以下の通り。
% time ./problem14.scm ****** ./problem14.scm 39.30s user 0.67s system 87% cpu 45.495 total
もっと頭の良い解きかたをしないとかっこわるいかなぁ。
