projecteuler20

　projecteuler の 問題20 は、100 の階乗を求め、各桁を足した和を求めるという問題。
　桁数に制限のない大整数のある newLISP とって、得意とするところ。

> (apply * (map bigint (sequence 1 100)))
93326215443944152681699238856266700490715968264381621468592963895217599993229915
608941463976156518286253697920827223758251185210916864000000000000000000000000L
> (apply + (map int (explode (chop (string (apply * (map bigint (sequence 1 100))))))))
648
> 

　これでおしまい。答えは 648 。
　これでは、解説しようが無い（笑）

　以上、如何でしょうか？

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
> 

　とすることもできます。

　以上、如何でしょうか？

newLISP マニュアル v.10.6.2 日本語訳公開

　久々の安定版のリリース。
　新規関数として collect が追加されています。
　また、 正規表現オプションが数値だけではなく、文字でも指定できるようになっています。
　もちろん、ウェブ・ブラウザ上の newLISP in a browser も v.10.6.2 です。
　ということで、newLISP の User Manual and Reference、Code Patterns の全訳のリリースです。

newlisp_manual-10602
CodePatterns-10602
こちらからダウンロードしてください。

　目次も含め日本語併記にしてあります。
　Lutz氏のご好意によりこちらから見ることもできます。

　いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報ください。

　以上、如何でしょうか？

FOOP で DAG する、その２

　前回の FOOP で DAG する は如何だったでしょうか？
　今回は、DAG (Directed acyclic graph) で a 地点から b 地点までの経路を検索するスクリプトを追加してみます。
　ということで、コードは、

(define (DAG:search a b (res '()))
  (let (connects (DAG:search-pre b))
    (if (= connects "start") nil
      (dolist (c connects)
        (let (tmp (append (list c) res))
          (if (= (c 0) a) (push tmp DAG:result -1)
            (DAG:search a (c 0) tmp)))))))
(define (DAG:search-a2b a b)
   (setq DAG:result '())
   (DAG:search a b)
   DAG:result)

　何と DAG データの引き渡しらしき箇所がない（笑）、、、FOOP ですから。
　これを前回のスクリプトに追加して実行します。
　使い方は、

> (setq mydag2 (DAG '((a b) (b c) (b d) (b e) (g d) (c e) (d e) (e f))))
(DAG ((a b) (b c) (b d) (b e) (g d) (c e) (d e) (e f)))
> (:search-a2b mydag2 'g 'f)
(((g d) (d e) (e f)))
> (:search-a2b mydag2 'a 'f)
(((a b) (b e) (e f)) ((a b) (b c) (c e) (e f)) ((a b) (b d) (d e) (e f)))
> 

　こんな感じ。

　以上、如何でしょうか？

FOOP で DAG する

　前回の DAG スクリプトは如何だったでしょうか？
　search-XXX なんて関数名は有りがちな名前。そんな時、関数名の衝突を避けるには FOOP（Functional-Object Oriented Programming ）なんてもってこい。
　とは言え、newLISP の目玉でもある FOOP を使ってこなかった私。この辺で覚書きでも作っておこうかと、、、
　
　ということで、コードは、

(new Class 'MAIN:DAG)

(define (DAG:DAG lst)
    (list DAG lst))
(define (DAG:nodes)
  (self 1))
(define (DAG:search-pre)
  (letex (_x (args 0))
    (if (find-all '(? _x) (self 1)) $it "start")))
(define (DAG:search-next)
  (letex (_x (args 0))
    (if (find-all '(_x ?) (self 1)) $it "end")))
(define (DAG:search-all)
  (letex (_x (args 0))
    (local (res)
      (dolist (x (self 1))
         (if (match '(? _x) x) (push x res -1)
             (match '(_x ?) x) (push x res -1)))
      res)))

　ポイントは、オブジェクト・データ部分のアクセスが self になること。
　とわかっていても、私には慣れが必要かも。引数の扱いが、、、
　さて、使い方は、

> (set 'mydag (DAG '((a c) (b c) (c d) (c g) (d e) (d f))))
(DAG ((a c) (b c) (c d) (c g) (d e) (d f)))
> (:nodes mydag)
((a c) (b c) (c d) (c g) (d e) (d f))
> (:search-all mydag 'd)
((c d) (d e) (d f))
> (:search-pre mydag 'd)
((c d))
> (:search-next mydag 'd)
((d e) (d f))
> (:search-pre mydag 'a)
"start"
> (:search-next mydag 'g)
"end"
> 

　こんな感じ。

　以上、如何でしょうか？

newLISP で DAG する．．．または、match な find-all

　DAG (Directed acyclic graph) とは有向非巡回グラフのことらしい。
　といっても、DAG が何かわからずにコードを書いた私。
　きっかけは、newLISP Foram の投稿から。
　これは簡単にコード化はできそうだと思い、書いて投降したのですが、、、
　何か、しっくりこなかったのです。newLISP らしくないというか、、、
　同投稿で rickyboy 氏が find に match を使っているのを見て、思い出しました。 find-all がリストに対して match になる（第二構文）ことを。

(if (replace nil (map (fn (x) (match '(? _x) x true)) lst)) $it "start")

　なんて、長ったらしいコードは、find-all を使えば、

(if (find-all '(? _x) lst) $it "start")

　ああ、すっきり。
　前にも、こんなことがあったのを思い出し、忘れないよう blog に（笑）
　先に newLISP Foram に投降したコードは、こんな感じに変わります。

(define (search-pre lst)
  (letex (_x (args 0))
    (if (find-all '(? _x) lst) $it "start")))
(define (search-next lst)
  (letex (_x (args 0))
    (if (find-all '(_x ?) lst) $it "end")))
(define (search-all lst)
  (letex (_x (args 0))
    (local (res)
      (dolist (x lst)
         (if (match '(? _x) x) (push x res -1)
             (match '(_x ?) x) (push x res -1)))
      res)))

　ついでに newLISP らしく、if の cond 的な使い方も（笑）

　以上、如何でしょうか？