用1*2的骨牌覆盖m*n的矩形

wayne

用Mathematica倒是可以算出来，是2514位:

1. 131846265682526346728507315343698114800359053496634301009828679411402441813422646362126551910
2. <<中间省去2327个数字>>
3. 1124189194251019445973743551751313240131140123164222090884336530044099119589255278716329116901

复制代码

wayne

这里有一思路,可供参考： 设x是某整系数多形式的根。y是另一整系数多形式的根。 则 (x_j+y_k) k从1到n， 连乘，根据韦达定理，可以将此结果转化成关于x_j 的n次多形式。 然后，对j从1到m，连乘，再根据韦达定理，化简之。 整个过程全部是 整数运算， 没有 浮点数的参与

litaoye

用Mathematica倒是可以算出来，10053位数： 30218390885738681717872468636289267256461196491079669439063771797953120872022759185772169039227650355532258121362657199045722981311373300566909443592668291470 ... wayne 发表于 2012-8-30 11:14

哇Mathematica太强大了，不知道具体内部是怎么算的。 这个运算，算了多长时间？

litaoye

这里有一思路,可供参考： 设x是某整系数多形式的根。y是另一整系数多形式的根。 则 (xj+yk) k从1到n， 连乘，根据韦达定理，可以将此结果转化成关于xj 的n次多形式。 然后，对j从1到m，连乘，再根据韦达定理，化 ... wayne 发表于 2012-8-30 11:38

这个方法我学习一下。我之前一直希望能够直接通过整数乘法来算，不过后来我发现结果中有比较大的质数，所以感觉自己的方法可能有问题。遇到这个问题，才发现自己数学底子太薄，解决不了复杂的问题。

wayne

13# litaoye AMD双核，台式机，61秒钟。 直接符号运算，效率太低，我是浮点运算的，Mathematica 内部的实现我也不知道，应该是普适的方法吧。

1. m = 200; n = 100; Timing[N[Product[4 Cos[(Pi j)/(m + 1)]^2 + 4 Cos[(Pi k)/(n + 1)]^2, {j, Ceiling[m/2]}, {k, Ceiling[n/2]}], 10100]];
3. Short[IntegerPart[%], 3]

复制代码

我数学底子也不好。

litaoye

我以为符号运算能够解决呢，不过这也是个很不错的方法，1分钟就可以算出结果，已经超出我的预期了。

13# litaoye AMD双核，台式机，61秒钟。 直接符号运算，效率太低，我是浮点运算的，Mathematica 内部的实现我也不知道，应该是普适的方法吧。m = 200; n = 100; Timing[N[Product[4 Cos[(Pi j)/(m + 1)]^2 + 4 C ... wayne 发表于 2012-8-30 13:11

mathematica

m*n/(1*2)?????????????????

mathe

2. MB(n)=
3. {
4. local(B);
5. B=matrix(n,n);
6. for(u=1,n-1,
7. B[u,u+1]=1;
8. B[u+1,u]=1
9. );
10. B
11. }
12. MI(n)=
13. {
14. local(B);
15. B=matrix(n,n);
16. for(u=1,n, B[u,u]=1);
17. B
18. }
20. V(m,n)=
21. {
22. local(M1,M2,M3,B);
23. B=MB(n)*I;
24. M1=MI(n);
25. M2=B;
26. for(u=2,m,
27. M3=B*M2-M1;
28. M1=M2;M2=M3
29. );
30. sqrtint(matdet(M2))
31. }

复制代码

谁转化成mathematica看看

wayne

13# litaoye 我搞错了, 实际答案应该是一个2514位数,即原答案的四次方根,实际消耗时间也只有几秒钟. 11楼我已经编辑过来了,

wayne

18# mathe , see this:

1. MI[n_] := IdentityMatrix[n];
2. MB[n_] := SparseArray[{i_, j_} /; Abs[i - j] == 1 -> 1, {n, n}];
3. V[m_, n_] := Module[{M1, M2, M3, B}, B = MB[n]*I; M1 = MI[n]; M2 = B;
4. For[ii = 2, ii <= m, ii++, M3 = B.M2 - M1; M1 = M2; M2 = M3;]; Sqrt@Det[M2]]

复制代码

函数V还可以改得更简洁:

2. V[m_, n_] := Module[{B}, B=MB[n]*I;Sqrt@Det@Last@Nest[{#[[2]], B.#[[2]]-#[[1]]}&, {MI[n],B},m-1]]

复制代码