Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

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

Search the Archive

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


  • Prev by Date: Re: List representation using element position
  • Next by Date: how to plot a 2-parametric output from Solve with Plot3D
  • Previous by thread: Re: List representation using element position
  • Next by thread: Re: List representation using element position