WOLFRAM

Services & Resources / Wolfram Forums / MathGroup Archive

MathGroup Archive 2011

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

Search the Archive

Re: sorting a nested list of 4-tuples

  • To: mathgroup at smc.vnet.net
  • Subject: [mg120396] Re: sorting a nested list of 4-tuples
  • From: Sseziwa Mukasa <mukasa at gmail.com>
  • Date: Thu, 21 Jul 2011 05:47:43 -0400 (EDT)
  • References: <201107191055.GAA10229@smc.vnet.net> <1C3C0ED1-39D7-4232-9160-A26C586F61AB@gmail.com> <54C85D0B-AEE1-48E2-B9D9-857C56E1111F@mac.com>
On Jul 20, 2011, at 6:33 AM, Luis Valero wrote:

> Thank you very much for your time
>
> The function Nearest does not use only the two first elements of each 4-tuple. This is the reason for the two different results

Sorry, I missed that part in your first post, but it's easy to modify my example to handle that case:

 orderedList2[list_] :=
 Module[{first = First[list], rest = Rest[list], nearest, result},
  result = {first};
  Do[nearest = Nearest[rest[[All, ;; 2]] -> Automatic, Last[result][[;; 2]]];
   result = Join[result, rest[[nearest]]];
   rest = Drop[rest, nearest], {Length[rest]}]; result]

In[5]:= Module[{list = RandomReal[{0, 1}, {1000, 4}], result1, result2},
 result1 = Timing[orderedList[list]];
 result2 = Timing[orderedList2[list]]; {result1[[2]] == result2[[2]],
  result1[[1]], result2[[1]]}]
Out[5]= {True, 4.07419, 0.644008}

So it still seems an order of magnitude faster.  Daniel Lichtblau's solution is faster still, but doesn't agree on the ordering:

