2011-04-24 7 views
6

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:

histogram of matrix element (2, 3)

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} 
+0

Lo siento, soy flojo hoy :). Minor es así http://en.wikipedia.org/wiki/Minor_(linear_algebra)#Example, ¿no es así? –

+0

@belisarius El menor en esa página es el determinante de lo que estoy hablando. Editaré mi publicación para explicar más. – Sasha

+0

Posiblemente relevante http://stackoverflow.com/questions/4270802/inserting-into-a-2d-list –

Respuesta

6

Me tomó un tiempo para llegar aquí, pero ya que pasé una buena parte de mi postdoctorado la generación de matrices aleatorias, no pudo evitarlo, así que aquí va. La principal ineficacia en el código proviene de la necesidad de mover las matrices (copiarlas). Si pudiéramos reformular el algoritmo para que solo modifiquemos una sola matriz en su lugar, podríamos ganar a lo grande. Para esto, debemos calcular las posiciones donde los vectores/filas insertadas terminarán, dado que típicamente insertaremos en medio de matrices más pequeñas y así cambiaremos los elementos. Esto es posible.Aquí está el código:

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, [email protected], [email protected]]; 
(* 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]; 

Aquí es el momento para la matriz grande:

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

Out[1114]= {0.078, Null} 

Para el histograma, consigo las parcelas idénticas, y el impulso eficiencia de 10 veces:

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} 

Espero que tras un cuidadoso perfil del código compilado anteriormente, uno podría mejorar aún más el rendimiento. Además, no utilicé el atributo Listable en tiempo de ejecución en Compilar, aunque esto debería ser posible. También puede ser que las partes del código que realizan la asignación a menores sean lo suficientemente genéricas para que la lógica se pueda excluir de la función principal; no investigué eso todavía.

+1

@Leonid Tenga en cuenta que 'ConstantArray' no es compatible con' Compile' y generó una llamada al evaluador. Cuando se reemplaza con la llamada 'Tabla' equivalente, el código aumenta en velocidad alrededor del 5%. Estudiaré el código en detalles. Actualice el código a su conveniencia y actualice también las definiciones 'NonSignularRanomMatrix' y' NonSignularRanomMatrixAlt' con las llamadas 'Mod' que agregue en mi edición, ya que no lo hice. Gracias. – Sasha

+0

@belisarius El artículo hablaba de generación en campo finito, y olvidé la reducción modular final. Una vez que se aplica y actualicé mi código original, los elementos de la matriz se distribuyen de manera uniforme. Ahora con el código de alto rendimiento de Leonid, podría considerar usar esto para su algoritmo de filtrado. – Sasha

+0

@Leonid ¡Muy buen trabajo! – Sasha

2

Para la primera parte de su pregunta (que espero que entiendo correctamente) puede MinorMatrix escribirse de la siguiente manera?

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

Sí, puede ser. – Sasha

Cuestiones relacionadas