Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I am trying to write a function which produces square matrices with certain characteristics. The function should have two inputs:

  1. number of the rows, n

  2. number of the times each element in the range 1, 2, 3, ..., n should be repeated in the matrix

So assuming the function is called KOCH then KOCH[4, {2, 4, 5, 5}] means the matrix should be 4 x 4 with 1, 2, 3 and 4 repeated respectively for 2, 4, 5, 5 times in the matrix, but each row in the output should be nondecreasing. And finally the function should find all the possible matrices, not only some of them.

The code I prepared is as following

Koch[n_, num_] := 
  Module[{list},
    list = Flatten@Table[Range[n], {i, n}];
    list = DeleteDuplicates[Sort /@ Tuples[list, {n}]];
    list = DeleteDuplicates[Sort /@ Tuples[list, {n}]];
    For[i = 1, i < n + 1, i++, 
      list = list[[Flatten@Position[Map[Count[#, i, 2] &, list], num[[i]]]]]];
    list]

But as you notice what I am doing is to reproduce a large pool of the possible matrices and then filtering them with regards to the constraint on the number of repeatings. So it's inefficient.

My function works for up to n = 4 even though it takes seconds for n = 4 but for n = 5 it fails because of memory constraint with shooting this error

General::nomem: The current computation was aborted because there was insufficientmemory available to complete the computation.

I need to compute for up to n = 15 and, therefore, need a better algorithm to find all the possible matrices given the constraints.

share|improve this question
2  
Sounds like the BKP problem, which is NP-complete. If so, I'd suggest giving up looking for ALL solutions, as there is no know algorithm which can solve it fast and completely. –  Silvia Jun 20 '13 at 19:01
    
Actually I need to have all the possible solutions!! The matrices are going to be ground of an economical theory evaluation!! What if I use a computer with 64GB ram and 12 CPUs??? –  Morry Jun 20 '13 at 19:08
    
Maybe LinearProgramming and LinearSolve would help. –  Silvia Jun 20 '13 at 19:31
    
May I ask you to explain a little more about your idea?? I am familiar with LP but no clues here!! –  Morry Jun 20 '13 at 19:40

2 Answers 2

Not a solution, but I think it would be REALLY hard to enumerate ALL solutions for matrices as large as $n=15$. I don't have a proof, just intuition coming from the size of the solution sets for relatively small $n$s.

The example setting $n=4$, $c=\{2, 4, 5, 5\}$, where $c_k$ denotes the repeating times of $k$, has 6720 solutions.

A setting I tried with $n=5$, $c=\{1, 2, 10, 1, 11\}$ has 151510 solutions.

$n=6$, $c=\{8, 1, 11, 2, 8, 6\}$ has ? (insufficient RAM here..) solutions.

Along with the number of solutions for $n=2$ and $n=3$, it looks like growing exponentially.

So I (wildly) guess the number of solutions for $n=15$ could require up to $\boldsymbol{10^{20}}$ Bytes or one hundred thousand Peta Bytes RAM, which will simply make it impossible even just to allocate them in RAM. Both time and memory costing are unpractical.

share|improve this answer
    
So what I should do is to change to another algorithm!! –  Morry Jun 20 '13 at 21:48
    
@user8144 As the limit is the scale of the final solution set itself, I think any algorithm will not be able to improve this problem. –  Silvia Jun 20 '13 at 21:52

The approach here is to first make a list of required elements, then successively pick valid orws from the remaining list.

I have not verified this is absolutely correct , but it should get you started..

stillneeded[ needed_, rows_ ] := 
   Module[{n0 = needed}, (n0 = Drop[n0, First@Position[n0, #]]) & /@  Flatten[ rows ]; n0]
KOCH[n_, req_] := Module[ {}, 
     needed = Flatten@ Table[j, {j, Length[req]}, {req[[j]]}];
     possible = {#} & /@ 
           Union[Select[ Subsets[needed, {n}] , # == Sort[#] & ]];
    Do[possible = 
         Flatten[Table[(Join[possible[[j]], {#}] & /@ 
              Union[Select[ 
           Subsets[ stillneeded[needed, possible[[j]]], {n}] , # ==  Sort[#] & ] ]) ,
                         {j, Length[possible]}], 1] ; 
         Print["row", irow + 1, "npos", Length[possible]], {irow,  n - 1}] ;  
                possible   ] /; (Total@req == n^2)
     Length[ KOCH[4, {2, 4, 5, 5}] ]
share|improve this answer
    
Thanks a lot @george2079 ..... I added DeleteDuplicates@(Sort /@ possible) to your code and it works proper and fast for n=5, but for n=6 it takes more than 6 hours to compute.... and imagine the larger n.... at least the RAM problem is vanished in your code!!! –  Morry Jun 21 '13 at 8:28

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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