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