Как эффективно установить минор матрицы в Mathematica?

Рассматривая вопрос belisarius о генерации несингулярных целочисленных матриц с равномерным распределением элементов, я изучал работу Dana Randal, "Efficient generation of random non-singular matrices". Предложенный алгоритм является рекурсивным и предполагает генерацию матрицы меньшей размерности и присвоение ей заданного минора. Я использовал для этого комбинации Insert и Transpose, но наверняка существуют более эффективные способы. Как бы вы это сделали?

Ниже приведен код:

Clear[Gen];
Gen[p_, 1] := {{{1}}, 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)

Код также не каждый эффективен, что, как я подозреваю, связано с моими неэффективными конструкторами матриц:

In[10]:= Timing[NonSingularRandomMatrix[101, 300];]

Out[10]= {0.421, Null}


EDIT Итак, позвольте мне сократить мой вопрос. Минорную матрицу заданной матрицы m можно вычислить следующим образом:
MinorMatrix[m_?MatrixQ, {i_, j_}] := 
 Drop[Transpose[Drop[Transpose[m], {j}]], {i}]

Это исходная матрица с 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}}

Я надеюсь, что это можно сделать более эффективно, о чем я и прошу в вопросе.


По предложению blisarius я рассмотрел возможность реализации ExpandMinor через 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}
6
задан Community 23 May 2017 в 11:55
поделиться