projecteuler30
コメントする projecteuler の 問題30は、自然数の各桁の 5 乗の和が、その自然数になるものを求め、その和を取るという問題。
だから（汗）、スクリプトは力技で、
(define (pf i)
(* i i i i i))
(let (lst)
(for (i 2 999999)
(if (= i (apply + (map pf (map int (explode (string i))))))
(push i lst -1))
)
(println lst)
(apply + lst)
) こんな感じ。
これを実行すると
(4150 4151 54748 92727 93084 194979) 443839 >
と、自然数のリストとその和が出てきます。
つまり、答えは 443839 。
以上、如何でしょうか？
日付関数の日本語化、解説編．．．または、2038年問題対応？
今回実装した関数 jdate, jdate:list, jdate:parse, jdate:value, jdate:now の内、list, parse, now は newLISP 組込関数と名前が同じです。通常、組込関数名は変数名にも関数名にも使えませんが、コンテキスト内でコンテキスト名を先付けして
jdate:list, jdate:parse, jdate:now
とすれば、定義できます。
また、これらを定義した場合、同名の newLISP 組込関数の呼び出しには、
MAIN:list, MAIN:parse, MAIN:now
と書く必要もあります。
それさえ気を付ければ、使いたい変数名や関数名が newLISP 組込関数名と同じだと嘆く必要はありません。まあ、そんなことは、無いでしょうけど（笑）
この点が今回実装のポイントの一つです。
さて、日付間の日本語化、前にも実装したことがあります。
今回、敢えて実装したのは、前述のようにコンテキストにまとめたかったのと、2038年問題にも対応しておこうと思ったからです。
newLISP は標準ライブラリを使って、あらゆるプラットフォームでの互換性を維持しています。そのため、日付に関する経過秒数を表現する型 time_t は、符号つき 32 ビットで 2038年1月19日3時14分7秒 までしか表現できません。これは、 64 ビット版 newLISP でも同じで、互換性維持のためだと思いますが、敢えて符号つき 32 ビットを使っています。
だから、これは仕様です。まあ、あと20年はありますから、それまでに解決されるでしょうけど、、、
それでも、20年くらい先はまだ生きていると思うので、その頃の予定を立てることがあるかもしれません。だから、取り敢えず、符号なし 32 ビット （2106年2月7日6時28分15秒相当）で実装してみました。本来なら、64 ビットで定義すべきですが、2100 年以降の予定なんて考えないから、これで十分かと（笑）
calcDateValue と gmtime が、そのための関数です。
一応、
> (jdate:value 2038 1 8) 2146489200 > (jdate:value 2106 2 6) 4294825200 > (jdate:parse "2106.2.6 6:28" "%Y.%m.%d %H:%M") 4294848480 > (jdate:list (jdate:parse "2106.2.6 6:28" "%Y.%m.%d %H:%M")) (2106 2 6 6 28 0 37 6) >
こんな感じで、使えます。
以上、如何でしょうか？
追記：
V10.7.0 の windoows 版で now を実行すると
> (now) (2016 3 16 8 54 40 297940 76 3 600 -60) >
このように、タイムゾーンのオフセット（分単位）が 600 となります。
日本では 540 のはずなので、V10.7.0 の windoows 版のバグです。
この点については Lutz氏 もわかっていて、次回、訂正されるそうです。
それまで、ご注意を。
日付関数の日本語化
newLISP の日付関数には、date, date-list, date-parse, date-value, now 等がありますが、date 以外はグリニッジ標準時なので、日本時間で使うには補正が必要です。
また、date も
> (date) "Tue Mar 15 16:00:19 2016" >
こんな風に、英語表記です。
そこで、日本語表記、日本時間用の日付関数を定義してみました。
(context 'MAIN:jdate)
(setq YEAR0 1900 EPOCH_YR 1970 SECS_DAY (* 24 60 60))
(define (calcDateValue year month day (hour 0) (int-min 0) (sec 0))
; Algorithm quoting from newLISP source.
(let (dateValue)
(setq dateValue (+ (* 367 year) (- (/ (* 7 (+ year (/ (+ month 9) 12))) 4)) (/ (* 275 month) 9) day 1721013))
(setq dateValue (+ (* dateValue 24 3600) (* hour 3600) (* int-min 60) sec -413319296))
(setq dateValue (& dateValue 0xFFFFFFFF))
(if (>= dateValue 4107596400) (-- dateValue 86400) dateValue)))
(define (leap (y ((now) 0)))
(if (and (zero? (% y 4))
(or (zero? (% y 400))
(not (zero? (% y 100))))) 1 0))
(define (yearsize year) (+ (leap year) 365))
(define _ytab '((31 28 31 30 31 30 31 31 30 31 30 31)(31 29 31 30 31 30 31 31 30 31 30 31)))
(define (gmtime tm)
; Algorithm quoting from common C-library source.
(letn (year EPOCH_YR
dayclock (% tm SECS_DAY)
dayno (/ tm SECS_DAY)
tm_sec (% dayclock 60)
tm_min (/ (% dayclock 3600) 60)
tm_hour (/ dayclock 3600)
tm_wday (% (+ 4 dayno) 7))
(while (>= dayno (yearsize year))
(-- dayno (yearsize year))
(++ year))
(let (tm_year (- year 0); YEAR0
tm_yday dayno
tm_mon 0
tm_mday 1)
(while (>= dayno (_ytab (leap year) tm_mon))
(-- dayno (_ytab (leap year) tm_mon))
(++ tm_mon))
(++ tm_mday dayno)
(list tm_year (++ tm_mon) tm_mday tm_hour tm_min tm_sec (++ tm_yday) tm_wday))))
(define (jdate:now (offset 540) idx)
(if idx (MAIN:now offset idx) (MAIN:now offset)))
(define (jdate:value)
(if (args) (- (apply calcDateValue (args)) (* 9 60 60))
(date-value)))
(define (jdate:list (sec (jdate:value)) idx)
(letn (offset (* 9 60 60)
lst (gmtime (+ sec offset)))
(if idx (idx lst) lst)))
(define (jdate:jdate (value (jdate:value)))
(let (lst (jdate:list value)
str (if utf8 '(227 128 63 230 156 136 231 129 171 230 176 180 230 156 168 233 135 145 229 156 159
230 151 165)
'(129 64 140 142 137 206 144 133 150 216 139 224 147 121 147 250)))
(append (join (map string (0 3 lst)) "/") " "
(join (map string (3 3 lst)) ":") " "
(if utf8 ((* 3 (lst 7)) 3 (pack (dup "b" (length str)) str))
((* 2 (lst 7)) 2 (pack (dup "b" (length str)) str))))))
(define (jdate:parse dateStr formatStr , res)
(if (= formatStr "%c") (setq formatStr "%m/%d/%y %H:%M:%S"))
(let (specs (find-all "(%.)" formatStr)
regStr (replace "(%.)" (replace "." formatStr "\\.") "(.+)" 0)
months '("" "Jan" "Feb" "Mar" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
Months '("" "January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December")
dateLst '(1900 1 1 0 0 0))
(setq res (regex regStr dateStr))
(when res
(setq res (rest (filter string? res)))
(when (= (length specs) (length res))
(dolist (i (transpose (MAIN:list specs res)))
(case (i 0)
("%b" (setf (dateLst 1) (find (i 1) months 1)))
("%B" (setf (dateLst 1) (find (i 1) Months 1)))
("%d" (setf (dateLst 2) (int (i 1) 0 10)))
("%H" (setf (dateLst 3) (int (i 1) 0 10)))
("%m" (setf (dateLst 1) (int (i 1) 0 10)))
("%M" (setf (dateLst 4) (int (i 1) 0 10)))
("%S" (setf (dateLst 5) (int (i 1) 0 10)))
("%Y" (setf (dateLst 0) (int (i 1) 0 10)))
("%y" (setf (dateLst 0) (int (string "20" (i 1)))))
(true )))))
(if-not (find nil dateLst) (apply jdate:value dateLst))))
(context MAIN) 使える関数は、jdate, jdate:list, jdate:parse, jdate:value, jdate:now で、それぞれ date, date-list, date-parse, date-value, now に対応します。
使い方は、
> (jdate) "2016/3/16 17:8:15 火" > (jdate:list) (2016 3 16 17 8 23 75 2) > (jdate:value 2016 3 16) 1458054000 > (jdate:now) (2016 3 15 17 8 48 630885 75 2 600 -60) > (jdate:parse "2010.10.18 7:00" "%Y.%m.%d %H:%M") 1287352800 > (jdate:list (jdate:parse "2010.10.18 7:00" "%Y.%m.%d %H:%M")) (2010 10 18 7 0 0 291 1) >
こんな感じ、解説は次回に、、、
newLISP マニュアル v.10.7.0 日本語訳公開
久々の安定版リリース。
新規関数として、統計でよく使われる二乗和関数 ssq が追加されています。
また、Windows 用に 64ビット版が用意されています。それに伴い、組込定数 ostype が Windows版では “Windows”になります。ご注意を。
ということで、newLISP の User Manual and Reference、GUI functions、Code Patterns の全訳のリリースです。
newlisp_manual-10700
guiserver_manual-171
CodePatterns-10700
こちらからダウンロードしてください。
目次も含め日本語併記にしてあります。
Lutz氏のご好意によりこちらから見ることもできます。
いつものように、間違いやおかしな点が有りましたら、こちらの blog までご一報ください。
以上、如何でしょうか？
projecteuler29
projecteuler の 問題29は、2 から 100 までの自然数を 2 乗から 100乗 して、同じものを除くと何個になるかという問題。
だから、スクリプトは単純、
(let (lst)
(for (i 2 100)
(for (j 2 100)
(push (apply * (cons 1L (dup i j))) lst -1)
)
)
(length (unique lst)))こんな感じ。1L を cons しているのは、大整数にするため。100 乗するには 64 ビット整数では足りないですからね（笑）
(let (lst)
(for (i 2 100)
(for (j 2 100)
(push (apply * (map bigint (dup i j))) lst -1)
)
)
(length (unique lst)))でも同じになります。
ここで bigint は整数を大整数に変換します。
また、unique は同一数値を除去してくれます。
これを実行すると
9183 >
と答えが求まります。
以上、如何でしょうか？
projecteuler28
projecteuler の 問題28は、自然数をらせん状に並べ、角の数値のみを足した和を求めるもの。といっても、一辺が 1001 になるまでですが（笑）
スクリプトは単純、
(let (i 1 j 2 lst '(1))
(while (< j 1001)
(dotimes (k 4) (++ i j) (push i lst -1))
(++ j 2))
(println lst)
(apply + lst)
) こんな感じ。一週ごとに求める自然数の間隔が2つずつ増えていくのがミソ。
これを実行すると
(1 3 5 7 9 13 17 21 25 31 37 43 49 57 65 73 81 91 101 111 121 133 145 157 169 183 ： 986049 987043 988037 989031 990025 991021 992017 993013 994009 995007 996005 997003 998001 999001 1000001 1001001 1002001) 669171001 >
答え 669171001 が求まります。
以上、如何でしょうか？
projecteuler27
projecteuler27
projecteuler の 問題27は、二次方程式
n^2 + an + b, where |a| < 1000 and |b| < 1000
において、n = 0 から素数が続く数が最大となる係数を探し出し、その積を求めるもの。
何も考えずに力ずくで求めるスクリプトは、
(define (func n a b)
(+ b (* a n) (* n n)))
(setq lst '() len 1)
(for (i -999 999)
(for (j -999 999)
(let (k 0 res '() flag true)
(while flag
(let (ans (func k i j))
(if(and (> ans 0) (= 1 (length (factor ans)))) (push (list k i j) res -1)
(setq flag nil)))
(++ k))
(when (> (length res) len) (setq len (length res)) (push res lst -1)))))
(lst -1 -1)
(apply * (1 (lst -1 -1)))これを実行すると
(lambda (n a b) (+ b (* a n) (* n n))) 1 nil (70 -61 971) -59231 >
こんな感じで答え -59231 が求まります。
この時の二次方程式は
n^2 - 61n + 971
で n = 0 ～ 70 で 71 個の素数が作られます。
実際に計算してみると、
> (map (hayashi func -61 971) (sequence 0 70)) (971 911 853 797 743 691 641 593 547 503 461 421 383 347 313 281 251 223 197 173 151 131 113 97 83 71 61 53 47 43 41 41 43 47 53 61 71 83 97 113 131 151 173 197 223 251 281 313 347 383 421 461 503 547 593 641 691 743 797 853 911 971 1033 1097 1163 1231 1301 1373 1447 1523 1601) >
こんな感じ。
ここで関数 hayashi は拙作で、（newlisp-utility.lsp にあります）
(hayashi func -61 971)
は以下の式等価です。
(fn (x) (func x -61 971))
以上、如何でしょうか？
projecteuler26
projecteuler の 問題26は、1000より小さい自然数 d で、1/d の作る循環小数が最大の長さになる d を求めよという問題。
まず、循環小数の長さを求める関数を用意します。
(define (junkan n disp)
(let (m 1 s 0 t 0 flst '() mlst '() flag true)
(while flag
(setq f (/ m n) m (% m n))
(if (find m mlst) (setq flag nil))
(push f flst -1)
(if (and (= s 0) (!= f 0) (setq s t)))
(push m mlst -1)
(if (= m 0) (setq flag nil))
(setq m (* 10 m))
(++ t)
)
(if disp (begin
(println mlst)
(println (flst 0) "." (apply append (map string (1 flst))))
(println s " " (-- t)))
(-- t))
)
) 与えらえた数値 n で 1 を割り算して、商と余りを次々に求め、それぞれをリストに保存し、余りに同じものが出たら終了して、長さを返すもの。余計な表示部分もつけてありますが、、、
さて、どうせ求める答えは素数ですから、あらかじめ素数を求め、そこから答えを探します。
(let (i 3 lst '() cc 0 res)
(while (< i 1000)
(when (= (length (factor i)) 1) (push i lst -1))
(++ i 2))
(dolist (i lst)
(let (len (junkan i))
(if (< cc len) (setq cc len res i))))
res)
こんな感じで実行すると、
>983
という答えが得られます。
実際、どれくらいの循環かというと
> (junkan 983 true) (1 10 100 17 170 717 289 924 393 981 963 783 949 643 532 405 118 197 4 40 400 68 680 902 173 747 589 975 903 183 847 606 162 637 472 788 16 160 617 272 754 659 692 39 390 951 663 732 439 458 648 582 905 203 64 640 502 105 67 670 802 156 577 855 686 962 773 849 626 362 671 812 256 594 42 420 268 714 259 624 342 471 778 899 143 447 538 465 718 299 41 410 168 697 89 890 53 530 385 901 163 647 572 805 186 877 906 213 164 657 672 822 356 611 212 154 557 655 652 622 322 271 744 559 675 852 656 662 722 339 441 478 848 616 262 654 642 522 305 101 27 270 734 459 658 682 922 373 781 929 443 498 65 650 602 122 237 404 108 97 970 853 666 762 739 509 175 767 789 26 260 634 442 488 948 633 432 388 931 463 698 99 7 70 700 119 207 104 57 570 785 969 843 566 745 569 775 869 826 396 28 280 834 476 828 416 228 314 191 927 423 298 31 310 151 527 355 601 112 137 387 921 363 681 912 273 764 759 709 209 124 257 604 142 437 438 448 548 565 735 469 758 699 109 107 87 870 836 496 45 450 568 765 769 809 226 294 974 893 83 830 436 428 348 531 395 18 180 817 306 111 127 287 904 193 947 623 332 371 761 729 409 158 597 72 720 319 241 444 508 165 667 772 839 526 345 501 95 950 653 632 422 288 914 293 964 793 66 660 702 139 407 138 397 38 380 851 646 562 705 169 707 189 907 223 264 674 842 556 645 552 605 152 537 455 618 282 854 676 862 756 679 892 73 730 419 258 614 242 454 608 182 837 506 145 467 738 499 75 750 619 292 954 693 49 490 968 833 466 728 399 58 580 885 3 30 300 51 510 185 867 806 196 977 923 383 881 946 613 232 354 591 12 120 217 204 74 740 519 275 784 959 743 549 575 835 486 928 433 398 48 480 868 816 296 11 110 117 187 887 23 230 334 391 961 763 749 609 192 937 523 315 201 44 440 468 748 599 92 920 353 581 895 103 47 470 768 799 126 277 804 176 777 889 43 430 368 731 429 358 631 412 188 897 123 247 504 125 267 704 159 607 172 737 489 958 733 449 558 665 752 639 492 5 50 500 85 850 636 462 688 982 973 883 966 813 266 694 59 590 2 20 200 34 340 451 578 865 786 979 943 583 915 303 81 810 236 394 8 80 800 136 377 821 346 511 195 967 823 366 711 229 324 291 944 593 32 320 251 544 525 335 401 78 780 919 343 481 878 916 313 181 827 406 128 297 21 210 134 357 621 312 171 727 389 941 563 715 269 724 359 641 512 205 84 840 536 445 518 265 684 942 573 815 286 894 93 930 453 598 82 820 336 411 178 797 106 77 770 819 326 311 161 627 372 771 829 426 328 331 361 661 712 239 424 308 131 327 321 261 644 542 505 135 367 721 329 341 461 678 882 956 713 249 524 325 301 61 610 202 54 540 485 918 333 381 861 746 579 875 886 13 130 317 221 244 474 808 216 194 957 723 349 541 495 35 350 551 595 52 520 285 884 976 913 283 864 776 879 926 413 198 14 140 417 238 414 208 114 157 587 955 703 149 507 155 567 755 669 792 56 560 685 952 673 832 456 628 382 871 846 596 62 620 302 71 710 219 224 274 774 859 726 379 841 546 545 535 435 418 248 514 225 284 874 876 896 113 147 487 938 533 415 218 214 174 757 689 9 90 900 153 547 555 635 452 588 965 803 166 677 872 856 696 79 790 36 360 651 612 222 254 574 825 386 911 263 664 742 539 475 818 316 211 144 457 638 482 888 33 330 351 561 695 69 690 19 190 917 323 281 844 576 845 586 945 603 132 337 421 278 814 276 794 76 760 719 309 141 427 338 431 378 831 446 528 365 701 129 307 121 227 304 91 910 253 564 725 369 741 529 375 801 146 477 838 516 245 484 908 233 364 691 29 290 934 493 15 150 517 255 584 925 403 98 980 953 683 932 473 798 116 177 787 6 60 600 102 37 370 751 629 392 971 863 766 779 909 243 464 708 199 24 240 434 408 148 497 55 550 585 935 503 115 167 687 972 873 866 796 96 960 753 649 592 22 220 234 374 791 46 460 668 782 939 543 515 235 384 891 63 630 402 88 880 936 513 215 184 857 706 179 807 206 94 940 553 615 252 554 625 352 571 795 86 860 736 479 858 716 279 824 376 811 246 494 25 250 534 425 318 231 344 491 978 933 483 898 133 347 521 295 1) 0.0010172939979654120040691759918616480162767039674465920651068158697863682604272634791454730417090539165818921668362156663275686673448626653102746693794506612410986775178026449643947100712105798575788402848423194303153611393692777212614445574771108850457782299084435401831129196337741607324516785350966429298067141403865717192268565615462868769074262461851475076297049847405900305188199389623601220752797558494404883011190233977619532044760935910478128179043743641912512716174974567650050864699898270600203458799593082400813835198372329603255340793489318413021363173957273652085452695829094608341810783316378433367243133265513733468972533062054933875890132248219735503560528992878942014242115971515768056968463886063072227873855544252288911495422177009155645981688708036622583926754832146490335707019328585961342828077314343845371312309257375381485249237029501525940996948118006103763987792472024415055951169888097660223804679552390640895218718209562563580874872838250254323499491353 3 982 982 >
こんな感じで 982 桁でした。
以上、如何でしょうか？
projecteuler25
newLISP の length を数値に適用すると、整数部分の桁数が返ります。
ということで、projecteuler の 問題25は、フィボナッチ数が 1000桁になるのは何番目かという問題。
1000桁ですから大整数の出番。そして、前述のlengthを使えば、
(silent)
(setq fibo '(1L 1L))
(while (< (length (fibo -1)) 1000)
(push (+ (fibo -2) (fibo -1)) fibo -1))
(println (length fibo))これを実行すれば
> 4782
と答えが得られます。
silent は余計な表示を抑えるための関数。なくても答えは得られます。
リストの長さが求める答えになっているので、スクリプトの最後にも length を使っています。
フィボナッチ数列は変数 fibo に入っていますから、中身を覗くと
> (0 12 fibo) (1L 1L 2L 3L 5L 8L 13L 21L 34L 55L 89L 144L) > (fibo -1) 1070066266382758936764980584457396885083683896632151665013235203375314520604694040621889147582489792657804694888177591957484336466672569959512996030461262748092482186144069433051234774442750273781753087579391666192149259186759553966422837148943113074699503439547001985432609723067290192870526447243726117715821825548491120525013201478612965931381792235559657452039506137551467837543229119602129934048260706175397706847068202895486902666185435124521900369480641357447470911707619766945691070098024393439617474103736912503231365532164773697023167755051595173518460579954919410967778373229665796581646513903488154256310184224190259846088000110186255550245493937113651657039447629584714548523425950428582425306083544435428212611008992863795048006894330309773217834864543113205765659868456288616808718693835297350643986297640660000723562917905207051164077614812491885830945940566688339109350944456576357666151619317753792891661581327159616877487983821820492520348473874384736771934512787029218636250627816L > (length (fibo -1)) 1000 >
こんな感じ。
末尾に L が付いているのは、大整数の証。
以上、如何でしょうか？
projecteuler24
projecteuler の 問題24は、辞書的順列問題。0 から 9 までの数字を組み合わせた10桁の数値を辞書的に並べ、百万番目を求めるもの。
当然一番目は 0123456789 。先頭が 0 である数は
9! ＝ 362880 個。
とすれば、
1000000 － 2*362880 ＝ 274240
となり、解答は先頭が 2 の 274240 番目。
こんな風に各桁を求めれば、解答に行く着くはず。
これを関数にすれば
(define (make-ans cnt lst, (res '()))
(-- cnt)
(while (> cnt 0)
(let (cm (apply * (sequence 1 (-- (length lst)))))
(push (pop lst (/ cnt cm)) res -1)
(setq cnt (% cnt cm))))
(apply string (if lst (append res lst) res)))実際に試すと、
> (make-ans 1 (sequence 0 9)) "0123456789" > (make-ans 362880 (sequence 0 9)) "0987654321" > (make-ans 362881 (sequence 0 9)) "1023456789" > (make-ans 1000000 (sequence 0 9)) "2783915460" >
こんな感じ。
ちなみ、例題にある 0 から 2 の三桁も
> (map (hayashi make-ans (sequence 0 2)) '(1 2 3 4 5 6))
("012" "021" "102" "120" "201" "210")
> (map (fn (x) (make-ans x (sequence 0 2))) '(1 2 3 4 5 6))
("012" "021" "102" "120" "201" "210")
>
この通り。
hayashi は拙作の関数で二番目以降の引数を curry のように扱える関数で、newlisp-utility.lsp に置いてあります。
以上、如何でしょうか？
