Re: List representation using element position
- To: mathgroup at smc.vnet.net
- Subject: [mg72514] Re: List representation using element position
- From: Peter Pein <petsie at dordos.net>
- Date: Wed, 3 Jan 2007 05:32:40 -0500 (EST)
- References: <enfgem$ss1$1@smc.vnet.net>
Dr. Wolfgang Hintze schrieb: > Hello group, > happy new year to all of you! > > This one was put up in a slightly different form by me in March 2006. > It is now more general and it is lossless with respect to information: > > Given a list of integers which may repeat, e.g. > > lstIn = {2,3,4,4,2,1,1,5,4} > > provide a list of the different values and their respective positions in > the original list. In the example, > > LstOut= { > {1,{6,7}}, > {2,{2,5}}, > {3,{2}}, > {4,{3,4,9}}, > {5,{8}} > } > > Who finds the shortest function doing this task in general? > > My solution appears 15 lines below > > Thanks. > > Best regards, > Wolfgang > 1 ... > fPos[lstIn_] := Module[{f = Flatten /@ (Position[lstIn, #1] & ) /@ > Union[lstIn]}, ({#1, f[[#1]]} & ) /@ Range[Length[f]]] > > In[15]:= > fPos[lstIn] > > Out[15]= > {{1, {6, 7}}, {2, {1, 5}}, {3, {2}}, {4, {3, 4, 9}}, {5, {8}}} > Hello Wolfgang, your code can be shortened a bit: First, I define the test-data: data = {2, 3, 4, 4, 2, 1, 1, 5, 4}; SeedRandom[1]; test = Table[Random[Integer, {1, 100}], {10^6}]; fPos1 is essentially your code fPos1 = Function[lst, {#1, Flatten[Position[lst, #1]]}& /@ Union[lst] ]; fPos1[data] First[Timing[ r1 = fPos1[test]; ]] Out[5]= {{1, {6, 7}}, {2, {1, 5}}, {3, {2}}, {4, {3, 4, 9}}, {5, {8}}} Out[6]= 12.859*Second fPos2 is a pure function using the Sow-Reap mechanism: fPos2 = Module[{n = 1}, Flatten[Last[Reap[Scan[Sow[n++, #1]&, #1], Union[#1], List]], 1]]&; fPos2[data] First[Timing[ r2 = fPos2[test]; ]] r1 === r2 Out[8]= {{1, {6, 7}}, {2, {1, 5}}, {3, {2}}, {4, {3, 4, 9}}, {5, {8}}} Out[9]= 3.266*Second Out[10]= True Another pure function. The result is even worse (46.4 s), when using MapIndexed instead of the Transpose[]-construct: fPos3 = ({#1[[1,1]], #1[[All,2]]} & ) /@ Split[ Sort[Transpose[{#1, Range[Length[#1]]}], First[#1] <= First[#2] & ], First[#1] == First[#2] & ] & ; fPos3[data] First[Timing[ r3 = fPos3[test]; ]] r1 === r3 Out[12]= {{1, {6, 7}}, {2, {1, 5}}, {3, {2}}, {4, {3, 4, 9}}, {5, {8}}} Out[13]= 38.375*Second Out[14]= True The next one is similar to fPos1 but uses Pick[] instead of Position[]: fPos4[lst_] := Module[ {rl = Range[Length[lst]]}, Function[ul, Transpose[{ul, (Pick[rl, lst, #1] & ) /@ ul}]][Union[lst]]] fPos4[data] First[Timing[ r4 = fPos4[test]; ]] r1 === r4 Out[16]= {{1, {6, 7}}, {2, {1, 5}}, {3, {2}}, {4, {3, 4, 9}}, {5, {8}}} Out[17]= 27.343*Second Out[18]= True And finally the fastest solution, I've been able to find: (tmp is the same as Split[Sort[lst]] but faster, because I need the Ordering[] list anyway) fPos5[lst_] := Module[ {ord = Ordering[lst], tmp}, tmp = Split[lst[[ord]]]; Transpose[{First /@ tmp, ord[[#1]]& /@ Rest[FoldList[ Range @@ (#1[[-1]] + {1, #2}) & , {0, 0}, Length /@ tmp ]] }] ] fPos5[data] First[Timing[ r5 = fPos5[test]; ]] r1 === r5 Out[20]= {{1, {6, 7}}, {2, {1, 5}}, {3, {2}}, {4, {3, 4, 9}}, {5, {8}}} Out[21]= 0.563*Second Out[22]= True Have fun decoding this stuff ;-) Peter