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

TSC999

问题来源：
任意给定一个正整数，例如 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} ？

TSC999

谢谢 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

cn8888

TSC999 发表于 2015-10-29 13:15
谢谢 wayne 大师！

a = 6874;

你这个是想穷举6174问题的

TSC999

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

cn8888

TSC999 发表于 2015-10-31 09:55
cn8888先生说得不错呀，就是想用 mathematica 写个“卡布列克” 运算的小程序。
代码如下，请各位指教： ...

你的程序排版太差了，我看不下去

chyanog

1. FixedPointList[FromDigits[Reverse@#-#]&@Sort@IntegerDigits@#&,9876]
   
2. Reap[FixedPoint[Length@Union@Sow@NestList[FromDigits[Reverse@#-#]&@Sort@IntegerDigits@#&,3584514,#]&,1]][[2,1,-1]]

复制代码