From 7898a9252d7ade2dda2248273c101f512911afd0 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 15 Nov 2008 15:43:21 -0500 Subject: [PATCH 01/15] Cleanup PE solutions and formatting --- extra/project-euler/203/203-tests.factor | 4 +- extra/project-euler/203/203.factor | 67 +++++++++++++++++++++--- extra/project-euler/215/215.factor | 2 +- extra/project-euler/project-euler.factor | 2 +- 4 files changed, 65 insertions(+), 10 deletions(-) diff --git a/extra/project-euler/203/203-tests.factor b/extra/project-euler/203/203-tests.factor index 6c49c2f958..4922f9a8cc 100644 --- a/extra/project-euler/203/203-tests.factor +++ b/extra/project-euler/203/203-tests.factor @@ -1,5 +1,5 @@ -USING: project-euler.203 tools.test ; +USING: project-euler.203 project-euler.203.private tools.test ; IN: project-euler.203.tests [ 105 ] [ 8 solve ] unit-test -[ 34029210557338 ] [ 51 solve ] unit-test +[ 34029210557338 ] [ euler203 ] unit-test diff --git a/extra/project-euler/203/203.factor b/extra/project-euler/203/203.factor index 9a2916649e..f2b5a2e212 100644 --- a/extra/project-euler/203/203.factor +++ b/extra/project-euler/203/203.factor @@ -1,9 +1,64 @@ +! Copyright (c) 2008 Eric Mertens. +! See http://factorcode.org/license.txt for BSD license. USING: fry kernel math math.primes.factors sequences sets ; IN: project-euler.203 -: iterate ( n initial quot -- results ) swapd '[ @ dup ] replicate nip ; inline -: (generate) ( seq -- seq ) [ 0 prefix ] [ 0 suffix ] bi [ + ] 2map ; -: generate ( n -- seq ) 1- { 1 } [ (generate) ] iterate concat prune ; -: squarefree ( n -- ? ) factors duplicates empty? ; -: solve ( n -- n ) generate [ squarefree ] filter sum ; -: euler203 ( -- n ) 51 solve ; +! http://projecteuler.net/index.php?section=problems&id=203 + +! DESCRIPTION +! ----------- + +! The binomial coefficients nCk can be arranged in triangular form, Pascal's +! triangle, like this: + +! 1 +! 1 1 +! 1 2 1 +! 1 3 3 1 +! 1 4 6 4 1 +! 1 5 10 10 5 1 +! 1 6 15 20 15 6 1 +! 1 7 21 35 35 21 7 1 +! ......... + +! It can be seen that the first eight rows of Pascal's triangle contain twelve +! distinct numbers: 1, 2, 3, 4, 5, 6, 7, 10, 15, 20, 21 and 35. + +! A positive integer n is called squarefree if no square of a prime divides n. +! Of the twelve distinct numbers in the first eight rows of Pascal's triangle, +! all except 4 and 20 are squarefree. The sum of the distinct squarefree numbers +! in the first eight rows is 105. + +! Find the sum of the distinct squarefree numbers in the first 51 rows of +! Pascal's triangle. + + +! SOLUTION +! -------- + + + +: euler203 ( -- n ) + 51 solve ; + +! [ euler203 ] 100 ave-time +! 12 ms ave run time - 1.6 SD (100 trials) + +MAIN: euler203 diff --git a/extra/project-euler/215/215.factor b/extra/project-euler/215/215.factor index fc09b37515..82d6a31c66 100644 --- a/extra/project-euler/215/215.factor +++ b/extra/project-euler/215/215.factor @@ -9,7 +9,7 @@ IN: project-euler.215 ! ----------- ! Consider the problem of building a wall out of 2x1 and 3x1 bricks -! (horizontalvertical dimensions) such that, for extra strength, the gaps +! (horizontal x vertical dimensions) such that, for extra strength, the gaps ! between horizontally-adjacent bricks never line up in consecutive layers, ! i.e. never form a "running crack". diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 9549505bf6..60d35f27ad 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -20,7 +20,7 @@ USING: definitions io io.files kernel math math.parser project-euler.097 project-euler.100 project-euler.116 project-euler.117 project-euler.134 project-euler.148 project-euler.150 project-euler.151 project-euler.164 project-euler.169 project-euler.173 project-euler.175 - project-euler.186 project-euler.190 project-euler.215 ; + project-euler.186 project-euler.190 project-euler.203 project-euler.215 ; IN: project-euler Date: Sat, 15 Nov 2008 17:26:00 -0500 Subject: [PATCH 02/15] Solution to Project Euler problem 99 --- extra/project-euler/099/099-tests.factor | 5 + extra/project-euler/099/099.factor | 52 ++ extra/project-euler/099/base_exp.txt | 1000 ++++++++++++++++++++++ 3 files changed, 1057 insertions(+) create mode 100644 extra/project-euler/099/099-tests.factor create mode 100644 extra/project-euler/099/099.factor create mode 100644 extra/project-euler/099/base_exp.txt diff --git a/extra/project-euler/099/099-tests.factor b/extra/project-euler/099/099-tests.factor new file mode 100644 index 0000000000..d3d46d98b4 --- /dev/null +++ b/extra/project-euler/099/099-tests.factor @@ -0,0 +1,5 @@ +USING: project-euler.099 project-euler.099.private tools.test ; +IN: project-euler.099.tests + +[ 2 ] [ { { 2 11 } { 3 7 } } solve ] unit-test +[ 709 ] [ euler099 ] unit-test diff --git a/extra/project-euler/099/099.factor b/extra/project-euler/099/099.factor new file mode 100644 index 0000000000..ebc830cf00 --- /dev/null +++ b/extra/project-euler/099/099.factor @@ -0,0 +1,52 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings.ascii io.files kernel math math.functions math.parser + math.vectors sequences splitting ; +IN: project-euler.099 + +! http://projecteuler.net/index.php?section=problems&id=99 + +! DESCRIPTION +! ----------- + +! Comparing two numbers written in index form like 2^11 and 3^7 is not difficult, +! as any calculator would confirm that 2^11 = 2048 < 3^7 = 2187. + +! However, confirming that 632382^518061 519432^525806 would be much more +! difficult, as both numbers contain over three million digits. + +! Using base_exp.txt (right click and 'Save Link/Target As...'), a 22K text +! file containing one thousand lines with a base/exponent pair on each line, +! determine which line number has the greatest numerical value. + +! NOTE: The first two lines in the file represent the numbers in the example +! given above. + + +! SOLUTION +! -------- + +! Use logarithms to make the calculations necessary more manageable. + +number ] map ] map ; + +: simplify ( seq -- seq ) + #! exponent * log(base) + flip first2 swap [ log ] map v* ; + +: solve ( seq -- index ) + simplify [ supremum ] keep index 1+ ; + +PRIVATE> + +: euler099 ( -- answer ) + source-099 solve ; + +! [ euler099 ] 100 ave-time +! 16 ms ave run timen - 1.67 SD (100 trials) + +MAIN: euler099 diff --git a/extra/project-euler/099/base_exp.txt b/extra/project-euler/099/base_exp.txt new file mode 100644 index 0000000000..92201db6f5 --- /dev/null +++ b/extra/project-euler/099/base_exp.txt @@ -0,0 +1,1000 @@ +519432,525806 +632382,518061 +78864,613712 +466580,530130 +780495,510032 +525895,525320 +15991,714883 +960290,502358 +760018,511029 +166800,575487 +210884,564478 +555151,523163 +681146,515199 +563395,522587 +738250,512126 +923525,503780 +595148,520429 +177108,572629 +750923,511482 +440902,532446 +881418,505504 +422489,534197 +979858,501616 +685893,514935 +747477,511661 +167214,575367 +234140,559696 +940238,503122 +728969,512609 +232083,560102 +900971,504694 +688801,514772 +189664,569402 +891022,505104 +445689,531996 +119570,591871 +821453,508118 +371084,539600 +911745,504251 +623655,518600 +144361,582486 +352442,541775 +420726,534367 +295298,549387 +6530,787777 +468397,529976 +672336,515696 +431861,533289 +84228,610150 +805376,508857 +444409,532117 +33833,663511 +381850,538396 +402931,536157 +92901,604930 +304825,548004 +731917,512452 +753734,511344 +51894,637373 +151578,580103 +295075,549421 +303590,548183 +333594,544123 +683952,515042 +60090,628880 +951420,502692 +28335,674991 +714940,513349 +343858,542826 +549279,523586 +804571,508887 +260653,554881 +291399,549966 +402342,536213 +408889,535550 +40328,652524 +375856,539061 +768907,510590 +165993,575715 +976327,501755 +898500,504795 +360404,540830 +478714,529095 +694144,514472 +488726,528258 +841380,507226 +328012,544839 +22389,690868 +604053,519852 +329514,544641 +772965,510390 +492798,527927 +30125,670983 +895603,504906 +450785,531539 +840237,507276 +380711,538522 +63577,625673 +76801,615157 +502694,527123 +597706,520257 +310484,547206 +944468,502959 +121283,591152 +451131,531507 +566499,522367 +425373,533918 +40240,652665 +39130,654392 +714926,513355 +469219,529903 +806929,508783 +287970,550487 +92189,605332 +103841,599094 +671839,515725 +452048,531421 +987837,501323 +935192,503321 +88585,607450 +613883,519216 +144551,582413 +647359,517155 +213902,563816 +184120,570789 +258126,555322 +502546,527130 +407655,535678 +401528,536306 +477490,529193 +841085,507237 +732831,512408 +833000,507595 +904694,504542 +581435,521348 +455545,531110 +873558,505829 +94916,603796 +720176,513068 +545034,523891 +246348,557409 +556452,523079 +832015,507634 +173663,573564 +502634,527125 +250732,556611 +569786,522139 +216919,563178 +521815,525623 +92304,605270 +164446,576167 +753413,511364 +11410,740712 +448845,531712 +925072,503725 +564888,522477 +7062,780812 +641155,517535 +738878,512100 +636204,517828 +372540,539436 +443162,532237 +571192,522042 +655350,516680 +299741,548735 +581914,521307 +965471,502156 +513441,526277 +808682,508700 +237589,559034 +543300,524025 +804712,508889 +247511,557192 +543486,524008 +504383,526992 +326529,545039 +792493,509458 +86033,609017 +126554,589005 +579379,521481 +948026,502823 +404777,535969 +265767,554022 +266876,553840 +46631,643714 +492397,527958 +856106,506581 +795757,509305 +748946,511584 +294694,549480 +409781,535463 +775887,510253 +543747,523991 +210592,564536 +517119,525990 +520253,525751 +247926,557124 +592141,520626 +346580,542492 +544969,523902 +506501,526817 +244520,557738 +144745,582349 +69274,620858 +292620,549784 +926027,503687 +736320,512225 +515528,526113 +407549,535688 +848089,506927 +24141,685711 +9224,757964 +980684,501586 +175259,573121 +489160,528216 +878970,505604 +969546,502002 +525207,525365 +690461,514675 +156510,578551 +659778,516426 +468739,529945 +765252,510770 +76703,615230 +165151,575959 +29779,671736 +928865,503569 +577538,521605 +927555,503618 +185377,570477 +974756,501809 +800130,509093 +217016,563153 +365709,540216 +774508,510320 +588716,520851 +631673,518104 +954076,502590 +777828,510161 +990659,501222 +597799,520254 +786905,509727 +512547,526348 +756449,511212 +869787,505988 +653747,516779 +84623,609900 +839698,507295 +30159,670909 +797275,509234 +678136,515373 +897144,504851 +989554,501263 +413292,535106 +55297,633667 +788650,509637 +486748,528417 +150724,580377 +56434,632490 +77207,614869 +588631,520859 +611619,519367 +100006,601055 +528924,525093 +190225,569257 +851155,506789 +682593,515114 +613043,519275 +514673,526183 +877634,505655 +878905,505602 +1926,914951 +613245,519259 +152481,579816 +841774,507203 +71060,619442 +865335,506175 +90244,606469 +302156,548388 +399059,536557 +478465,529113 +558601,522925 +69132,620966 +267663,553700 +988276,501310 +378354,538787 +529909,525014 +161733,576968 +758541,511109 +823425,508024 +149821,580667 +269258,553438 +481152,528891 +120871,591322 +972322,501901 +981350,501567 +676129,515483 +950860,502717 +119000,592114 +392252,537272 +191618,568919 +946699,502874 +289555,550247 +799322,509139 +703886,513942 +194812,568143 +261823,554685 +203052,566221 +217330,563093 +734748,512313 +391759,537328 +807052,508777 +564467,522510 +59186,629748 +113447,594545 +518063,525916 +905944,504492 +613922,519213 +439093,532607 +445946,531981 +230530,560399 +297887,549007 +459029,530797 +403692,536075 +855118,506616 +963127,502245 +841711,507208 +407411,535699 +924729,503735 +914823,504132 +333725,544101 +176345,572832 +912507,504225 +411273,535308 +259774,555036 +632853,518038 +119723,591801 +163902,576321 +22691,689944 +402427,536212 +175769,572988 +837260,507402 +603432,519893 +313679,546767 +538165,524394 +549026,523608 +61083,627945 +898345,504798 +992556,501153 +369999,539727 +32847,665404 +891292,505088 +152715,579732 +824104,507997 +234057,559711 +730507,512532 +960529,502340 +388395,537687 +958170,502437 +57105,631806 +186025,570311 +993043,501133 +576770,521664 +215319,563513 +927342,503628 +521353,525666 +39563,653705 +752516,511408 +110755,595770 +309749,547305 +374379,539224 +919184,503952 +990652,501226 +647780,517135 +187177,570017 +168938,574877 +649558,517023 +278126,552016 +162039,576868 +658512,516499 +498115,527486 +896583,504868 +561170,522740 +747772,511647 +775093,510294 +652081,516882 +724905,512824 +499707,527365 +47388,642755 +646668,517204 +571700,522007 +180430,571747 +710015,513617 +435522,532941 +98137,602041 +759176,511070 +486124,528467 +526942,525236 +878921,505604 +408313,535602 +926980,503640 +882353,505459 +566887,522345 +3326,853312 +911981,504248 +416309,534800 +392991,537199 +622829,518651 +148647,581055 +496483,527624 +666314,516044 +48562,641293 +672618,515684 +443676,532187 +274065,552661 +265386,554079 +347668,542358 +31816,667448 +181575,571446 +961289,502320 +365689,540214 +987950,501317 +932299,503440 +27388,677243 +746701,511701 +492258,527969 +147823,581323 +57918,630985 +838849,507333 +678038,515375 +27852,676130 +850241,506828 +818403,508253 +131717,587014 +850216,506834 +904848,504529 +189758,569380 +392845,537217 +470876,529761 +925353,503711 +285431,550877 +454098,531234 +823910,508003 +318493,546112 +766067,510730 +261277,554775 +421530,534289 +694130,514478 +120439,591498 +213308,563949 +854063,506662 +365255,540263 +165437,575872 +662240,516281 +289970,550181 +847977,506933 +546083,523816 +413252,535113 +975829,501767 +361540,540701 +235522,559435 +224643,561577 +736350,512229 +328303,544808 +35022,661330 +307838,547578 +474366,529458 +873755,505819 +73978,617220 +827387,507845 +670830,515791 +326511,545034 +309909,547285 +400970,536363 +884827,505352 +718307,513175 +28462,674699 +599384,520150 +253565,556111 +284009,551093 +343403,542876 +446557,531921 +992372,501160 +961601,502308 +696629,514342 +919537,503945 +894709,504944 +892201,505051 +358160,541097 +448503,531745 +832156,507636 +920045,503924 +926137,503675 +416754,534757 +254422,555966 +92498,605151 +826833,507873 +660716,516371 +689335,514746 +160045,577467 +814642,508425 +969939,501993 +242856,558047 +76302,615517 +472083,529653 +587101,520964 +99066,601543 +498005,527503 +709800,513624 +708000,513716 +20171,698134 +285020,550936 +266564,553891 +981563,501557 +846502,506991 +334,1190800 +209268,564829 +9844,752610 +996519,501007 +410059,535426 +432931,533188 +848012,506929 +966803,502110 +983434,501486 +160700,577267 +504374,526989 +832061,507640 +392825,537214 +443842,532165 +440352,532492 +745125,511776 +13718,726392 +661753,516312 +70500,619875 +436952,532814 +424724,533973 +21954,692224 +262490,554567 +716622,513264 +907584,504425 +60086,628882 +837123,507412 +971345,501940 +947162,502855 +139920,584021 +68330,621624 +666452,516038 +731446,512481 +953350,502619 +183157,571042 +845400,507045 +651548,516910 +20399,697344 +861779,506331 +629771,518229 +801706,509026 +189207,569512 +737501,512168 +719272,513115 +479285,529045 +136046,585401 +896746,504860 +891735,505067 +684771,514999 +865309,506184 +379066,538702 +503117,527090 +621780,518717 +209518,564775 +677135,515423 +987500,501340 +197049,567613 +329315,544673 +236756,559196 +357092,541226 +520440,525733 +213471,563911 +956852,502490 +702223,514032 +404943,535955 +178880,572152 +689477,514734 +691351,514630 +866669,506128 +370561,539656 +739805,512051 +71060,619441 +624861,518534 +261660,554714 +366137,540160 +166054,575698 +601878,519990 +153445,579501 +279899,551729 +379166,538691 +423209,534125 +675310,515526 +145641,582050 +691353,514627 +917468,504026 +284778,550976 +81040,612235 +161699,576978 +616394,519057 +767490,510661 +156896,578431 +427408,533714 +254849,555884 +737217,512182 +897133,504851 +203815,566051 +270822,553189 +135854,585475 +778805,510111 +784373,509847 +305426,547921 +733418,512375 +732087,512448 +540668,524215 +702898,513996 +628057,518328 +640280,517587 +422405,534204 +10604,746569 +746038,511733 +839808,507293 +457417,530938 +479030,529064 +341758,543090 +620223,518824 +251661,556451 +561790,522696 +497733,527521 +724201,512863 +489217,528217 +415623,534867 +624610,518548 +847541,506953 +432295,533249 +400391,536421 +961158,502319 +139173,584284 +421225,534315 +579083,521501 +74274,617000 +701142,514087 +374465,539219 +217814,562985 +358972,540995 +88629,607424 +288597,550389 +285819,550812 +538400,524385 +809930,508645 +738326,512126 +955461,502535 +163829,576343 +826475,507891 +376488,538987 +102234,599905 +114650,594002 +52815,636341 +434037,533082 +804744,508880 +98385,601905 +856620,506559 +220057,562517 +844734,507078 +150677,580387 +558697,522917 +621751,518719 +207067,565321 +135297,585677 +932968,503404 +604456,519822 +579728,521462 +244138,557813 +706487,513800 +711627,513523 +853833,506674 +497220,527562 +59428,629511 +564845,522486 +623621,518603 +242689,558077 +125091,589591 +363819,540432 +686453,514901 +656813,516594 +489901,528155 +386380,537905 +542819,524052 +243987,557841 +693412,514514 +488484,528271 +896331,504881 +336730,543721 +728298,512647 +604215,519840 +153729,579413 +595687,520398 +540360,524240 +245779,557511 +924873,503730 +509628,526577 +528523,525122 +3509,847707 +522756,525555 +895447,504922 +44840,646067 +45860,644715 +463487,530404 +398164,536654 +894483,504959 +619415,518874 +966306,502129 +990922,501212 +835756,507474 +548881,523618 +453578,531282 +474993,529410 +80085,612879 +737091,512193 +50789,638638 +979768,501620 +792018,509483 +665001,516122 +86552,608694 +462772,530469 +589233,520821 +891694,505072 +592605,520594 +209645,564741 +42531,649269 +554376,523226 +803814,508929 +334157,544042 +175836,572970 +868379,506051 +658166,516520 +278203,551995 +966198,502126 +627162,518387 +296774,549165 +311803,547027 +843797,507118 +702304,514032 +563875,522553 +33103,664910 +191932,568841 +543514,524006 +506835,526794 +868368,506052 +847025,506971 +678623,515342 +876139,505726 +571997,521984 +598632,520198 +213590,563892 +625404,518497 +726508,512738 +689426,514738 +332495,544264 +411366,535302 +242546,558110 +315209,546555 +797544,509219 +93889,604371 +858879,506454 +124906,589666 +449072,531693 +235960,559345 +642403,517454 +720567,513047 +705534,513858 +603692,519870 +488137,528302 +157370,578285 +63515,625730 +666326,516041 +619226,518883 +443613,532186 +597717,520257 +96225,603069 +86940,608450 +40725,651929 +460976,530625 +268875,553508 +270671,553214 +363254,540500 +384248,538137 +762889,510892 +377941,538833 +278878,551890 +176615,572755 +860008,506412 +944392,502967 +608395,519571 +225283,561450 +45095,645728 +333798,544090 +625733,518476 +995584,501037 +506135,526853 +238050,558952 +557943,522972 +530978,524938 +634244,517949 +177168,572616 +85200,609541 +953043,502630 +523661,525484 +999295,500902 +840803,507246 +961490,502312 +471747,529685 +380705,538523 +911180,504275 +334149,544046 +478992,529065 +325789,545133 +335884,543826 +426976,533760 +749007,511582 +667067,516000 +607586,519623 +674054,515599 +188534,569675 +565185,522464 +172090,573988 +87592,608052 +907432,504424 +8912,760841 +928318,503590 +757917,511138 +718693,513153 +315141,546566 +728326,512645 +353492,541647 +638429,517695 +628892,518280 +877286,505672 +620895,518778 +385878,537959 +423311,534113 +633501,517997 +884833,505360 +883402,505416 +999665,500894 +708395,513697 +548142,523667 +756491,511205 +987352,501340 +766520,510705 +591775,520647 +833758,507563 +843890,507108 +925551,503698 +74816,616598 +646942,517187 +354923,541481 +256291,555638 +634470,517942 +930904,503494 +134221,586071 +282663,551304 +986070,501394 +123636,590176 +123678,590164 +481717,528841 +423076,534137 +866246,506145 +93313,604697 +783632,509880 +317066,546304 +502977,527103 +141272,583545 +71708,618938 +617748,518975 +581190,521362 +193824,568382 +682368,515131 +352956,541712 +351375,541905 +505362,526909 +905165,504518 +128645,588188 +267143,553787 +158409,577965 +482776,528754 +628896,518282 +485233,528547 +563606,522574 +111001,595655 +115920,593445 +365510,540237 +959724,502374 +938763,503184 +930044,503520 +970959,501956 +913658,504176 +68117,621790 +989729,501253 +567697,522288 +820427,508163 +54236,634794 +291557,549938 +124961,589646 +403177,536130 +405421,535899 +410233,535417 +815111,508403 +213176,563974 +83099,610879 +998588,500934 +513640,526263 +129817,587733 +1820,921851 +287584,550539 +299160,548820 +860621,506386 +529258,525059 +586297,521017 +953406,502616 +441234,532410 +986217,501386 +781938,509957 +461247,530595 +735424,512277 +146623,581722 +839838,507288 +510667,526494 +935085,503327 +737523,512167 +303455,548204 +992779,501145 +60240,628739 +939095,503174 +794368,509370 +501825,527189 +459028,530798 +884641,505363 +512287,526364 +835165,507499 +307723,547590 +160587,577304 +735043,512300 +493289,527887 +110717,595785 +306480,547772 +318593,546089 +179810,571911 +200531,566799 +314999,546580 +197020,567622 +301465,548487 +237808,559000 +131944,586923 +882527,505449 +468117,530003 +711319,513541 +156240,578628 +965452,502162 +992756,501148 +437959,532715 +739938,512046 +614249,519196 +391496,537356 +62746,626418 +688215,514806 +75501,616091 +883573,505412 +558824,522910 +759371,511061 +173913,573489 +891351,505089 +727464,512693 +164833,576051 +812317,508529 +540320,524243 +698061,514257 +69149,620952 +471673,529694 +159092,577753 +428134,533653 +89997,606608 +711061,513557 +779403,510081 +203327,566155 +798176,509187 +667688,515963 +636120,517833 +137410,584913 +217615,563034 +556887,523038 +667229,515991 +672276,515708 +325361,545187 +172115,573985 +13846,725685 \ No newline at end of file From 72fea0752652a7a0ea4d716ced7d6266e0748b10 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sat, 15 Nov 2008 17:33:51 -0500 Subject: [PATCH 03/15] Forgot to update project-euler.factor --- extra/project-euler/project-euler.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 60d35f27ad..027e8fe50f 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -17,10 +17,11 @@ USING: definitions io io.files kernel math math.parser project-euler.052 project-euler.053 project-euler.055 project-euler.056 project-euler.059 project-euler.067 project-euler.071 project-euler.073 project-euler.075 project-euler.076 project-euler.079 project-euler.092 - project-euler.097 project-euler.100 project-euler.116 project-euler.117 - project-euler.134 project-euler.148 project-euler.150 project-euler.151 - project-euler.164 project-euler.169 project-euler.173 project-euler.175 - project-euler.186 project-euler.190 project-euler.203 project-euler.215 ; + project-euler.097 project-euler.099 project-euler.100 project-euler.116 + project-euler.117 project-euler.134 project-euler.148 project-euler.150 + project-euler.151 project-euler.164 project-euler.169 project-euler.173 + project-euler.175 project-euler.186 project-euler.190 project-euler.203 + project-euler.215 ; IN: project-euler Date: Sun, 16 Nov 2008 21:24:56 -0500 Subject: [PATCH 04/15] Cleanup math.functions and remove >r r> usages --- basis/math/functions/functions.factor | 28 +++++++++++++-------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 43efc35c27..4fa83a9904 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -15,7 +15,7 @@ IN: math.functions PRIVATE> : rect> ( x y -- z ) - over real? over real? and [ + 2dup [ real? ] both? [ (rect>) ] [ "Complex number must have real components" throw @@ -27,10 +27,10 @@ M: real sqrt >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; : each-bit ( n quot: ( ? -- ) -- ) - over 0 = pick -1 = or [ + over [ 0 = ] [ -1 = ] bi or [ 2drop ] [ - 2dup >r >r >r odd? r> call r> 2/ r> each-bit + 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread ] if ; inline recursive : map-bits ( n quot: ( ? -- obj ) -- seq ) @@ -69,8 +69,7 @@ PRIVATE> >rect [ >float ] bi@ ; inline : >polar ( z -- abs arg ) - >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; - inline + >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; inline : cis ( arg -- z ) dup fcos swap fsin rect> ; inline @@ -79,11 +78,10 @@ PRIVATE> r >r >float-rect swap r> swap fpow r> rot * fexp /f ; - inline + [ >float-rect swap ] [ swap fpow ] [ rot * fexp /f ] tri* ; inline : ^theta ( w abs arg -- theta ) - >r >r >float-rect r> flog * swap r> * + ; inline + [ >float-rect ] [ flog * swap ] [ * + ] tri* ; inline : ^complex ( x y -- z ) swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline @@ -106,18 +104,18 @@ PRIVATE> : (^mod) ( n x y -- z ) 1 swap [ - [ dupd * pick mod ] when >r sq over mod r> + [ dupd * pick mod ] when [ sq over mod ] dip ] each-bit 2nip ; inline : (gcd) ( b a x y -- a d ) over zero? [ 2nip ] [ - swap [ /mod >r over * swapd - r> ] keep (gcd) + swap [ /mod [ over * swapd - ] dip ] keep (gcd) ] if ; : gcd ( x y -- a d ) - 0 -rot 1 -rot (gcd) dup 0 < [ neg ] when ; foldable + [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable : lcm ( a b -- c ) [ * ] 2keep gcd nip /i ; foldable @@ -131,7 +129,7 @@ PRIVATE> : ^mod ( x y n -- z ) over 0 < [ - [ >r neg r> ^mod ] keep mod-inv + [ [ neg ] dip ^mod ] keep mod-inv ] [ -rot (^mod) ] if ; foldable @@ -141,14 +139,14 @@ GENERIC: absq ( x -- y ) foldable M: real absq sq ; : ~abs ( x y epsilon -- ? ) - >r - abs r> < ; + [ - abs ] dip < ; : ~rel ( x y epsilon -- ? ) - >r [ - abs ] 2keep [ abs ] bi@ + r> * < ; + [ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ; : ~ ( x y epsilon -- ? ) { - { [ pick fp-nan? pick fp-nan? or ] [ 3drop f ] } + { [ pick pick [ fp-nan? ] either? ] [ 3drop f ] } { [ dup zero? ] [ drop number= ] } { [ dup 0 < ] [ ~rel ] } [ ~abs ] From 5d8b3c3fb13f4404f0eb16a868aa729c6edf50b1 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 17:20:56 -0500 Subject: [PATCH 05/15] Cleanup math.intervals and eliminate >r r> usage --- basis/math/intervals/intervals.factor | 34 +++++++++++++-------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 54ee0ac894..4182d25524 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -12,10 +12,10 @@ SYMBOL: full-interval TUPLE: interval { from read-only } { to read-only } ; : ( from to -- int ) - over first over first { + 2dup [ first ] bi@ { { [ 2dup > ] [ 2drop 2drop empty-interval ] } { [ 2dup = ] [ - 2drop over second over second and + 2drop 2dup [ second ] both? [ interval boa ] [ 2drop empty-interval ] if ] } [ 2drop interval boa ] @@ -26,16 +26,16 @@ TUPLE: interval { from read-only } { to read-only } ; : closed-point ( n -- endpoint ) t 2array ; : [a,b] ( a b -- interval ) - >r closed-point r> closed-point ; foldable + [ closed-point ] dip closed-point ; foldable : (a,b) ( a b -- interval ) - >r open-point r> open-point ; foldable + [ open-point ] dip open-point ; foldable : [a,b) ( a b -- interval ) - >r closed-point r> open-point ; foldable + [ closed-point ] dip open-point ; foldable : (a,b] ( a b -- interval ) - >r open-point r> closed-point ; foldable + [ open-point ] dip closed-point ; foldable : [a,a] ( a -- interval ) closed-point dup ; foldable @@ -51,11 +51,11 @@ TUPLE: interval { from read-only } { to read-only } ; : [-inf,inf] ( -- interval ) full-interval ; inline : compare-endpoints ( p1 p2 quot -- ? ) - >r over first over first r> call [ + [ 2dup [ first ] bi@ ] dip call [ 2drop t ] [ - over first over first = [ - swap second swap second not or + 2dup [ first ] bi@ = [ + [ second ] bi@ not or ] [ 2drop f ] if @@ -86,7 +86,7 @@ TUPLE: interval { from read-only } { to read-only } ; ] if ; : (interval-op) ( p1 p2 quot -- p3 ) - [ [ first ] [ first ] [ ] tri* call ] + [ [ first ] [ first ] [ call ] tri* ] [ drop [ second ] both? ] 3bi 2array ; inline @@ -177,7 +177,7 @@ TUPLE: interval { from read-only } { to read-only } ; drop f ] [ interval>points - 2dup [ second ] bi@ and + 2dup [ second ] both? [ [ first ] bi@ = ] [ 2drop f ] if ] if ; @@ -193,9 +193,9 @@ TUPLE: interval { from read-only } { to read-only } ; dup [ interval>points [ first ] bi@ [a,b] ] when ; : interval-integer-op ( i1 i2 quot -- i3 ) - >r 2dup - [ interval>points [ first integer? ] both? ] both? - r> [ 2drop [-inf,inf] ] if ; inline + [ + 2dup [ interval>points [ first integer? ] both? ] both? + ] dip [ 2drop [-inf,inf] ] if ; inline : interval-shift ( i1 i2 -- i3 ) #! Inaccurate; could be tighter @@ -302,7 +302,7 @@ SYMBOL: incomparable 2tri and and ; : (interval<) ( i1 i2 -- i1 i2 ? ) - over from>> over from>> endpoint< ; + 2dup [ from>> ] bi@ endpoint< ; : interval< ( i1 i2 -- ? ) { @@ -314,10 +314,10 @@ SYMBOL: incomparable } cond 2nip ; : left-endpoint-<= ( i1 i2 -- ? ) - >r from>> r> to>> = ; + [ from>> ] dip to>> = ; : right-endpoint-<= ( i1 i2 -- ? ) - >r to>> r> from>> = ; + [ to>> ] dip from>> = ; : interval<= ( i1 i2 -- ? ) { From d328589b87c05cfb40a8c1e9363b6d9a0fee5837 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 17:59:15 -0500 Subject: [PATCH 06/15] Cleanup partial-dispatch by removing >r r> usage --- basis/math/partial-dispatch/partial-dispatch.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index fd0e910b37..6874b79d2e 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -126,7 +126,7 @@ SYMBOL: fast-math-ops : math-method* ( word left right -- quot ) 3dup math-op - [ >r 3drop r> 1quotation ] [ drop math-method ] if ; + [ [ 3drop ] dip 1quotation ] [ drop math-method ] if ; : math-both-known? ( word left right -- ? ) 3dup math-op @@ -157,13 +157,13 @@ SYMBOL: fast-math-ops ] bi@ append ; : each-derived-op ( word quot -- ) - >r derived-ops r> each ; inline + [ derived-ops ] dip each ; inline : each-fast-derived-op ( word quot -- ) - >r fast-derived-ops r> each ; inline + [ fast-derived-ops ] dip each ; inline : each-integer-derived-op ( word quot -- ) - >r integer-derived-ops r> each ; inline + [ integer-derived-ops ] dip each ; inline [ [ From fa88f8825b6656cf66ae7c74516e8d9ea881ede1 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:13:42 -0500 Subject: [PATCH 07/15] Replace >r r> usage with dip in math.ratios --- basis/math/ratios/ratios.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index d9dea22b7b..81294d29f7 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -12,10 +12,10 @@ IN: math.ratios dup 1 number= [ drop ] [ ] if ; inline : scale ( a/b c/d -- a*d b*c ) - 2>fraction >r * swap r> * swap ; inline + 2>fraction [ * swap ] dip * swap ; inline : ratio+d ( a/b c/d -- b*d ) - denominator swap denominator * ; inline + [ denominator ] bi@ * ; inline PRIVATE> @@ -24,7 +24,7 @@ M: integer / "Division by zero" throw ] [ dup 0 < [ [ neg ] bi@ ] when - 2dup gcd nip tuck /i >r /i r> fraction> + 2dup gcd nip tuck /i [ /i ] dip fraction> ] if ; M: ratio hashcode* @@ -52,7 +52,7 @@ M: ratio >= scale >= ; M: ratio + 2dup scale + -rot ratio+d / ; M: ratio - 2dup scale - -rot ratio+d / ; -M: ratio * 2>fraction * >r * r> / ; +M: ratio * 2>fraction * [ * ] dip / ; M: ratio / scale / ; M: ratio /i scale /i ; M: ratio /f scale /f ; From d2a67c78b2b385b3286d376c50a6f02fbfbb3b3b Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:14:29 -0500 Subject: [PATCH 08/15] Replace >r r> usage with dip in math.ranges --- basis/math/ranges/ranges.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 5acdc43ca3..41fd28e441 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -8,7 +8,7 @@ TUPLE: range { step read-only } ; : ( a b step -- range ) - >r over - r> + [ over - ] dip [ / 1+ 0 max >integer ] keep range boa ; inline From 9c27e9d61bd086cfa44e9ad9451c72c4aa82af81 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:17:14 -0500 Subject: [PATCH 09/15] Replace >r r> usage with dip in math.vectors --- basis/math/vectors/vectors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 5316720b2f..01a421b4e7 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -25,7 +25,7 @@ IN: math.vectors : normalize ( u -- v ) dup norm v/n ; : set-axis ( u v axis -- w ) - [ >r zero? 2over ? r> swap nth ] map-index 2nip ; + [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ; HINTS: vneg { array } ; HINTS: norm-sq { array } ; From 000d84a8719d689199aec3a343349838935fcc49 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:20:34 -0500 Subject: [PATCH 10/15] Replace pick pick with 2over in math.functions --- basis/math/functions/functions.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 4fa83a9904..c582c560a9 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -146,7 +146,7 @@ M: real absq sq ; : ~ ( x y epsilon -- ? ) { - { [ pick pick [ fp-nan? ] either? ] [ 3drop f ] } + { [ 2over [ fp-nan? ] either? ] [ 3drop f ] } { [ dup zero? ] [ drop number= ] } { [ dup 0 < ] [ ~rel ] } [ ~abs ] From f8e86894a46d3879c233e9d1161626111ac402b8 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 18:41:21 -0500 Subject: [PATCH 11/15] Minor Project Euler cleanup --- extra/project-euler/047/047.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/project-euler/047/047.factor b/extra/project-euler/047/047.factor index 30c01d8f61..9caaa8776f 100644 --- a/extra/project-euler/047/047.factor +++ b/extra/project-euler/047/047.factor @@ -32,7 +32,7 @@ IN: project-euler.047 Date: Mon, 17 Nov 2008 18:48:19 -0500 Subject: [PATCH 12/15] Replace nested >r r> with spread in math.statistics --- extra/math/statistics/statistics.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 267a95c100..7568af5294 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Michael Judge. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.analysis math.functions sequences sequences.lib - sorting ; +USING: arrays combinators kernel math math.analysis math.functions sequences + sequences.lib sorting ; IN: math.statistics : mean ( seq -- n ) @@ -63,7 +63,7 @@ IN: math.statistics r sq ; : least-squares ( {{x,y}...} -- alpha beta ) - [r] >r >r >r >r 2dup r> r> r> r> + [r] { [ 2dup ] [ ] [ ] [ ] [ ] } spread ! stack is mean(x) mean(y) mean(x) mean(y) {x} {y} sx sy [ (r) ] 2keep ! stack is mean(x) mean(y) r sx sy swap / * ! stack is mean(x) mean(y) beta From a7551efd0231f9e0bd466429897972fb320a7e75 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 21:12:10 -0500 Subject: [PATCH 13/15] Add documentation for math.quaternions --- .../math/quaternions/quaternions-docs.factor | 46 +++++++++++++++++++ extra/math/quaternions/quaternions.factor | 35 +++++--------- 2 files changed, 58 insertions(+), 23 deletions(-) create mode 100644 extra/math/quaternions/quaternions-docs.factor diff --git a/extra/math/quaternions/quaternions-docs.factor b/extra/math/quaternions/quaternions-docs.factor new file mode 100644 index 0000000000..bb34ec8da2 --- /dev/null +++ b/extra/math/quaternions/quaternions-docs.factor @@ -0,0 +1,46 @@ +USING: help.markup help.syntax math math.vectors vectors ; +IN: math.quaternions + +HELP: q* +{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u*v" "a quaternion" } } +{ $description "Multiply quaternions." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q* ." "{ 0 C{ 0 1 } }" } } ; + +HELP: qconjugate +{ $values { "u" "a quaternion" } { "u'" "a quaternion" } } +{ $description "Quaternion conjugate." } ; + +HELP: qrecip +{ $values { "u" "a quaternion" } { "1/u" "a quaternion" } } +{ $description "Quaternion inverse." } ; + +HELP: q/ +{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u/v" "a quaternion" } } +{ $description "Divide quaternions." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 C{ 0 1 } } { 0 1 } q/ ." "{ C{ 0 1 } 0 }" } } ; + +HELP: q*n +{ $values { "q" "a quaternion" } { "n" number } { "q" "a quaternion" } } +{ $description "Multiplies each element of " { $snippet "q" } " by " { $snippet "n" } "." } +{ $notes "You will get the wrong result if you try to multiply a quaternion by a complex number on the right using " { $link v*n } ". Use this word instead." + $nl "Note that " { $link v*n } " with a quaternion and a real is okay." } ; + +HELP: c>q +{ $values { "c" number } { "q" "a quaternion" } } +{ $description "Turn a complex number into a quaternion." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "C{ 0 1 } c>q ." "{ C{ 0 1 } 0 }" } } ; + +HELP: v>q +{ $values { "v" vector } { "q" "a quaternion" } } +{ $description "Turn a 3-vector into a quaternion with real part 0." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 1 0 0 } v>q ." "{ C{ 0 1 } 0 }" } } ; + +HELP: q>v +{ $values { "q" "a quaternion" } { "v" vector } } +{ $description "Get the vector part of a quaternion, discarding the real part." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } q>v ." "{ 1 0 0 }" } } ; + +HELP: euler +{ $values { "phi" number } { "theta" number } { "psi" number } { "q" "a quaternion" } } +{ $description "Convert a rotation given by Euler angles (phi, theta, and psi) to a quaternion." } ; + diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index ffc0fcc9f7..bb0d025dc6 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -1,15 +1,13 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. - -! Everybody's favorite non-commutative skew field, the -! quaternions! - -! Quaternions are represented as pairs of complex numbers, -! using the identity: (a+bi)+(c+di)j = a+bi+cj+dk. -USING: arrays kernel math math.vectors math.functions -arrays sequences ; +USING: arrays kernel math math.functions math.vectors sequences ; IN: math.quaternions +! Everybody's favorite non-commutative skew field, the quaternions! + +! Quaternions are represented as pairs of complex numbers, using the +! identity: (a+bi)+(c+di)j = a+bi+cj+dk. + : q* ( u v -- u*v ) - #! Multiply quaternions. [ q*a ] [ q*b ] 2bi 2array ; : qconjugate ( u -- u' ) - #! Quaternion conjugate. first2 [ conjugate ] [ neg ] bi* 2array ; : qrecip ( u -- 1/u ) - #! Quaternion inverse. qconjugate dup norm-sq v/n ; : q/ ( u v -- u/v ) - #! Divide quaternions. qrecip q* ; : q*n ( q n -- q ) - #! Note: you will get the wrong result if you try to - #! multiply a quaternion by a complex number on the right - #! using v*n. Use this word instead. Note that v*n with a - #! quaternion and a real is okay. conjugate v*n ; : c>q ( c -- q ) - #! Turn a complex number into a quaternion. 0 2array ; : v>q ( v -- q ) - #! Turn a 3-vector into a quaternion with real part 0. first3 rect> [ 0 swap rect> ] dip 2array ; : q>v ( q -- v ) - #! Get the vector part of a quaternion, discarding the real - #! part. first2 [ imaginary-part ] dip >rect 3array ; ! Zero @@ -67,11 +53,14 @@ PRIVATE> : qj { 0 1 } ; : qk { 0 C{ 0 1 } } ; -! Euler angles -- see -! http://www.mathworks.com/access/helpdesk/help/toolbox/aeroblks/euleranglestoquaternions.html +! Euler angles + +q swap sin ] dip n*v v- ; + [ -0.5 * [ cos c>q ] [ sin ] bi ] dip n*v v- ; + +PRIVATE> : euler ( phi theta psi -- q ) [ qi (euler) ] [ qj (euler) ] [ qk (euler) ] tri* q* q* ; From e17f51948005ff8b20f63efe74f7d0d3fe48cb5b Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Mon, 17 Nov 2008 22:51:57 -0500 Subject: [PATCH 14/15] Minor documentation fixes --- basis/math/vectors/vectors-docs.factor | 2 +- extra/math/derivatives/derivatives-docs.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 140eddb2f6..7ee948be65 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -34,7 +34,7 @@ HELP: n*v { $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ; HELP: v*n -{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } } +{ $values { "u" "a sequence of numbers" } { "n" "a number" } { "v" "a sequence of numbers" } } { $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ; HELP: n/v diff --git a/extra/math/derivatives/derivatives-docs.factor b/extra/math/derivatives/derivatives-docs.factor index bbb793fe92..1630b2f9de 100644 --- a/extra/math/derivatives/derivatives-docs.factor +++ b/extra/math/derivatives/derivatives-docs.factor @@ -90,7 +90,6 @@ HELP: derivative-func " [ cos ]" " bi - abs" "] map minmax" - } } } ; @@ -100,4 +99,5 @@ ARTICLE: "derivatives" "The Derivative Toolkit" { $subsection derivative } { $subsection derivative-func } { $subsection (derivative) } ; + ABOUT: "derivatives" From fd95e641257a63e2931d2c7b15ab213888d873a9 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Tue, 18 Nov 2008 10:13:57 -0500 Subject: [PATCH 15/15] Cleanup polynomials and add documentation --- .../math/polynomials/polynomials-docs.factor | 94 +++++++++++++++++++ .../math/polynomials/polynomials-tests.factor | 3 +- extra/math/polynomials/polynomials.factor | 46 ++++----- 3 files changed, 115 insertions(+), 28 deletions(-) create mode 100644 extra/math/polynomials/polynomials-docs.factor diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor new file mode 100644 index 0000000000..08b7ca7c4d --- /dev/null +++ b/extra/math/polynomials/polynomials-docs.factor @@ -0,0 +1,94 @@ +USING: help.markup help.syntax math sequences ; +IN: math.polynomials + +ARTICLE: "polynomials" "Polynomials" +"A polynomial is a vector with the highest powers on the right:" +{ $code "{ 1 1 0 1 } -> 1 + x + x^3" "{ } -> 0" } +"Numerous words are defined to help with polynomial arithmetic:" +{ $subsection p= } +{ $subsection p+ } +{ $subsection p- } +{ $subsection p* } +{ $subsection p-sq } +{ $subsection powers } +{ $subsection n*p } +{ $subsection p/mod } +{ $subsection pgcd } +{ $subsection polyval } +{ $subsection pdiff } +{ $subsection pextend-conv } +{ $subsection ptrim } +{ $subsection 2ptrim } ; + +ABOUT: "polynomials" + +HELP: powers +{ $values { "n" integer } { "x" number } { "seq" sequence } } +{ $description "Output a sequence having " { $snippet "n" } " elements in the format: " { $snippet "{ 1 x x^2 x^3 ... }" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "4 2 powers ." "{ 1 2 4 8 }" } } ; + +HELP: p= +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "?" "a boolean" } } +{ $description "Tests if two polynomials are equal." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ; + +HELP: ptrim +{ $values { "p" "a polynomial" } { "p" "a polynomial" } } +{ $description "Trims excess zeros from a polynomial." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ; + +HELP: 2ptrim +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } +{ $description "Trims excess zeros from two polynomials." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; + +HELP: p+ +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Adds " { $snippet "p" } " and " { $snippet "q" } " component-wise." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } p+ ." "{ 1 1 1 }" } } ; + +HELP: p- +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Subtracts " { $snippet "q" } " from " { $snippet "p" } " component-wise." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 } { 0 1 } p- ." "{ 1 0 1 }" } } ; + +HELP: n*p +{ $values { "n" number } { "p" "a polynomial" } { "n*p" "a polynomial" } } +{ $description "Multiplies each element of " { $snippet "p" } " by " { $snippet "n" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ; + +HELP: pextend-conv +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } +{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; + +HELP: p* +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Multiplies two polynomials." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 3 0 0 0 } { 1 2 0 0 } p* ." "{ 1 4 7 6 0 0 0 0 0 }" } } ; + +HELP: p-sq +{ $values { "p" "a polynomial" } { "p^2" "a polynomial" } } +{ $description "Squares a polynomial." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 0 } p-sq ." "{ 1 4 4 0 0 }" } } ; + +HELP: p/mod +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } +{ $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; + +HELP: pgcd +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } +{ $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } } +{ $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ; + +HELP: pdiff +{ $values { "p" "a polynomial" } { "p'" "a polynomial" } } +{ $description "Finds the derivative of " { $snippet "p" } "." } ; + +HELP: polyval +{ $values { "p" "a polynomial" } { "x" number } { "p[x]" number } } +{ $description "Evaluate " { $snippet "p" } " with the input " { $snippet "x" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } 2 polyval ." "5" } } ; + diff --git a/extra/math/polynomials/polynomials-tests.factor b/extra/math/polynomials/polynomials-tests.factor index cccf24fbff..cd88d19d13 100644 --- a/extra/math/polynomials/polynomials-tests.factor +++ b/extra/math/polynomials/polynomials-tests.factor @@ -1,7 +1,6 @@ -IN: math.polynomials.tests USING: kernel math math.polynomials tools.test ; +IN: math.polynomials.tests -! Tests [ { 0 1 } ] [ { 0 1 0 0 } ptrim ] unit-test [ { 1 } ] [ { 1 0 0 } ptrim ] unit-test [ { 0 } ] [ { 0 } ptrim ] unit-test diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 47226114d0..13090b6486 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -4,46 +4,38 @@ USING: arrays kernel make math math.order math.vectors sequences shuffle splitting vectors ; IN: math.polynomials -! Polynomials are vectors with the highest powers on the right: -! { 1 1 0 1 } -> 1 + x + x^3 -! { } -> 0 - -: powers ( n x -- seq ) - #! Output sequence has n elements, { 1 x x^2 x^3 ... } - 1 [ * ] accumulate nip ; - -: p= ( p p -- ? ) pextend = ; +: powers ( n x -- seq ) + 1 [ * ] accumulate nip ; + +: p= ( p q -- ? ) pextend = ; : ptrim ( p -- p ) dup length 1 = [ [ zero? ] trim-right ] unless ; -: 2ptrim ( p p -- p p ) [ ptrim ] bi@ ; -: p+ ( p p -- p ) pextend v+ ; -: p- ( p p -- p ) pextend v- ; +: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ; +: p+ ( p q -- r ) pextend v+ ; +: p- ( p q -- r ) pextend v- ; : n*p ( n p -- n*p ) n*v ; -! convolution -: pextend-conv ( p p -- p p ) - #! extend to: p_m + p_n - 1 +: pextend-conv ( p q -- p q ) 2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ; -: p* ( p p -- p ) - #! Multiply two polynomials. +: p* ( p q -- r ) 2unempty pextend-conv dup length [ over length pick pick [ * ] 2map sum ] map 2nip reverse ; -: p-sq ( p -- p-sq ) +: p-sq ( p -- p^2 ) dup p* ; PRIVATE> -: p/mod ( a b -- / mod ) +: p/mod ( p q -- z w ) p/mod-setup [ [ (p/mod) ] times ] V{ } make reverse nip swap 2ptrim pextend ; + tuck p/mod [ pick p* swap [ swapd p- ] dip ] dip (pgcd) ] if ; -: pgcd ( p p -- p q ) +PRIVATE> + +: pgcd ( p q -- a d ) swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ; : pdiff ( p -- p' ) - #! Polynomial derivative. dup length v* { 0 } ?head drop ; : polyval ( p x -- p[x] ) - #! Evaluate a polynomial. [ dup length ] dip powers v. ;