找回密码
 欢迎注册
查看: 14205|回复: 6

[提问] Mathematica 中,有何指令可将列表 {1,2,3,4} 变为 {1234} ?

[复制链接]
发表于 2015-10-29 08:25:50 | 显示全部楼层 |阅读模式

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

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

×
问题来源:
任意给定一个正整数,例如 6874,将其各位数码由大到小排列得 8764,由小到大排得 4678,求二者的差。如何用 Mathematica  编程?
我写的程序前几句是:

a = 6874;                     (* 给定的一个数 *)
b1 = IntegerDigits[a]    (* 按位拆成一个列表  *)
b2 = Sort[b1]               (* 从小到大排序  *)
b3 = Reverse[b2]         (* 从大到小排序  *)

运行结果是:
{6, 8, 7, 4}
{4, 6, 7, 8}
{8, 7, 6, 4}

现在只完成了从小到大和从大到小的排序,却没有办法相减,因为大表直接减小表得 {4, 1, -1, -4},而不是希望的 {8764} - {4678} = {4086}。
应该用什么指令才能将 {4, 6, 7, 8} 变成 {4678} ?

点评

FromDigits  发表于 2015-10-29 08:28
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2015-10-29 13:15:39 | 显示全部楼层
谢谢 wayne 大师!

a = 6874;
b1 = IntegerDigits[a]
b2 = Sort[b1]
b3 = Reverse[b2]
FromDigits[b3] - FromDigits[b2]
运行结果:
{6, 8, 7, 4}
{4, 6, 7, 8}
{8, 7, 6, 4}
4086
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2015-10-30 08:26:54 | 显示全部楼层
TSC999 发表于 2015-10-29 13:15
谢谢 wayne 大师!

a = 6874;

你这个是想穷举6174问题的
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
 楼主| 发表于 2015-10-31 09:55:57 | 显示全部楼层
cn8888 发表于 2015-10-30 08:26
你这个是想穷举6174问题的

cn8888先生说得不错呀,就是想用 mathematica 写个“卡布列克” 运算的小程序。
代码如下,请各位指教:

n = 3584514;    (* 任意给定一个多位数 n   *)
i = 0;
m = 0; lst = {n};
Print[i, "------", n]
For[i = 1, i < 1000, i++,
n = FromDigits[Reverse[Sort[IntegerDigits[n]]]] -
   FromDigits[Sort[IntegerDigits[n]]];
lst = Append[lst, n];
  For[j = 1, j < i, j++; If[n == lst[[j]], m = 1; mm = j]];
Print[i, "------", n]
  If[m == 1, Break[]]
]  
Print["从第 ", mm - 1, " 步开始进入循环圈(循环圈长度是 ", j + 1 - mm, "):"]
For[k = mm, k < j + 2, k++, Print[lst[[k]], " "]]

0------3584514

1------7209873

2------9639531

3------8629632

4------7629633

5------7429653

6------7419753

7------8429652

8------7619733

9------8439552

10------7509843

11------9529641

12------8719722

13------8649432

14------7519743

15------8429652

从第 7 步开始进入循环圈(循环圈长度是 8):

8429652

7619733

8439552

7509843

9529641

8719722

8649432

7519743

8429652
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2015-11-9 12:09:38 | 显示全部楼层
TSC999 发表于 2015-10-31 09:55
cn8888先生说得不错呀,就是想用 mathematica 写个“卡布列克” 运算的小程序。
代码如下,请各位指教: ...

你的程序排版太差了,我看不下去
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
发表于 2015-11-10 11:42:26 | 显示全部楼层
2015-11-10_114251.png
  1. FixedPointList[FromDigits[Reverse@#-#]&@Sort@IntegerDigits@#&,9876]
  2. Reap[FixedPoint[Length@Union@Sow@NestList[FromDigits[Reverse@#-#]&@Sort@IntegerDigits@#&,3584514,#]&,1]][[2,1,-1]]
复制代码
毋因群疑而阻独见  毋任己意而废人言
毋私小惠而伤大体  毋借公论以快私情
您需要登录后才可以回帖 登录 | 欢迎注册

本版积分规则

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

GMT+8, 2024-3-29 17:52 , Processed in 0.048799 second(s), 20 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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