Mientras miraba la pregunta belisarius sobre generation of non-singular integer matrices with uniform distribution of its elements, estaba estudiando un documento de Dana Randal, "Efficient generation of random non-singular matrices". El algoritmo propuesto es recursivo e implica generar una matriz de menor dimensión y asignarla a un menor dado. Usé combinaciones de Insert
y Transpose
para hacerlo, pero debe haber maneras más eficientes de hacerlo. ¿Como lo harias?¿Cómo configurar de forma eficiente el elemento secundario de la matriz en Mathematica?
El siguiente es el código:
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]
Lo hace generar una matriz no singular, y tiene una distribución uniforme de elementos de matriz, pero requiere p ser primer:
El código tampoco es eficiente, es decir, sospecho que debido a mis constructores de matrices ineficientes:
In[10]:= Timing[NonSingularRandomMatrix[101, 300];]
Out[10]= {0.421, Null}
EDIT Así que permítanme resumir mi pregunta. La matriz de menor importancia de una matriz dada
m
puede calcularse de la siguiente manera:
MinorMatrix[m_?MatrixQ, {i_, j_}] :=
Drop[Transpose[Drop[Transpose[m], {j}]], {i}]
Es la matriz original con i
fila -ésimo y j
columna -ésimo eliminado.
ahora tengo que crear una matriz de tamaño n
por n
que tendrá la matriz menor dada mm
en la posición {i,j}
. Lo que he usado en el algoritmo fue:
ExpandMinor[minmat_, {i_, j_}, v1_,
v2_] /; {Length[v1] - 1, Length[v2]} == Dimensions[minmat] :=
Insert[Transpose[Insert[Transpose[minmat], v2, j]], v1, i]
Ejemplo:
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}}
estoy esperando que esto se puede hacer de manera más eficiente, que es lo que estoy solicitando en la pregunta.
Por sugerencia de blisarius Miré en la implementación de ExpandMinor
través 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], [email protected]{v2[[;; i - 1]]},
Part[m, ;; i - 1, j ;;]},
{{v1[[;; j - 1]]}, {{v1[[j]]}}, {v1[[j + 1 ;;]]}},
{Part[m, i ;;, ;; j - 1], [email protected]{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], [email protected]{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}
Lo siento, soy flojo hoy :). Minor es así http://en.wikipedia.org/wiki/Minor_(linear_algebra)#Example, ¿no es así? –
@belisarius El menor en esa página es el determinante de lo que estoy hablando. Editaré mi publicación para explicar más. – Sasha
Posiblemente relevante http://stackoverflow.com/questions/4270802/inserting-into-a-2d-list –