Permutations of 0's and 1's in a lower-triangular matrix

Question

For a given $n \ge 5$ create every $n$-by-$n$ matrix containing exactly four $1$'s strictly below the diagonal and $0$'s elsewhere.

Related: http://mathematica.stackexchange.com/questions/608/how-to-generate-random-directed-acyclic-graphs — Szabolcs, Sep 30 '15 at 15:09
I don't see why you wrote "randomly" if then you want "all permutations" — Dr. belisarius, Sep 30 '15 at 15:32
@belisarius Ah, that explains my original misunderstanding (I voted to close as duplicate of the above then retracted the vote ...) — Szabolcs, Sep 30 '15 at 15:41

MarcoB · Accepted Answer · 2015-09-30T16:14:21.963

indices = Flatten[Table[{i, j}, {i, 2, 5}, {j, 1, i - 1}], 1];
allarrays = SparseArray[# -> 1, 5] & /@ Subsets[indices, {4}];

The code generates 210 such matrices (see Length@allarrays). Here is a sample of one of them:

allarrays[[3]] // Normal

(* Out:
{{0, 0, 0, 0, 0},
 {1, 0, 0, 0, 0},
 {1, 1, 0, 0, 0},
 {0, 0, 1, 0, 0},
 {0, 0, 0, 0, 0}}
*)

Mathematica graphics

Here is a general function to accomplish the task:

generator[n_Integer] := Module[
   {indices, allarrays},
   indices = Flatten[Table[{i, j}, {i, 2, n}, {j, 1, i - 1}], 1];
   allarrays = SparseArray[# -> 1, n] & /@ Subsets[indices, {n - 1}]
 ]

You can check the output against the $n=5$ case shown above:

generator[5] == allarrays

(* Out: True *)

Keep in mind that the number of matrices to be generated blows up really quickly and the results take quite a bit of space in memory as well. For instance:

results = generator[8]; // AbsoluteTiming
Length[results]
ByteCount[results]/1024.^3 (* to convert to GB *)

(* Out:
{11.9763, Null}
1 184 040
0.996862
*)

kale · Answer 2 · 2015-09-30T16:06:38.690

5

Eh, what the heck... With RandomSample and ReplacePart:

With[{ss = Subsets[Flatten@
 MapIndexed[Range[#1, #2 + #1 - 1] &, Range[6, 21, 5]], {4}]},
 Partition[ReplacePart[ConstantArray[0, 25], Thread[# -> 1]], 5] & /@ ss]

And...

MatrixForm/@%

edited Sep 30 '15 at 16:06

answered Sep 30 '15 at 15:59

kale

10,922
1
32
69

You are generating only one instance, not ALL of them as requested. – MarcoB Sep 30 '15 at 16:01
@MarcoB... oops, Fixed. – kale Sep 30 '15 at 16:04

score 2 · Answer 3 · answered Oct 01 '15 at 10:04

A variant:

f[i_, j_, n_] := n (i - 1)  + j
fun[n_] := f[##, n] & @@@ Subsets[Range[n], {2}]
sa[n_] := Module[{r = Subsets[fun[n], {4}]},
  Transpose@Partition[SparseArray[Thread[# -> 1], n^2], n] & /@ r]

saproduces the desired matrices (in this case with 4 "ones" in elements below diagonal.

Length[sa@#] & /@ Range[5, 10]

shows the growth with argument: {210, 1365, 5985, 20475, 58905, 148995}

Visualizing first 9 elements for n=5,...,10.

vis[n_] := 
 Grid[Partition[ArrayPlot[#, Mesh -> Automatic] & /@ sa[n][[1 ;; 9]], 
   3]]
ListAnimate[vis /@ Range[5, 10]]

Permutations of 0's and 1's in a lower-triangular matrix

3 Answers3