orderedList3[data_] :=
 Module[{n = Length[data], chunksize, denom, moddata, nf, next, taken, result,
    remove, nextset, posns, k, done}, chunksize = Ceiling[Log[n]]^2;
  denom = 10000.;
  moddata = Map[Take[#, 3] &, MapThread[Prepend, {data, Range[n]/denom}]];
  nf = Nearest[moddata]; next = moddata[[1]]; taken = ConstantArray[False, n];
   result = ConstantArray[{0., 0., 0., 0.}, n];
  remove = ConstantArray[{0., 0., 0.}, chunksize]; result[[1]] = data[[1]];
  remove[[1]] = moddata[[1]]; taken[[1]] = True;
  Do[nextset = nf[next, 1 + Mod[j, chunksize, 1]];
   posns = Round[denom*Map[First, nextset]];
   k = 1;
   While[k < Length[nextset] && taken[[posns[[k]]]], k++;];
   taken[[posns[[k]]]] = True;
   result[[j]] = data[[posns[[k]]]];
   next = nextset[[k]];
   remove[[Mod[j, chunksize, 1]]] = next;
   If[Mod[j, chunksize] == 0, done = True;
    posns = Apply[Alternatives, remove];
    moddata = DeleteCases[moddata, posns];
    nf = Nearest[moddata];];, {j, 2, n}]; result]

In[9]:= Module[{list = RandomReal[{0, 1}, {1000, 4}], result1, result2, result3},
 result1 = Timing[orderedList[list]];
 result2 = Timing[orderedList2[list]];
 result3 = Timing[orderedList3[list]]; {result1[[2]] == result2[[2]],
  result1[[2]] === result3[[2]], result1[[1]], result2[[1]], result3[[1]]}]
Out[9]= {True, False, 4.24234, 0.664731, 0.20674}

>
> Regards
>
> Luis
>
>
> El 19/07/2011, a las 18:05, Sseziwa Mukasa escribi=F3:
>
>> Your function does not appear to work correctly, sometimes the list is in the wrong order, but orderedList2:
>>
>> orderedList2[list_] :=
>> Module[{first = First[list], rest = Rest[list], nearest, result},
>> result = {first};
>> Do[nearest = Nearest[rest -> Automatic, Last[result]];
>>  result = Join[result, rest[[nearest]]];
>>  rest = Drop[rest, nearest], {Length[rest]}]; result]
>>
>> seems faster anyway.:
>>
>> In[11]:= Module[{list = RandomReal[{0, 1}, {20, 4}], result1, result2},
>> result1 = Timing[orderedList[list]];
>> result2 = Timing[orderedList2[list]]; {result1[[2]] == result2[[2]],
>> result1[[1]], result2[[1]], {list, result1[[2]], result2[[2]]}}]
>> Out[11]= {False, 0.002556, 0.0007, {{{0.0780386, 0.220901, 0.748457,
>>   0.548342}, {0.722099, 0.308747, 0.33661, 0.304516}, {0.623358, 0.761312,
>>   0.884318, 0.21337}, {0.14872, 0.284139, 0.244084, 0.582692}, {0.0829757,
>>   0.911987, 0.448848, 0.606659}, {0.312903, 0.703568, 0.747021,
>>   0.126831}, {0.847102, 0.437041, 0.0924343, 0.0333101}, {0.189339,
>>   0.419192, 0.498754, 0.846607}, {0.661185, 0.455712, 0.31286,
>>   0.387921}, {0.566059, 0.331815, 0.412978, 0.84236}, {0.714704, 0.335434,
>>   0.417758, 0.0569088}, {0.855757, 0.0118403, 0.310144,
>>   0.312894}, {0.278001, 0.874878, 0.289541, 0.199531}, {0.682503, 0.387263,
>>   0.931379, 0.662633}, {0.8045, 0.264645, 0.595204, 0.534895}, {0.645246,
>>   0.915467, 0.167849, 0.210847}, {0.789694, 0.987745, 0.0405679,
>>   0.0957831}, {0.811736, 0.77314, 0.73452, 0.0771508}, {0.784869, 0.582503,
>>   0.0986897, 0.152786}, {0.426251, 0.135863, 0.465908,
>>   0.228462}}, {{0.0780386, 0.220901, 0.748457, 0.548342}, {0.14872,
>>   0.284139, 0.244084, 0.582692}, {0.189339, 0.419192, 0.498754,
>>   0.846607}, {0.312903, 0.703568, 0.747021, 0.126831}, {0.278001, 0.874878,
>>   0.289541, 0.199531}, {0.0829757, 0.911987, 0.448848, 0.606659}, {0.623358,
>>    0.761312, 0.884318, 0.21337}, {0.645246, 0.915467, 0.167849,
>>   0.210847}, {0.789694, 0.987745, 0.0405679, 0.0957831}, {0.811736, 0.77314,
>>    0.73452, 0.0771508}, {0.784869, 0.582503, 0.0986897,
>>   0.152786}, {0.847102, 0.437041, 0.0924343, 0.0333101}, {0.714704,
>>   0.335434, 0.417758, 0.0569088}, {0.722099, 0.308747, 0.33661,
>>   0.304516}, {0.682503, 0.387263, 0.931379, 0.662633}, {0.661185, 0.455712,
>>   0.31286, 0.387921}, {0.566059, 0.331815, 0.412978, 0.84236}, {0.426251,
>>   0.135863, 0.465908, 0.228462}, {0.8045, 0.264645, 0.595204,
>>   0.534895}, {0.855757, 0.0118403, 0.310144, 0.312894}}, {{0.0780386,
>>   0.220901, 0.748457, 0.548342}, {0.189339, 0.419192, 0.498754,
>>   0.846607}, {0.14872, 0.284139, 0.244084, 0.582692}, {0.566059, 0.331815,
>>   0.412978, 0.84236}, {0.8045, 0.264645, 0.595204, 0.534895}, {0.722099,
>>   0.308747, 0.33661, 0.304516}, {0.661185, 0.455712, 0.31286,
>>   0.387921}, {0.784869, 0.582503, 0.0986897, 0.152786}, {0.847102, 0.437041,
>>    0.0924343, 0.0333101}, {0.714704, 0.335434, 0.417758,
>>   0.0569088}, {0.426251, 0.135863, 0.465908, 0.228462}, {0.855757,
>>   0.0118403, 0.310144, 0.312894}, {0.682503, 0.387263, 0.931379,
>>   0.662633}, {0.623358, 0.761312, 0.884318, 0.21337}, {0.811736, 0.77314,
>>   0.73452, 0.0771508}, {0.312903, 0.703568, 0.747021, 0.126831}, {0.278001,
>>   0.874878, 0.289541, 0.199531}, {0.645246, 0.915467, 0.167849,
>>   0.210847}, {0.789694, 0.987745, 0.0405679, 0.0957831}, {0.0829757,
>>   0.911987, 0.448848, 0.606659}}}}
>>
>> From the above output it seems to me orderedList is incorrect:
>>
>> In[12]:= Nearest[{{0.7220990188851284`, 0.30874655560999353`, 0.33661039115480085`,
>>  0.30451607189733565`}, {0.623358140247426`, 0.7613121754790066`,
>>  0.8843184964161348`, 0.21336965042896106`}, {0.14871956929750207`,
>>  0.2841388256243189`, 0.2440839157054575`,
>>  0.5826918077236027`}, {0.08297574175354927`, 0.9119868514832306`,
>>  0.44884815651517496`, 0.606658888854545`}, {0.3129032093692543`,
>>  0.7035682306379043`, 0.7470209852828422`,
>>  0.126831036636313`}, {0.8471019825138335`, 0.4370412344560497`,
>>  0.09243429503478429`, 0.03331005052172231`}, {0.18933936353633118`,
>>  0.4191916563275504`, 0.49875370996337387`,
>>  0.8466068811542358`}, {0.6611848899498884`, 0.455712283905654`,
>>  0.31286031890780386`, 0.3879208331484807`}, {0.566058771065481`,
>>  0.3318146887998126`, 0.41297814980274516`,
>>  0.8423595336937795`}, {0.7147038318708883`, 0.33543423510640613`,
>>  0.4177577945972242`, 0.056908774958363884`}, {0.8557567595586966`,
>>  0.011840287587700837`, 0.31014365477384986`,
>>  0.31289360223925855`}, {0.27800072513915963`, 0.8748776068932764`,
>>  0.28954067774830894`, 0.19953109481447573`}, {0.6825027823624006`,
>>  0.38726329607605536`, 0.9313788703031116`,
>>  0.6626327289353637`}, {0.8045002220254145`, 0.26464489073341646`,
>>  0.5952036781362782`, 0.5348945499518614`}, {0.6452463375631783`,
>>  0.9154672494486176`, 0.16784916226023205`,
>>  0.21084656084695386`}, {0.7896939168446158`, 0.9877454808787693`,
>>  0.04056790678073363`, 0.09578312387470667`}, {0.8117363160995603`,
>>  0.7731396349254072`, 0.7345204475002354`,
>>  0.0771508252866615`}, {0.784869093354617`, 0.5825033331936824`,
>>  0.09868967226141323`, 0.1527856209885663`}, {0.426250694413443`,
>>  0.1358634032399666`, 0.46590788139431916`,
>>  0.22846239863279472`}}, {0.07803858379747108`, 0.22090093831902768`,
>> 0.7484574646075761`, 0.5483416965515358`}]
>> Out[12]= {{0.189339, 0.419192, 0.498754, 0.846607}}
>>
>> Regards,
>> 	Ssezi
>>
>> On Jul 19, 2011, at 6:55 AM, Luis Valero wrote:
>>
>>> Dear Sirs,
>>>
>>> I want to sort a list of 4-tuples of real numbers, so that, the second 4-tuple has minimum distance to the first, the third, selected from the rest, ha minimum distance to the second, and so on.
>>>
>>> The distance is the euclidean distance, calculated with the first two elements of each 4-tuple.
>>>
>>> I have defined a function that work:
>>>
>>> orderedList[list_] := Module[{nearest},
>>> 	Flatten[ Nest[{
>>> 	    Append[ #[[1]] , nearest = Flatten @@ Nearest[ Map[ Rule[ #[[{1, 2}]], #] &, #[[2]] ], Last[ #[[1]] ] [[{1, 2}]], 1] ],
>>>  	    Delete[ #[[2]], Position[ #[[2]], nearest ] ]  } &, { {list[[1]] }, Delete[ list, 1 ] }, Length[ list ] - 2], 1] ];
>>>
>>>
>>> but I need to improve the temporal efficiency
>>>
>>> Thank you
>>>
>>>
>>>
>>
>
  • Prev by Date: Re: sorting a nested list of 4-tuples
  • Next by Date: Re: Inverse of Interpolating Function?
  • Previous by thread: Re: sorting a nested list of 4-tuples
  • Next by thread: Re: sorting a nested list of 4-tuples