4
$\begingroup$

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.

$\endgroup$

3 Answers 3

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

Examples:

MatrixForm /@ sPM[1] 

enter image description here

MatrixForm /@ sPM[2]

enter image description here

MatrixForm /@ sPM[3]

enter image description here

Length[sPM @ #] & /@ Range[2, 8]
{8, 48, 384, 3840, 46080, 645120, 10321920}
$\endgroup$
2
  • 1
    $\begingroup$ I like that - pretty fast as well. For $n=8$ my function takes about 1.5 minutes - yours takes about 16 seconds. $\endgroup$
    – 1729taxi
    Jan 27 at 12:15
  • $\begingroup$ Well your final edit takes only about 2 seconds. To be honest I should have seen that one myself. Thanks for that - as I said in the initial question - I always learn something when I ask a question like this. Much appreciated . $\endgroup$
    – 1729taxi
    Jan 27 at 21:30
5
$\begingroup$
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}}}    *)
$\endgroup$
1
  • $\begingroup$ Thanks for that - I enjoy deciphering these one liners. Slower than my function but as I said speed is not a driver here. $\endgroup$
    – 1729taxi
    Jan 27 at 12:12
2
$\begingroup$

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...

$\endgroup$
1
  • $\begingroup$ Thanks for the input. Only just saw your post - I'll look at this more closely. $\endgroup$
    – 1729taxi
    Jan 27 at 21:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.