3
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Related: mathematica.stackexchange.com/questions/608/… $\endgroup$ – Szabolcs Sep 30 '15 at 15:09
  • 1
    $\begingroup$ I don't see why you wrote "randomly" if then you want "all permutations" $\endgroup$ – Dr. belisarius Sep 30 '15 at 15:32
  • $\begingroup$ @belisarius Ah, that explains my original misunderstanding (I voted to close as duplicate of the above then retracted the vote ...) $\endgroup$ – Szabolcs Sep 30 '15 at 15:41
7
$\begingroup$
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
*)
$\endgroup$
5
$\begingroup$

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/@%

enter image description here

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

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

enter image description here

$\endgroup$

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.