Question

在查看belisarius关于generation of non-singular integer matrices with uniform distribution of its elements的问题时，我正在研究Dana Randal撰写的一篇论文，“Efficient generation of random non-singular matrices”。提出的算法是递归的，并且涉及生成较低维度的矩阵并将其分配给给定的次要。我使用Insert和Transpose的组合来完成它，但必须有更有效的方法。你会怎么做？

以下是代码：

Clear[Gen];
Gen[p_, 1] := {In[10]:= Timing[NonSingularRandomMatrix[101, 300];]

Out[10]= {0.421, Null}
, RandomInteger[{1, p - 1}, {1, 1}]};
Gen[p_, n_] := Module[{v, r, aa, tt, afr, am, tm},
  While[True,
   v = RandomInteger[{0, p - 1}, n];
   r = LengthWhile[v, # == 0 &] + 1;
   If[r <= n, Break[]]
   ];
  afr = UnitVector[n, r];
  {am, tm} = Gen[p, n - 1];
  {Insert[
    Transpose[
     Insert[Transpose[am], RandomInteger[{0, p - 1}, n - 1], r]], afr,
     1], Insert[
    Transpose[Insert[Transpose[tm], ConstantArray[0, n - 1], r]], v, 
    r]}
  ]

NonSingularRandomMatrix[p_?PrimeQ, n_] := Mod[Dot @@ Gen[p, n], p]

它确实生成一个非奇异矩阵，并且矩阵元素的分布均匀，但需要p为素数：

histogram of matrix element (2, 3)

代码也不是很有效，我怀疑是因为我的矩阵构造函数效率低下：

<小时/> 编辑所以让我来浓缩我的问题。给定矩阵

MinorMatrix[m_?MatrixQ, {i_, j_}] := 
 Drop[Transpose[Drop[Transpose[m], {j}]], {i}]

的次矩阵可以如下计算：

原始矩阵中删除了第j行和第n列。

我现在需要在n之前创建一个大小为mm的矩阵，该矩阵在位置{i,j}处具有给定的次要矩阵ExpandMinor[minmat_, {i_, j_}, v1_, v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[minmat] := Insert[Transpose[Insert[Transpose[minmat], v2, j]], v1, i]。我在算法中使用的是：

In[31]:= ExpandMinor[
 IdentityMatrix[4], {2, 3}, {1, 2, 3, 4, 5}, {2, 3, 4, 4}]

Out[31]= {{1, 0, 2, 0, 0}, {1, 2, 3, 4, 5}, {0, 1, 3, 0, 0}, {0, 0, 4,
   1, 0}, {0, 0, 4, 0, 1}}

示例：

ExpandMinor

我希望这可以更有效率地完成，这就是我在这个问题上所征求的。

Per blisarius的建议我考虑通过ArrayFlatten实施Clear[ExpandMinorAlt]; ExpandMinorAlt[m_, {i_ /; i > 1, j_}, v1_, v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[m] := ArrayFlatten[{ {Part[m, ;; i - 1, ;; j - 1], Transpose@{v2[[;; i - 1]]}, Part[m, ;; i - 1, j ;;]}, {{v1[[;; j - 1]]}, {{v1[[j]]}}, {v1[[j + 1 ;;]]}}, {Part[m, i ;;, ;; j - 1], Transpose@{v2[[i ;;]]}, Part[m, i ;;, j ;;]} }] ExpandMinorAlt[m_, {1, j_}, v1_, v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[m] := ArrayFlatten[{ {{v1[[;; j - 1]]}, {{v1[[j]]}}, {v1[[j + 1 ;;]]}}, {Part[m, All, ;; j - 1], Transpose@{v2}, Part[m, All, j ;;]} }] In[192]:= dim = 5; mm = RandomInteger[{-5, 5}, {dim, dim}]; v1 = RandomInteger[{-5, 5}, dim + 1]; v2 = RandomInteger[{-5, 5}, dim]; In[196]:= Table[ExpandMinor[mm, {i, j}, v1, v2] == ExpandMinorAlt[mm, {i, j}, v1, v2], {i, dim}, {j, dim}] // Flatten // DeleteDuplicates Out[196]= {True}。

{{1}}

Answer 1

我花了一段时间才到达这里，但由于我花了很多时间来生成随机矩阵，我无法帮助它，所以这里有。代码中的主要低效率来自于移动矩阵（复制它们）的必要性。如果我们可以重新构造算法，以便我们只修改单个矩阵，我们就可以赢得大奖。为此，我们必须计算插入的矢量/行最终的位置，因为我们通常会插入较小矩阵的中间，从而移动元素。这个有可能。这是代码：

gen = Compile[{{p, _Integer}, {n, _Integer}},
 Module[{vmat = Table[0, {n}, {n}],
    rs = Table[0, {n}],(* A vector of r-s*)
    amatr = Table[0, {n}, {n}],
    tmatr = Table[0, {n}, {n}],
    i = 1,
    v = Table[0, {n}],
    r = n + 1,
    rsc = Table[0, {n}], (* recomputed r-s *)
    matstarts = Table[0, {n}], (* Horizontal positions of submatrix starts at a given step *)    
    remainingShifts = Table[0, {n}] 
      (* 
      ** shifts that will be performed after a given row/vector insertion, 
      ** and can affect the real positions where the elements will end up
      *)
},
(* 
 ** Compute the r-s and vectors v all at once. Pad smaller 
 ** vectors v with zeros to fill a rectangular matrix
*)
For[i = 1, i <= n, i++,
 While[True,
  v = RandomInteger[{0, p - 1}, i];
  For[r = 1, r <= i && v[[r]] == 0, r++];
  If[r <= i,
   vmat[[i]] = PadRight[v, n];
   rs[[i]] = r;
   Break[]]
  ]];
 (* 
 ** We must recompute the actual r-s, since the elements will 
 ** move due to subsequent column insertions. 
 ** The code below repeatedly adds shifts to the 
 ** r-s on the left, resulting from insertions on the right. 
 ** For example, if vector of r-s 
 ** is {1,2,1,3}, it will become {1,2,1,3}->{2,3,1,3}->{2,4,1,3}, 
 ** and the end result shows where
 ** in the actual matrix the columns (and also rows for the case of 
 ** tmatr) will be inserted 
 *)
 rsc = rs;
 For[i = 2, i <= n, i++,
  remainingShifts = Take[rsc, i - 1];
  For[r = 1, r <= i - 1, r++,
   If[remainingShifts[[r]] == rsc[[i]],
     Break[]
   ]
  ];
  If[ r <= n,
    rsc[[;; i - 1]] += UnitStep[rsc[[;; i - 1]] - rsc[[i]]]
  ]
 ];
 (* 
  ** Compute the starting left positions of sub-
  ** matrices at each step (1x1,2x2,etc)
 *)
 matstarts = FoldList[Min, First@rsc, Rest@rsc];
 (* Initialize matrices - this replaces the recursion base *)
 amatr[[n, rsc[[1]]]] = 1;
 tmatr[[rsc[[1]], rsc[[1]]]] = RandomInteger[{1, p - 1}];
 (* Repeatedly perform insertions  - this replaces recursion *)
 For[i = 2, i <= n, i++,
  amatr[[n - i + 2 ;; n, rsc[[i]]]] = RandomInteger[{0, p - 1}, i - 1];
  amatr[[n - i + 1, rsc[[i]]]] = 1;
  tmatr[[n - i + 2 ;; n, rsc[[i]]]] = Table[0, {i - 1}];
  tmatr[[rsc[[i]], 
    Fold[# + 1 - Unitize[# - #2] &, 
       matstarts[[i]] + Range[0, i - 1], Sort[Drop[rsc, i]]]]] = 
            vmat[[i, 1 ;; i]];    
 ];
 {amatr, tmatr}
 ], 
 {{FoldList[__], _Integer, 1}}, CompilationTarget -> "C"];

NonSignularRanomMatrix[p_?PrimeQ, n_] := Mod[Dot @@ Gen[p, n],p];
NonSignularRanomMatrixAlt[p_?PrimeQ, n_] := Mod[Dot @@ gen[p, n],p];

以下是大矩阵的时间：

In[1114]:= gen [101, 300]; // Timing

Out[1114]= {0.078, Null}

对于直方图，我得到相同的图，效率提高了10倍：

In[1118]:= 
  Histogram[Table[NonSignularRanomMatrix[11, 5][[2, 3]], {10^4}]]; // Timing

Out[1118]= {7.75, Null} 

In[1119]:= 
 Histogram[Table[NonSignularRanomMatrixAlt[11, 5][[2, 3]], {10^4}]]; // Timing

Out[1119]= {0.687, Null}

我希望通过仔细分析上面编译的代码，可以进一步提高性能。另外，我没有在Compile中使用运行时Listable属性，而这应该是可能的。执行赋予未成年人的代码部分也可能是通用的，因此可以将逻辑从主函数中分解出来 - 我还没有对此进行调查。

Answer 2

对于你问题的第一部分（我希望我能正确理解）可以 MinorMatrix写成如下？

MinorMatrixAlt[m_?MatrixQ, {i_, j_}] := Drop[mat, {i}, {j}]

如何在Mathematica中有效地设置矩阵的次要？

2 个答案: