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

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

Search the Archive

RE: Position within a list

  • To: mathgroup at smc.vnet.net
  • Subject: [mg32932] RE: [mg32920] Position within a list
  • From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
  • Date: Wed, 20 Feb 2002 01:26:12 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

> -----Original Message-----
> From: Dana DeLouis [mailto:ng_only at hotmail.com]
To: mathgroup at smc.vnet.net
> Sent: Tuesday, February 19, 2002 8:30 AM
> To: mathgroup at smc.vnet.net
> Subject: [mg32932] [mg32920] Position within a list
> 
> 
> Hello.  A long time ago someone posted an elegant solution, 
> but I can not
> find it in the Archives.
> Given a list that may have repeating data, this returned the 
> character that
> was repeated the most, and its position..
> 
> The example given was a list of the first 10,000 digits of 
> Pi.  I believe
> the answer was that the number 9 was repeated 6 times around position
> 700 or 800.
> The function was very short and elegant.
> I don't believe the Split function was used, but I might be wrong.
> 
> Does anyone know how to do this?  Thank you.
> 
> lst = RealDigits[Pi,10,10000][[1]];
> 
> The list would have...
> {3, 1, 4, 1, 5, 9, 2, 6, etc)
> 
> 
> --
> Dana DeLouis
> Windows XP  & Mathematica 4.1
> = = = = = = = = = = = = = = = = =
> 
> 
> 
> 
Dana,

I don't know of that post you didn't find, however here a few suggestions:

A solution with Split:

Module[{xlen}, 
    With[{lenlst = Length /@ Split[lst]}, 
        Plus @@ Take[lenlst, 
            Position[lenlst, xlen = Max[lenlst], {1}, 1][[1, 1]] - 1]
            + {1, xlen}]] // Timing

{0.071 Second, {763, 768}}

lst[[Range @@ Last[%]]]

{9, 9, 9, 9, 9, 9}

It finds the maximum length of repetitions and its positions. I have no idea
how this could be done faster.


Here a more pedestrian alternative:

Timing[Module[{digit = Indeterminate, c = 0, maxc = 0, xpos}, 
    MapIndexed[
      If[#1 === digit, ++c, If[c > maxc, xpos = #2; maxc = c]; digit = #1; 
          c = 1] &, lst]; 
    xpos[[1]] - {maxc, 1}]]

{0.51 Second, {763, 768}}

It's clearly slower.


As you *already* know the number of repetitions, you can try different
things:

Timing[Position[ListCorrelate[Range[6], lst, {1, -1}, {}, #2 &, SameQ], 
        True][[1, 1]] + {0, 5}]

{0.25 Second, {763, 768}}

Explanation: Range[6] is of no significance here, any list of length 6 will
do. #2& picks out the second argument, i.e. 6 successive elements of lst,
SameQ tests whether they are the same.


These are quite similar methods

Timing[Position[MapThread[SameQ, (RotateLeft[lst, #1] &) /@ Range[0, 5]], 
        True][[1, 1]] + {0, 5}]

{0.09 Second, {763, 768}}

excluding the non-existence of a longer repetion cost extra:

Timing[Position[MapThread[SameQ, (RotateLeft[lst, #1] &) /@ Range[0, 6]], 
          True]][[1,1]] + {0, 6}]

{0.13 Second, {} + {0, 6}}



Timing[Position[SameQ @@@ Partition[lst, 6, 1], 
        True][[1, 1]] + {0, 5}]

{0.09 Second, {763, 768}}

Timing[Position[SameQ @@@ Partition[lst, 7, 1], 
        True][[1, 1]] + {0, 6}]

{0.11 Second, {{}[[1, 1]], 6 + {}[[1, 1]]}}


Of course you can search for the longest repetitions, but elegant it isn't.

Catch[Check[{p1, p2} = 
      {Position[SameQ @@@ Partition[lst, #, 1], True, {1}, 1][[1, 1]] 
       + {0, # - 1}, p1}, 
      Throw[p2]] & /@ Range[2, 999]] // Timing

Part::"partw": "Part \!\(1\) of \!\({}\) does not exist."

{0.491 Second, {763, 768}}

(This time has to be compared with the Split-solution.)


Pattern matching:

Timing[Replace[
    lst, {{a___, b_, b_, b_, b_, b_, b_, ___} :> Length[{a}] + {1, 6}, _ :> 
        Null}]]

{0.72 Second, {763, 768}}

This gives only the first match, which is lucky in this case, see

Timing[Replace[
    lst, {{a___, b_, b_, b_, b_, b_, b_, b_, ___} :> 
        Length[{a}] + {1, 6}, _ :> Null}]]

{9.05 Second, Null}

It is not so pleasing to repeat the pattern 6 or 7 times, but...

Timing[Replace[lst, 
   {{a___, s:(b_..) /; Length[{s}] == 6, ___} :> 
     Length[{a}] + {1, 6}, _ :> Null}]]

{269.667 Second, {763, 768}}

...is not usable. There is no visible difference whether you include the
length condition inside the pattern, at the end of the pattern (at the lhs
of the rule), or at the rhs of the rule. This is possibly not so
astonishing, since matching the rest of the pattern is rather simple.

--
Hartmut



  • Prev by Date: Re: Position within a list
  • Next by Date: array into tiff format
  • Previous by thread: Re: Position within a list
  • Next by thread: Re: creating packages[2]