Message Boards Message Boards

Generating a special m x n matrix?

Posted 8 years ago

I am trying to program a function depending only on two parameters, let's say n and r, which generates a m x n matrix of natural numbers between 1 and r verifying the following conditions: for two neighboring matrix elements the one on the right must be equal or greater than the one on the left but equal or smaller than n, starting with 1. For n=2 and r=2 for instance, this yields the matrix

{{1,1}, {1,2}, {2,2}}

or for n=3 and r=2, this yields

{{1, 1, 1}, {1, 1, 2}, {1, 2, 2}, {2, 2, 2}}

I tried several hours with Do or Table, but without success. Unfortunately, I am not good enough in programming so any help would highly be appreciated.

POSTED BY: Ulrich Utiger
5 Replies

The number of elements 'm' can be given by:

Pochhammer[n, r]/r!

Check:

Table[Length[GiveList[n, r]], {n, 1, 7}, {r, 1, 7}] // Grid
Table[Pochhammer[n, r]/r!, {n, 1, 7}, {r, 1, 7}] // Grid
POSTED BY: Sander Huisman
Posted 8 years ago

@Sander: Wow, this works. Thanks a lot. I was trying something with an integer c incrementing it and transforming it into base r with IntegerDigits. Far too complicate...

@Bill: You have almost done it too. Thank you anyway. Maybe I can complete it and test it for speed against the method of Sander as I will use the function in a loop for big n and r.

POSTED BY: Ulrich Utiger

The problem with my two other solutions is that you start off with a very large list and sieve a lot of them out. For n and r below 6 or so this is fine, however if you try 10 or so it will not work as you start off with a list of 10^10 elements and filter it, will never work; too big.

IntegerDigits works similarly but you will also start off with way too many, and you filter more and more for higher r and n....

POSTED BY: Sander Huisman
Posted 8 years ago

.

f[n_, r_] := Select[IntegerDigits[Range[0, 2^n-1], r, n]+1, LessEqual @@ # &]

In[2]:= f[2, 2]

Out[2]= {{1, 1}, {1, 2}, {2, 2}}

In[3]:= f[3, 2]

Out[3]= {{1, 1, 1}, {1, 1, 2}, {1, 2, 2}, {2, 2, 2}}

I am not certain that I have interpreted your 'r' correctly.

POSTED BY: Bill Simpson

I'm not sure if I understand your description exactly but I think you can generalize your pattern like so:

ClearAll[GiveList]
(*GiveList[n_,r_]:=Select[Tuples[Range[r],n],And@@NonNegative[Differences[#]]&]*)
(*GiveList[n_, r_] := DeleteDuplicatesBy[Tuples[Range[r], n], Sort]*)
GiveList[n_Integer,r_Integer]:=Module[{vars,seq},
  vars=Table[Unique[],r];
  seq=MapThread[{#1,#2,n}&,{vars,Prepend[Most[vars],1]}];
  Flatten[Table[vars,Evaluate[Sequence@@seq]],r-1]
]
GiveList[2, 2]
GiveList[2, 3]
GiveList[3, 2]
GiveList[3, 3]

{{1,1},{1,2},{2,2}}
{{1,1},{1,2},{1,3},{2,2},{2,3},{3,3}}
{{1,1,1},{1,1,2},{1,2,2},{2,2,2}}
{{1,1,1},{1,1,2},{1,1,3},{1,2,2},{1,2,3},{1,3,3},{2,2,2},{2,2,3},{2,3,3},{3,3,3}}

I came up with multiple ways of implementing it, but the last one seems to be the nicest (and fastest) implementation I think...

POSTED BY: Sander Huisman
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract