作为合成噪声生成算法的一部分,我必须动态构建许多大型非奇异平方矩阵
a i,j (i,j:1..n)/∀(i,j)a i,j ∈ℤ且0≤a i,j ≤k且Det [a]≠0
但是a i,j 在[0,k]中均匀分布后也应该是随机的。
目前的问题是这个问题的n = 300,k≅100。
在Mathematica中,我可以非常快速地生成随机元素矩阵,但问题是我还必须检查奇点。我目前正在使用Determinant值。
问题是这个检查,对于300x300矩阵需要2秒左右的时间,我负担不起。
当然我可以通过选择一个随机的第一行然后构造连续的正交行来构造行,但我不确定如何保证这些行的元素遵循[0,k]中的均匀分布。
我正在寻找Mathematica中的解决方案,但是也欢迎使用更快的生成矩阵的算法。
NB> U [0,k]条件意味着采用一组矩阵,整个集合中的每个位置(i,j)应遵循均匀分布。
答案 0 :(得分:5)
在Matlab和Octave中,500x500矩阵的行列式和LU因子分解基本上是瞬时的。 Mathematica有一个可以调用LAPACK或类似库的模式吗?您可能需要注释您的数组应该被视为浮点数而不是符号;这可能会让它快得多。作为比较,使用Octave在我的系统上使用5.8x5000矩阵的LU需要8.66秒; 500x500应该比这快1000倍。
答案 1 :(得分:5)
您可以使用MatrixRank
代替。在我的机器上,对于大的nxn整数矩阵,它大约快了n / 10倍。
答案 2 :(得分:3)
如果在奇点测试中使用数值近似矩阵,您将获得更好的速度。
k = 100; n = 500;
mat = RandomInteger[100, {n, n}];
AbsoluteTiming[Det[mat] == 0]
Out [57] = {6.8640000,False}
AbsoluteTiming[Det[N@mat] == 0.] (*warning light!!*)
Out [58] = {0.0230000,False}
AbsoluteTiming[MatrixRank[N@mat] != n]
Out [59] = {0.1710000,False}
不幸的是,最快的测试并不可靠。但排名测试应该运作良好。这是一个快速示例,其中我们用前一行的总和替换最后一行。
mat2 = mat;
mat2[[-1]] = Total[Most[mat]];
AbsoluteTiming[Det[mat2] == 0]
Out [70] = {9.4750000,True}
AbsoluteTiming[Det[N@mat2] == 0.]
Out [69] = {0.0470000,False}
AbsoluteTiming[MatrixRank[N@mat2] != n]
Out [71] = {0.1440000,True}
原则上我认为排名测试可能会给出假阴性的可能性很小。比如由于病情恶化。由于您的使用将更好地容忍误报(即,不正确的奇点声称),您可以测试奇点超过素数模数。我认为这是其他人提出的建议之一。
继续上述例子:
AbsoluteTiming[Det[mat, Modulus -> Prime[1000]]]
Out [77] = {0.6320000,4054}
AbsoluteTiming[Det[mat2, Modulus -> Prime[1000]]]
输出[78] = {0.6470000,0}
这比在理性上工作要慢但速度快。对于它的价值,对于大多数用途,我对通过MatrixRank [N [矩阵]]进行更快速测试的结果非常有信心。
Daniel Lichtblau Wolfram Research
答案 3 :(得分:1)
这是我做了一点评论的扩展。我同意Dan的观点,即数字版本会出现误报,这是极不可能的。尽管如此,如果最小奇异值大于某个误差容差,您可以通过检查奇异值并可靠地返回False来避免这种情况。 (无可否认,找到可证明的容差可能有点棘手。)如果最小的奇异值小得令人不舒服,可以将Det应用于整数矩阵。
这是一个函数,对于大多数非奇异矩阵,它应该快速返回False。如果矩阵接近单数,则执行更昂贵的整数计算。
singularQ[M_?MatrixQ] := If[
Last[SingularValueList[N[M], Tolerance -> 0]] > 1/10.0^8,
False, Det[M] == 0];
以下是符合您描述的200个矩阵。中间的一个被操纵为单数。
SeedRandom[1];
matrices = RandomInteger[{0, 100}, {200, 300, 300}];
matrices[[100, -1]] = Sum[RandomInteger[{0, 10}]*matrices[[100, k]],
{k, 1, Length[matrices[[100]]] - 1}];
现在,让我们找到所有奇异矩阵的索引,随时观察。
Flatten@Monitor[Table[
If[singularQ[matrices[[k]]], k, {}],
{k, 1, Length[matrices]}], k]