Generating signed permutation matrices

Question

As most people (on here at least) know a permutation matrix is a square binary matrix that has exactly one entry of 1 in each row and each column and 0s elsewhere. For the $n \times n$ case there are $n!$ permutation matrices.

A signed permutation matrix is a generalized permutation matrix whose nonzero entries are ±1 instead of just 1 as in a permutation matrix. For the $n \times n$ case there are $2^n n!$ signed permutation matrices.

So I wrote a little function to generate the signed permutation matrices for a given $n$.

spm[n_] := Module[
  {n0 = n, spmlist, tuples},
  tuples = Tuples[{-1, 1}, n0];
  spmlist = {};
  Do[
   AppendTo[spmlist, 
    Map[Normal[#] &, 
     Map[SparseArray[Table[{i, i} -> tuples[[j, i]], {i, n0}]][[#]] &,
       Permutations[Array[# &, n0]]]]],
   {j, 1, Length@tuples}
   ];
  Join @@ spmlist
  ]

Do[Print[i, "   ", Length@spm[i]], {i, 2, 8}]

(*

2   8

3   48

4   384

5   3840

6   46080

7   645120

8   10321920

*)

This function works. But it looks a bit clunky to me. It's also slow (using AppendTo) though that doesn't concern me too much since I'll not need these for $n>6$ (maybe $n>7$ at a push).

The reason I posted this - does anyone know a less clunky/slicker way of doing this? I always learn something new when I ask a question like this.

Answer 1

sPM = Join @@ Map[Permutations @* DiagonalMatrix] @ Tuples[{-1, 1}, #] &

Examples:

MatrixForm /@ sPM[1] 

MatrixForm /@ sPM[2]

MatrixForm /@ sPM[3]

Length[sPM @ #] & /@ Range[2, 8]

{8, 48, 384, 3840, 46080, 645120, 10321920}

Answer 2

sp[n_] := SparseArray /@ Join @@ Outer[
  MapIndexed[{#2[[1]], #1[[1]]} -> #1[[2]] &, Transpose[{##}]] &, 
    Permutations[Range[n]], Tuples[{-1, 1}, n], 1]

sp[1] // Normal
(*    {{{-1}},
       {{1}}}    *)

sp[2] // Normal
(*    {{{-1, 0}, {0, -1}},
       {{-1, 0}, {0, 1}},
       {{1, 0}, {0, -1}},
       {{1, 0}, {0, 1}},
       {{0, -1}, {-1, 0}},
       {{0, -1}, {1, 0}},
       {{0, 1}, {-1, 0}},
       {{0, 1}, {1, 0}}}    *)

Answer 3

Not beautiful, but a bit faster. It use SparseArray to store the result in an compressed way. I could not use a 3-tensor for that because the CSR compression is applied only to the first list of indices and there is not sparsity to exploit there. Instead, I produces the 3-tensor, but the last two slots flattened together. Here is the code; it is most economic to compute the CSR-compressed sparsity pattern just by hand:

copy[a_, b_] := Flatten[ConstantArray[a, b]];
riffle[a_, b_] := Flatten[Transpose[ConstantArray[a, b]]];

quickSparseArray[rp_?VectorQ, ci_?VectorQ, vals_?VectorQ, 
   dims_?VectorQ, background_ : 0] :=
  
  With[{data = {Automatic, dims, 
      background, {1, {rp, Partition[ci, 1]}, vals}}},
   SparseArray @@ data
   ];

spm2[n0_] := quickSparseArray[
   Range[0, n0 n0! 2^n0, n0],
   n0 riffle[Permutations[Range[0, n0 - 1]], 2^n0] + 
    copy[Range[n0], n0! 2^n0],
   copy[Flatten[Tuples[{1, -1}, n0]], n0!],
   {n0! 2^n0, n0 n0},
   0
   ];

Here is a usage example:

result = spm2[8]; // AbsoluteTiming // First
Dimensions[result]

2.9568

{10321920, 64}

1403781912

Then you can get the k-th matrix with

Partition[result[[k]],n0]

If you want the 3-tensor, then you can additionally do

modifiedresult = ArrayReshape[Normal@result, {Length[result], n0, n0}]; // AbsoluteTiming // First
modifiedresult // Dimensions
ByteCount[modifiedresult]

7.92416

{10321920, 6, 6}

2972713176

Apparently, the memory savings of the SparseArray are not that great...