mathematica 发表于 2018-9-29 16:33:47

3x+1问题的mathematica代码

Grid,#/2,3*#+1]&,#,#>1&]&/@Range]
运行结果:1
2       1
3       10 5 16 8 4 2 1
4       2 1
5       16 8 4 2 1
6       3 10 5 16 8 4 2 1
7       22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
8       4 2 1
9       28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
10      5 16 8 4 2 1
11      34 17 52 26 13 40 20 10 5 16 8 4 2 1
12      6 3 10 5 16 8 4 2 1
13      40 20 10 5 16 8 4 2 1
14      7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
15      46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
16      8 4 2 1
17      52 26 13 40 20 10 5 16 8 4 2 1
18      9 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
19      58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
20      10 5 16 8 4 2 1
21      64 32 16 8 4 2 1
22      11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
23      70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
24      12 6 3 10 5 16 8 4 2 1
25      76 38 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
26      13 40 20 10 5 16 8 4 2 1
27      82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
28      14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
29      88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
30      15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
31      94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
32      16 8 4 2 1
33      100 50 25 76 38 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
34      17 52 26 13 40 20 10 5 16 8 4 2 1
35      106 53 160 80 40 20 10 5 16 8 4 2 1
36      18 9 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
37      112 56 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
38      19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
39      118 59 178 89 268 134 67 202 101 304 152 76 38 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
40      20 10 5 16 8 4 2 1
41      124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
42      21 64 32 16 8 4 2 1
43      130 65 196 98 49 148 74 37 112 56 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
44      22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
45      136 68 34 17 52 26 13 40 20 10 5 16 8 4 2 1
46      23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
47      142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
48      24 12 6 3 10 5 16 8 4 2 1
49      148 74 37 112 56 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
50      25 76 38 19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1

mathematica 发表于 2018-9-29 16:39:06

ListLinePlot,#/2,3*#+1]&,27,#>1&]]
画图的代码

mathematica 发表于 2018-9-30 09:12:03

@TSC999
有空多看看mathematica的帮助文件,你就自然懂了,程序特别简单,我就写在一行了,也没注释,本身就没难度,
不过如果你不熟悉mathematica软件,我写得再详细都没用!

gxqcn 发表于 2018-9-30 09:17:26

如果从1向后连续验证,当得到的中间结果小于初始值时,即可提前结束了。

zeroieme 发表于 2018-10-1 11:29:36

借用郭老板的思路Select,Function[{i},TimeConstrained[(#!=1&&#>=i&),#/2,3 #+1]&,i,#>=i&]],60,True]]]

mathe 发表于 2018-10-1 15:01:18

如果一个数经过若干次变换后变为比它自己小的数,就不需要继续验证了。
而所有偶数2k经过一次变换就比它自己小,我们一次变换就可筛选掉。
由此,我们接下去只要看类似2k+1的数,所以它下一步变换为6k+4,再变换一次得到3k+2,所以二次变换可以有
2k+1->3k+2(1)
而这部分我们没法直接淘汰,为此我们可以根据k的奇偶性分类为
4k+1->6k+2->3k+1 (直接淘汰)
4k+3->6k+5
其中6k+5必然是奇数,我们可以再次乘以3加1然后除以2,得到
4k+3->9k+8 (2)
同样第二式我们又需要对k分奇偶,得到
8k+3->18k+8->9k+4
8k+7->18k+17->27k+26
于是我们得到两种结果
8k+3->9k+4
8k+7->27k+26
继续对k分奇偶可以有
16k+3->18k+4->9k+2 (淘汰)
16k+11->18k+13->27k+20
16k+7->54k+26->27k+13
16k+15->54k+53->81k+80
所以余下
16k+11->27k+20
16k+7->27k+13
16k+15->81k+80
同样有
32k+27->81k+71
32k+7->81k+20
32k+15->81k+40
32k+31->243k+242
然后
64k+27->243k+107
64k+59->81k+76
64k+7->81k+10
64k+39->243k+152
64k+15->81k+20
64k+47->243k+182
64k+31->243k+121
64k+63->729k+728

128k+27->729k+161
128k+91->243k+175
128k+123->243k+236
128k+71->243k+137
128k+39->243k+76
128k+103->729k+593
128k+79->243k+152
128k+47->243k+91
128k+111->729k+638
128k+31->729k+182
128k+95->243k+182
128k+63->729k+364
128k+127->2187k+2186
到了这一步由于表格中数都不小于31,证明了31一下都成立

一般情况,我们会余下一些类似
$2^u k+a -> 3^v k+b$形式的表达式,其中$v<=u, 2^u<3^v$而且a是奇数。
其中比较有意思的好像是当达到$2^u<3^v$时,必然有对应的a小于b从而可以马上淘汰

zeroieme 发表于 2018-10-2 19:50:19

感谢mathe大师的思路,我的破机器轻松验证过 \(2^{30}\) 了,符号计算万岁!
Nest]>>("Collatz conjecture-Step"<>ToString<>"-File"<>#<>".txt"&)<>"-File*.txt"]]]]])&)]>>("Collatz conjecture-Step"<>ToString<>"-File"<>#<>".txt"&)<>"-File*.txt"]]]]];#[])&,#,Length[#]>65536&]&)],(Join@@#&)[(Parallelize[((DeleteCases[#,Null]&)[(((If]<#[],k>0],#]&)[{#[],(NestWhile&,#,And@@EvenQ/@CoefficientList[#,k]&]&)[(If],#,Expand]&)[#[]]]}]&)/@#&)]]&)/@#]&)]]]]]],DeleteFile[#[]];Delete[#[],1]}&,{{},TheFilesList},#[]!={}&]];{LastStep+1,FileNames["Collatz conjecture-Step"<>ToString<>"-File*.txt"]}]@@#&,{0,{{k,k}}>>"Collatz conjecture-Step0-File1.txt";{"Collatz conjecture-Step0-File1.txt"}},30]
页: [1]
查看完整版本: 3x+1问题的mathematica代码