数学研发网设为首页收藏本站
切换到窄版

 找回密码
 欢迎注册
数学研发论坛»论坛 › 【数学研究】 › 数学软件 › 3x+1问题的mathematica代码
返回列表 发新帖
查看: 13235|回复: 9

[原创] 3x+1问题的mathematica代码

[复制链接]
mathematica
发表于 2018-9-29 16:33:47 | 显示全部楼层 |阅读模式

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？欢迎注册

×
  1. Grid[NestWhileList[If[EvenQ[#],#/2,3*#+1]&,#,#>1&]&/@Range[50]]
复制代码

运行结果：
  1. 1
  2. 2       1
  3. 3       10 5 16 8 4 2 1
  4. 4       2 1
  5. 5       16 8 4 2 1
  6. 6       3 10 5 16 8 4 2 1
  7. 7       22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  8. 8       4 2 1
  9. 9       28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  10. 10      5 16 8 4 2 1
  11. 11      34 17 52 26 13 40 20 10 5 16 8 4 2 1
  12. 12      6 3 10 5 16 8 4 2 1
  13. 13      40 20 10 5 16 8 4 2 1
  14. 14      7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  15. 15      46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
  16. 16      8 4 2 1
  17. 17      52 26 13 40 20 10 5 16 8 4 2 1
  18. 18      9 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  19. 19      58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  20. 20      10 5 16 8 4 2 1
  21. 21      64 32 16 8 4 2 1
  22. 22      11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  23. 23      70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
  24. 24      12 6 3 10 5 16 8 4 2 1
  25. 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. 26      13 40 20 10 5 16 8 4 2 1
  27. 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. 28      14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  29. 29      88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  30. 30      15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
  31. 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. 32      16 8 4 2 1
  33. 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. 34      17 52 26 13 40 20 10 5 16 8 4 2 1
  35. 35      106 53 160 80 40 20 10 5 16 8 4 2 1
  36. 36      18 9 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  37. 37      112 56 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  38. 38      19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  39. 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. 40      20 10 5 16 8 4 2 1
  41. 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. 42      21 64 32 16 8 4 2 1
  43. 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. 44      22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  45. 45      136 68 34 17 52 26 13 40 20 10 5 16 8 4 2 1
  46. 46      23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
  47. 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. 48      24 12 6 3 10 5 16 8 4 2 1
  49. 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. 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[NestWhileList[If[EvenQ[#],#/2,3*#+1]&,27,#>1&]]
画图的代码

点评

TSC999
我这个 mathematica 可能版本低，仅当 Grid[NestWhileList[If[EvenQ[#], #/2, 3*# + 1] &, #, # > 1 &] & /@ Range[26]] 时显示才是正确的。  发表于 2018-9-30 09:04
TSC999
从 n1 到 n2 的程序： Grid[NestWhileList[If[EvenQ[#], #/2, 3*# + 1] &, #, # > 1 &] & /@ Range[5, 26, 1]]  发表于 2018-9-30 09:02
TSC999
我记得楼主曾说过，不赞成把程序合并为一行，并且没有任何注解和说明。另外，希望验证的数字最好能从 n1 到 n2，不限于从 1 开始。如果 mathematica 版本较低，如何稍改这程序以适应低版本？  发表于 2018-9-30 08:43
毋因群疑而阻独见　　毋任己意而废人言
毋私小惠而伤大体　　毋借公论以快私情
回复 支持 反对

使用道具 举报

mathematica
 楼主| 发表于 2018-9-30 09:12:03 | 显示全部楼层
@TSC999
有空多看看mathematica的帮助文件，你就自然懂了，程序特别简单，我就写在一行了，也没注释，本身就没难度，
不过如果你不熟悉mathematica软件，我写得再详细都没用！
毋因群疑而阻独见　　毋任己意而废人言
毋私小惠而伤大体　　毋借公论以快私情
回复 支持 反对

使用道具 举报

gxqcn
发表于 2018-9-30 09:17:26 | 显示全部楼层
如果从1向后连续验证，当得到的中间结果小于初始值时，即可提前结束了。
毋因群疑而阻独见　　毋任己意而废人言
毋私小惠而伤大体　　毋借公论以快私情
回复 支持 1 反对 0

使用道具 举报

zeroieme
发表于 2018-10-1 11:29:36 | 显示全部楼层
借用郭老板的思路
  1. Select[Range[10^6],Function[{i},TimeConstrained[(#!=1&&#>=i&)[NestWhile[If[EvenQ[#],#/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}\) 了，符号计算万岁！
  1. Nest[Function[{LastStep,TheFilesList},((#[[1]]>>("Collatz conjecture-Step"<>ToString[LastStep+1]<>"-File"<>#<>".txt"&)[ToString[(#+1&)[Length[FileNames["Collatz conjecture-Step"<>ToString[LastStep+1]<>"-File*.txt"]]]]])&)[NestWhile[{(NestWhile[(#[[1;;65536]]>>("Collatz conjecture-Step"<>ToString[LastStep+1]<>"-File"<>#<>".txt"&)[ToString[(#+1&)[Length[FileNames["Collatz conjecture-Step"<>ToString[LastStep+1]<>"-File*.txt"]]]]];#[[65537;;-1]])&,#,Length[#]>65536&]&)[Join[#[[1]],(Join@@#&)[(Parallelize[((DeleteCases[#,Null]&)[(((If[Simplify[#[[1]]<#[[2]],k>0],#]&)[{#[[1]],(NestWhile[Expand[#/2]&,#,And@@EvenQ/@CoefficientList[#,k]&]&)[(If[EvenQ[Coefficient[#,k,0]],#,Expand[3 #+1]]&)[#[[2]]]]}]&)/@#&)[Expand[#/. {{k->2 k},{k->2 k+1}}]]]&)/@#]&)[Get[#[[2,1]]]]]]],DeleteFile[#[[2,1]]];Delete[#[[2]],1]}&,{{},TheFilesList},#[[2]]!={}&]];{LastStep+1,FileNames["Collatz conjecture-Step"<>ToString[LastStep+1]<>"-File*.txt"]}]@@#&,{0,{{k,k}}>>"Collatz conjecture-Step0-File1.txt";{"Collatz conjecture-Step0-File1.txt"}},30]
复制代码
毋因群疑而阻独见　　毋任己意而废人言
毋私小惠而伤大体　　毋借公论以快私情
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

小黑屋|手机版|数学研发网 ( 苏ICP备07505100号 )

GMT+8, 2024-5-2 11:11 , Processed in 0.045088 second(s), 17 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表