Knuth's power tree: Difference between revisions
Content added Content deleted
m (→{{header|Phix}}: made it work on pwa/p2js) |
No edit summary |
||
| Line 1,100: | Line 1,100: | ||
3 ^ 191 = 13494588674281093803728157396523884917402502294030101914066705367021922008906273586058258347 |
3 ^ 191 = 13494588674281093803728157396523884917402502294030101914066705367021922008906273586058258347 |
||
</pre> |
</pre> |
||
=={{header|Mathematica}} / {{header|Wolfram Language}}== |
|||
<lang Mathematica>ClearAll[NextStep, TreePow] |
|||
NextStep[pows_List] := Module[{maxlen, sel, new, vals, knows}, |
|||
maxlen = Max[Length /@ pows[[All, "Path"]]]; |
|||
sel = Select[pows, Length[#["Path"]] == maxlen &]; |
|||
knows = pows[[All, "P"]]; |
|||
new = {}; |
|||
Do[ |
|||
vals = s["P"] + s["Path"]; |
|||
vals = DeleteCases[vals, Alternatives @@ Join[s["Path"], knows]]; |
|||
new = |
|||
Join[ |
|||
new, <|"Path" -> Append[s["Path"], #], "P" -> #|> & /@ vals]; |
|||
, |
|||
{s, sel} |
|||
]; |
|||
new //= DeleteDuplicatesBy[#["P"] &]; |
|||
SortBy[Join[pows, new], #["P"] &] |
|||
] |
|||
TreePow[path_List, base_] := Module[{db, tups}, |
|||
db = <|1 -> base|>; |
|||
Do[ |
|||
tups = Tuples[Keys[db], 2]; |
|||
tups = Select[tups, #[[2]] >= #[[1]] &]; |
|||
tups = Select[tups, Total[#] == next &]; |
|||
If[Length[tups] < 1, Abort[]]; |
|||
tups //= First; |
|||
AssociateTo[db, Total[tups] -> (Times @@ (db /@ tups))] |
|||
, |
|||
{next, Rest[path]} |
|||
]; |
|||
db[Last[path]] |
|||
] |
|||
pows = {<|"Path" -> {1}, "P" -> 1|>}; |
|||
steps = Nest[NextStep, pows, 7]; |
|||
LayeredGraphPlot[DirectedEdge @@@ steps[[2 ;;, "Path", -2 ;;]], VertexLabels -> Automatic] |
|||
pows = {<|"Path" -> {1}, "P" -> 1|>}; |
|||
steps = Nest[NextStep, pows, 5]; |
|||
assoc = Association[#["P"] -> #["Path"] & /@ steps]; |
|||
Dataset[assoc] |
|||
TreePow[assoc[#], 2] & /@ Range[1, 17] |
|||
pows = {<|"Path" -> {1}, "P" -> 1|>}; |
|||
steps = NestWhile[NextStep, pows, Not[MemberQ[#[[All, "P"]], 191]] &]; |
|||
SelectFirst[steps, #["P"] == 191 &]["Path"]; |
|||
TreePow[%, 3] |
|||
pows = {<|"Path" -> {1}, "P" -> 1|>}; |
|||
steps = NestWhile[NextStep, pows, Not[MemberQ[#[[All, "P"]], 81]] &]; |
|||
SelectFirst[steps, #["P"] == 81 &]["Path"]; |
|||
TreePow[%, 1.1]</lang> |
|||
{{out}} |
|||
<pre>[Graphics object showing the tree] |
|||
1 {1} |
|||
2 {1,2} |
|||
3 {1,2,3} |
|||
4 {1,2,4} |
|||
5 {1,2,3,5} |
|||
6 {1,2,3,6} |
|||
7 {1,2,3,5,7} |
|||
8 {1,2,4,8} |
|||
9 {1,2,3,6,9} |
|||
10 {1,2,3,5,10} |
|||
11 {1,2,3,6,9,11} |
|||
12 {1,2,3,6,12} |
|||
13 {1,2,3,5,10,13} |
|||
14 {1,2,3,5,7,14} |
|||
15 {1,2,3,6,9,15} |
|||
16 {1,2,4,8,16} |
|||
17 {1,2,4,8,16,17} |
|||
18 {1,2,3,6,9,18} |
|||
20 {1,2,3,5,10,20} |
|||
24 {1,2,3,6,12,24} |
|||
... ... |
|||
{2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768, 65536, 131072} |
|||
13494588674281093803728157396523884917402502294030101914066705367021922008906273586058258347 |
|||
2253.24</pre> |
|||
=={{header|Nim}}== |
=={{header|Nim}}== |
||