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: [mg53640] Re: [mg53599] Re: random matrix from row and column sums
  • From: DrBob <drbob at bigfoot.com>
  • Date: Fri, 21 Jan 2005 06:35:49 -0500 (EST)
  • References: <csinpt$njk$1@smc.vnet.net><csl12t$6rv$1@smc.vnet.net> <200501200847.DAA04066@smc.vnet.net>
  • Reply-to: drbob at bigfoot.com
  • Sender: owner-wri-mathgroup at wolfram.com

Here are timings for methods from Astanoff and myself:

(* astanoff *)
Needs["Statistics`"]
rand[sumLin_List, sumCol_List] :=
    Module[{nbLin = Length[sumLin],
      nbCol = Length[sumCol], t, ok},
     While[t = Outer[Min[#1, #2, Random[
             PoissonDistribution[Min[#1/nbCol,
               #2/nbLin]]]] & , sumLin, sumCol];
        t[[1]] = sumCol - Plus @@ Rest[t];
        t[[All,1]] = sumLin - (Plus @@ #1 & ) /@
           Rest /@ t; ok =
         And @@ Thread[0 <= t[[1]]] &&
          And @@ Thread[t[[1]] <= sumCol] &&
          And @@ Thread[0 <= t[[All,1]]] &&
          And @@ Thread[t[[All,1]] <= sumLin] &&
          (Plus @@ #1 & ) /@ t == sumLin &&
          (Plus @@ #1 & ) /@ Transpose[t] ==
           sumCol;  !ok]; t];
Timing[
   f = Frequencies[Array[rand[Range[4],
          Range[4]] & , {1000}]][[All,1]]; ]
Through[{Length, Min, Max}[f]]

{276.687 Second,Null}
{233,1,14}

(* DrBob *)
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 = 0*m;
     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, {0, gaps[[i,j]]}]]; m]
Timing[
   f = Frequencies[Array[randomFill[Range[4],
          Range[4]] & , {1000}]][[All,1]]; ]
Through[{Length, Min, Max}[f]]

{3.016 Second,Null}
{246,1,15}

Bobby

On Thu, 20 Jan 2005 03:47:40 -0500 (EST), Astanoff <astanoff at yahoo.fr> wrote:

> A faster random solution assuming a truncated Poisson distribution :
>
> <<Statistics`
>
> rand[sumLin_List, sumCol_List]:=
> Module[{nbLin = Length[sumLin],
> nbCol = Length[sumCol],t,ok},
> While[t = Outer[Min[#1,#2,
> Random[PoissonDistribution[Min[#1/nbCol, #2/nbLin]]]
> ]&,
> sumLin, sumCol];
> t[[1]]=sumCol-Plus @@ Rest[t];
> t[[All,1]]=sumLin-(Plus @@ #& /@ (Rest/@t));
> ok=And @@ Thread[0 <= t[[1]]] &&
> And @@ Thread[t[[1]] <= sumCol] &&
> And @@ Thread[0 <= t[[All,1]]] &&
> And @@ Thread[t[[All,1]] <= sumLin] &&
> (Plus @@ #& /@ t) == sumLin &&
> (Plus @@ #& /@ Transpose[t]) == sumCol;
> !ok];
> t];
>
> rand[{15,17,12,10,4},{9,11,10,6,14,8}]//Timing
>
> {0.218
> Second,{{0,4,0,3,5,3},{2,2,5,0,5,3},{4,0,4,1,2,1},{3,3,0,2,2,0},{0,2,1,0,0,1}}}
>
>
>
>



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


  • Prev by Date: Re: Algebraic problem solved by simulation
  • Next by Date: Re: Algebraic problem solved by simulation
  • Previous by thread: Re: random matrix from row and column sums
  • Next by thread: Re: random matrix from row and column sums