Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2000
*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 2000

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

Search the Archive

Re: need little help - no longer!(2)

  • To: mathgroup at smc.vnet.net
  • Subject: [mg23655] Re: [mg23530] need little help - no longer!(2)
  • From: "Allan Hayes" <hay at haystack.demon.co.uk>
  • Date: Sun, 28 May 2000 23:09:06 -0400 (EDT)
  • References: <8g9nm8$mmd@smc.vnet.net> <8gfuar$br7@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Mark Fisher has pointed out some problems with the brackets in code for the
function pickRandom in my earlier posting.
I have corrected these below; speeded the code up a little and brought the
output more into line with the other two functions in the previous posting.

I  have also added a step-by-step version of the calculation.

pickRandom[m_] :=
  With[{m2 = Rest[FoldList[Plus, 0, m]]},
    Last[Transpose[Sort[Join @@ (Map[Last, Split[Sort[
                        Join[
                          Transpose[{Table[Random[], {#}], Range[#]}],
                          Thread[List[m2, List /@ Range[Length[m]]]]
                          ]],
                      MatchQ[#1, {_, _Integer}] &
                      ], {2}
                    ] /.
                  {{x__, {p_Integer}} :> Thread[List[{x}, p]],
                    {{_}} -> Sequence[]
                    })
            ]]
        ] &
    ]

EXAMPLES

m = #/(Plus @@ #) &[Table[Random[], {500}]];

SeedRandom[1]; pickRandom[m][10]
SeedRandom[1]; pickRandom[m][10000]; // Timing

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

        {4.88 Second, Null}

Pre-compute pickRandom[m]

pick3 = pickRandom[m];
SeedRandom[1]; pick3[10]
SeedRandom[1]; pick3[10000]; // Timing

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

        {4.72 Second, Null}


STEP BY STEP EVALUATION

m = { .3, .3, .4}; n = 8;

m2 = Rest[FoldList[Plus, 0, m]]

     {0.3, 0.6, 1.}

r1 = Thread[List[m2, List /@ Range[Length[m2]]]]

     {{0.3, {1}}, {0.6, {2}}, {1., {3}}}

r2 = Transpose[{#, Range[Length[#]]} &[Table[Random[], {n}]]]

    {{0.246313, 1}, {0.464937, 2}, {0.509709, 3}, {0.146946, 4}, {0.375082,
    5}, {0.873216, 6}, {0.728773, 7}, {0.787449, 8}}

r3 = Sort[Join[r1, r2]]

    {{0.146946, 4}, {0.246313, 1}, {0.3, {1}}, {0.375082, 5}, {0.464937,
    2}, {0.509709, 3}, {0.6, {2}}, {0.728773, 7}, {0.787449, 8}, {0.873216,
    6}, {1., {3}}}

r4 = Split[r3, MatchQ[#1, {_, _Integer}] &]

    {{{0.146946, 4}, {0.246313, 1}, {0.3, {1}}}, {{0.375082, 5}, {0.464937,
      2}, {0.509709, 3}, {0.6, {2}}}, {{0.728773, 7}, {0.787449,
      8}, {0.873216, 6}, {1., {3}}}}

r5 = Map[Last, r4, {2}]

    {{4, 1, {1}}, {5, 2, 3, {2}}, {7, 8, 6, {3}}}

r6 = r5 /. {{x__, {p_Integer}} :> Thread[List[{x}, p]],
      {{_}} -> Sequence[]
      }

    {{{4, 1}, {1, 1}}, {{5, 2}, {2, 2}, {3, 2}}, {{7, 3}, {8, 3}, {6, 3}}}

r7 = Sort[Join @@ r6]

    {{1, 1}, {2, 2}, {3, 2}, {4, 1}, {5, 2}, {6, 3}, {7, 3}, {8, 3}}

r8 = Last[Transpose[r7]]

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


Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565





  • Prev by Date: Re: init.m questions and message windows
  • Next by Date: Re: need little help - no longer!
  • Previous by thread: Re: FindMinimum of a compiled function??
  • Next by thread: Global Font Size