projecteuler19

　projecteuler の 問題19 は、1901 年から 2000 年までで日曜日から始まる月の回数を数えるもの。
　条件として与えられるのが、

・1900/1/1 は月曜日
・4 月、6 月、9 月、11 月は 30 日あり、残りは 2 月を除いて 31 日。
　2月は 28 日とうるう年の 29 日がある
・うるう年は 4 で割り切れる年で、100 で割り切れる年は含まないが、400 で割り切れる年は含まれる

　ということ。だから、うるう年かどうかを判定する関数は

(define (leap y)
  (or (= 0 (% y 400)) (and (= 0 (% y 4)) (!= 0 (% y 100)))))

　こんなところ。
　上記条件から 1900 年はうるう年ではないので、1901/1/1 は火曜日となる。
　だから、答えを求めるスクリプトは

(setq mn '(31 28 31 30 31 30 31 31 30 31 30 31)
      ml '(31 29 31 30 31 30 31 31 30 31 30 31))
(let (res '() cnt 0 days 2)
  (for (y 1901 2000) (push (if (leap y) ml mn) res -1))
    (dolist (x (chop (flat res)))
      (++ days x)
      (if (= 0 (% days 7)) (++ cnt)))
  cnt)

　こんな感じ。
　最初の for 文で与えらえた期間の月ごとの日数のリストを作り、ひと月ずつ足していって、日曜日かどうかを判定して変数 cnt を増加させているだけ。
　先の関数 leap と併せて実行すれば、

171

　という結果が得られます。

　以上、如何でしょうか？

projecteuler67．．．または、URLファイルの読み込み

　projecteuler の 問題67 は、前回の 問題18 と同じで段数が１００段なだけ。
　さすがに１００段の数字ともなるとは別 URL になっています。そこで、１００段の数字の読み込みに get-url を使います。
　あとは前回と同じで、スクリプトは

(silent)
(setq url "https://projecteuler.net/project/resources/p067_triangle.txt")
(setq triangle
      (map (fn (x) (parse x " "))
      (replace "" (parse (get-url url 1000) "\n"))))
(let (res (map list (map (fn(x) (int x 0 10)) (pop (reverse triangle)))))
  (dolist (r triangle)
    (let (tmp)
    (dolist (c (map (fn(x) (int x 0 10)) r))
      (push (if (> (apply + (res $idx)) (apply + (res (+ 1 $idx)))) 
        (cons c (res $idx)) (cons c (res (+ 1 $idx))))
        tmp -1))
    (setq res tmp)))
 (println (res 0))
 (println (apply + (res 0))))

　silent を使って余分な表示を抑え、必要なものだけ println で表示させるようにしました。
　これを実行すれば、

(59 73 52 53 87 57 92 81 81 79 81 32 86 82 97 55 97 36 62 65 90 93 95 54 71 77 68 
 71 94 8 89 54 42 90 84 91 31 71 93 94 53 69 73 99 89 47 80 96 81 52 98 38 91 78 
 90 70 61 17 11 75 74 55 81 87 89 99 73 88 95 68 37 87 73 77 60 82 87 64 96 65 47 
 94 85 51 87 65 65 66 91 83 72 24 98 89 53 82 57 99 98 95)
7273

　筋道と答えの 7273 が出てきます。

　以上、如何でしょうか？

projecteuler18．．．または、先読み問題？

　projecteuler の 問題18 は、三角形に並べられた数値を足して、最大になる道筋の和を求めるもの。
　例題は４段ですが、本番は１５段で道筋は 16384（2の14乗）通り。
　全ての道筋を計算してもいいですが、注記にもあるように問題67では１００段ありますので、ここは一工夫要りそうです（汗）
　上から順に追って行くと回答が得られるまですべての道筋を通らざるを得ないので、発想を変えて下から追ってみます。
　例題でいえば、
　３段目の 2 が取れるのは 8 か 5 なので 8、4 は 9 、6 も 9 と一意に決まる。
　同様に、２段目の 7 は 4+9 の道筋、4 は 6+9 の道筋となる。
　最後の１段目は 7+4+9 を取るか 4+6+9 を取るかなので、おのずと決まる。
　これでいけそう。先読みならぬ逆読み（笑）
　スクリプトにすると、

(setq triangle
        (map (fn (x) (parse x " "))
          (replace "" (parse 
[text]
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
[/text]  "\n"))))
(let (res (map list (map (fn(x) (int x 0 10)) (pop (reverse triangle)))))
  (dolist (r triangle)
    (let (tmp)
      (dolist (c (map (fn(x) (int x 0 10)) r))
        (push (if (> (apply + (res $idx)) (apply + (res (+ 1 $idx)))) 
          (cons c (res $idx)) (cons c (res (+ 1 $idx))))
          tmp -1))
      (setq res tmp)))
  (println (res 0))
  (apply + (res 0)))

　こんな感じ。これを実行すれば、

(("75")
 ("95" "64")
 ("17" "47" "82")
 ("18" "35" "87" "10")
 ("20" "04" "82" "47" "65") 
 ("19" "01" "23" "75" "03" "34") 
 ("88" "02" "77" "73" "07" "63" "67") 
 ("99" "65" "04" "28" "06" "16" "70" "92") 
 ("41" "41" "26" "56" "83" "40" "80" "70" "33") 
 ("41" "48" "72" "33" "47" "32" "37" "16" "94" "29") 
 ("53" "71" "44" "65" "25" "43" "91" "52" "97" "51" "14") 
 ("70" "11" "33" "28" "77" "73" "17" "78" "39" "68" "17" "57") 
 ("91" "71" "52" "38" "17" "14" "91" "43" "58" "50" "27" "29" "48") 
 ("63" "66" "04" "68" "89" "53" "67" "30" "73" "16" "69" "87" "40" "31") 
 ("04" "62" "98" "27" "23" "09" "70" "98" "73" "93" "38" "53" "60" "04" "23"))
(75 64 82 87 82 75 73 28 83 32 91 78 58 73 93)
1074

　こんな風に答え 1074 が出てきます。
　さて、解説するまでもないですが、$idx はシステム変数でここでは dolist のインデックス値が入っています。また、newLISP の reverse は Common Lisp の nreverse 相当で破壊的関数です。ご注意を。

　以上、如何でしょうか？

projecteuler17．．．または、英数字表記の問題

　日本人には.、あまりなじみのない問題なのが projecteuler の 問題17。
　1 から 1000 の数値を英字に変えて、アルファベット文字数を数えるのですから。
　英語だと 20 までは固有名詞があるから

(setq c1 (map string  '(zero one two three four five six seven eight nine ten eleven twelve thirteen fourteen fifteen seventeen sixteen eighteen nineteen twenty)))

　と定義しておけば、

> (map 'c1 (sequence 1 20))
("one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" 
 "thirteen" "fourteen" "fifteen" "seventeen" "sixteen" "eighteen" "nineteen" "twenty")
> 

　こんな風に変換できます。だから、例題の〝1 から 5 まで〟なら

> (map 'c1 (sequence 1 5))
("one" "two" "three" "four" "five")
> (length (apply string (map 'c1 (sequence 1 5))))
19
> 

　これで十分だけど、ここからが問題。1000 までありますからね、、、
　20 以上の 10 の位とそれ以上の桁の単位を用意して、

(setq c2 (map string '(twenty thirty forty fifty sixty seventy eighty ninety)))
(setq c3 (map string '(hundred thousand million billion)))

　それぞれの桁に応じた変換スクリプトを用意する。

(define (before100 num)
  (if ( m 0) (string "-" (c1 m)) "")))
  ))
(define (before1000 num)
  (let (i (/ num 100) m (% num 100))
    (string (c1 i) " " (c3 0)  (if (> m 0) (string " and " (before100 m)) ""))
  ))
(define (num2words num)
  (if (< num 100) (before100 num)
      (< num 1000) (before1000 num)
      (string "one " (c3 1))
  ))

　これを使えば、20 より上は

> (map num2words '(22 33 44 55 66 77 88 99))
("twenty-two" "thirty-three" "forty-four" "fifty-five" "sixty-six" "seventy-seven" 
 "eighty-eight" "ninety-nine")
> (map num2words '(111 222 333 444 555 666 777 888 999))
("one hundred and eleven" "two hundred and twenty-two" "three hundred and thirty-three" 
 "four hundred and forty-four" "five hundred and fifty-five" "six hundred and sixty-six" 
 "seven hundred and seventy-seven" "eight hundred and eighty-eight" "nine hundred and ninety-nine")
> (num2words 1000)
"one thousand"
> 

　こんな感じ。1000 までですけど（汗）
　これで準備は完了、答え一発

> (length (replace "[ -]" (apply append (map num2words (sequence 1 1000))) "" 1))
21124
> 

　こんなところ。
　さて、解説はするまでもない（笑）

　以上、如何でしょうか？

projecteuler16．．．または、大整数の使い方

　projecteuler の 問題16 は、2 の 1000 乗を求め、桁ごとの数値を足した和を求める問題。
　ポイントは、300桁以上ある 2 の 1000 乗を桁落ち無しで求めること。
　64ビット整数では 21桁 が限度ですから、その桁数が大きさが問題となっている訳です。
　でも、newLISP には大整数がありますので、全く問題になりません（笑）
　答えは、

> (let (res (apply * (dup 2L 1000))) res)
10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376L
> (let (res (apply * (dup 2L 1000))) (apply + (map int (explode (chop (string res))))))
1366
> 

　ざっと、こんなもん。
　さて、解説ですが、数値の末尾に L を付けると大整数になります。
　string で 文字列にして、explode で各桁数に分解し、int で整数にもどして、足すだけ。
　chop は大整数の L を外すためのもの。
　int のオプションを使って

> (let (res (apply * (dup 2L 1000))) (apply + (map (fn (x) (int x 0)) (explode (string res)))))
1366
> 

　とすることもできます。

　以上、如何でしょうか？