Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Re: random matrix from row and column sums

  • To: mathgroup at smc.vnet.net
  • Subject: [mg53609] Re: [mg53598] Re: random matrix from row and column sums
  • From: DrBob <drbob at bigfoot.com>
  • Date: Thu, 20 Jan 2005 03:47:50 -0500 (EST)
  • References: <csinpt$njk$1@smc.vnet.net> <200501190700.CAA06903@smc.vnet.net>
  • Reply-to: drbob at bigfoot.com
  • Sender: owner-wri-mathgroup at wolfram.com

Random procedures that don't first identify ALL solutions can certainly be faster.

This works well, for instance:

Clear@randomFill
randomFill[rowSums:{__Integer?Positive},
     colSums:{__Integer?Positive}]:=Module[{r=Length@rowSums,c=
     Length@colSums,m,gaps,p,i,j},
     m=Table[0,{r},{c}];zeroes=0m;
     While[(gaps=Table[Min[rowSums[[i]]-Tr@m[[i]],
       colSums[[j]]-Tr@m[[All,j]]],{i,r},{j,c}])!=zeroes,
       p=Position[gaps,_?Positive];{i,j}=p[[Random[Integer,{1,Length@p}]]];
       m[[i,j]]+=Random[Integer,{1,gaps[[i,j]]}]
       ];m
     ]
randomFill[{7,3,2,1},{2,9,2}]

{{0,6,1},{2,1,0},{0,1,1},{0,1,0}}

However, I don't think solutions are chosen with equal frequency, under any such scheme.

For instance:

Timing[f=Frequencies[Array[randomFill[Range@4,Range@4]&,{20000}]][[All,1]]]
Through[{Length,Min,Max}@f]

{36.734 Second,{103,204,45,72,
   155,102,105,105,77,69,157,55,57,45,18,58,67,51,74,37,73,36,28,
     71,143,96,60,55,91,110,97,100,49,73,127,40,26,82,74,18,41,67,31,44,56,43,
     82,28,41,43,24,55,52,23,70,35,39,184,73,78,196,147,79,105,85,73,158,88,
     30,50,144,77,113,53,94,62,36,67,85,82,116,28,43,115,93,34,55,93,98,94,
     35,96,103,103,103,76,101,60,51,107,94,44,30,32,65,71,58,58,33,42,71,146,
     62,125,120,83,171,58,30,53,49,25,54,57,23,60,44,39,67,36,65,
     43,35,41,49,96,171,91,107,115,98,178,132,54,105,44,28,55,94,76,102,70,30,
     48,80,155,80,39,58,47,34,111,64,72,139,117,57,76,130,75,91,110,70,101,
     35,51,51,31,59,66,30,60,42,43,145,95,80,90,83,81,92,125,120,47,50,112,80,
     41,59,64,39,67,67,43,91,127,42,48,121,87,43,65,91,47,67,67,54,107,116,
     56,56,151,108,96,169,113,46,65,175,111,107,45,77,34,22,47,73,75,145,
     119,75,58,112,158,115,33,30,107,73,36,42,73,32,54,58,35,90,190,88,73,182}}

{261,18,204}

#.# &[f - Mean@f]/Mean@f
ChiSquarePValue[%,261]

50351983/10000

OneSidedPValue -> 0.

Bobby

On Wed, 19 Jan 2005 02:00:27 -0500 (EST), Paul Abbott <paul at physics.uwa.edu.au> wrote:

> In article <csinpt$njk$1 at smc.vnet.net>, adiggle at agric.wa.gov.au wrote:
>
>> Is there an efficient method in Mathematica to generate random tables
>> of nonnegative integers from a list of row sums and a list of column
>> sums?
>>
>> For example for row sums of {7,3,2} and column sums of {2,9,1} the
>> following two tables satisfy the constraints:
>>
>> {{2, 5, 0}, {0, 2, 1}, {0, 2, 0}}
>> and
>>
>> {{1, 6, 0}, {1, 2, 0}, {0, 1, 1}}
>
> Here is one way to do this. The following module
>
> [1] constructs an arbitrary matrix of dimension implied by the row and
> column sums (need not be square);
>
> [2] uses Reduce to apply the conditions that the entries are nonnegative
> integers to determine all possible solutions;
>
> [3] turns this output into a list of replacement rules; and
>
> [4] returns a list of _all_ matrices satisfying the constraints.
>
>   NonnegativeIntegerMatrices[rows_, cols_] := Module[
>   {mat, r, c, a, vars, cond, red, m = Length[rows], n = Length[cols]},
>    mat = Table[a[i, j], {i, m}, {j, n}];
>    r = Thread[Plus @@ Transpose[mat] == rows];
>    c = Thread[Plus @@ mat == cols];
>    vars = Flatten[mat];
>    cond = Thread[Flatten[mat] >= 0];
>    red = {ToRules[Reduce[Join[r, c, cond], vars, Integers]]};
>    If[red != {}, mat /. red, {}]
>   ]
>
> Once you have the complete list of solutions, say
>
>   sols = NonnegativeIntegerMatrices[{7,3,2}, {2,9,1}]
>
> it is easy to select one at random
>
>   sols[[ Random[Integer, {1, Length[sols]}] ]]
>
> However, this approach is not optimal if you have to work with large
> numbers of different row and column sums. Also, computing all solutions
> can be slow even for rather small matrices, e.g., try
>
>  sols = NonnegativeIntegerMatrices[Range[4], Range[4]]
>
> In such cases a random search method will be more efficient -- and I'm
> confident that other posters will help you here.
>
> Cheers,
> Paul
>



-- 
DrBob at bigfoot.com
www.eclecticdreams.net


  • Prev by Date: REpost: Nonatomic error associated with Intersection
  • Next by Date: Re: Nonatomic expression error encountered with Intersection
  • Previous by thread: Re: random matrix from row and column sums
  • Next by thread: Re: random matrix from row and column sums