Mathematica 9 is now available
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: [mg120398] Re: sorting a nested list of 4-tuples
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Thu, 21 Jul 2011 05:48:05 -0400 (EDT)
  • References: <201107191055.GAA10229@smc.vnet.net>
  • Reply-to: drmajorbob at yahoo.com

Sseziwa,

The OP wanted distances to take into account only the 1st two elements of  
each vector, not all four, so your orderings usually won't match those of  
the original code.

A simple modification works well, however. I call it "treat" below, but  
it's still your code, mostly.

valero[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]];

sseziwa[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]

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

Here is Daniel Lichtblau's code, but I may have broken it somehow. It  
sometimes agrees with Valero's code and sometimes does not.

daniel[data_List] :=
  Module[{n = Length@data, chunksize, denom = 1000., moddata, nf, next,
     taken, result, remove, nextset, posns, k},
   chunksize = Ceiling[Log[n]]^2;
   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
   ]

n = 10^2;
data = RandomReal[1, {n, 4}];
Timing[one = valero@data;]
Timing[two = sseziwa@data;]
Timing[three = treat@data;]
Timing[four = daniel@data;]
{one == two, one == three, one == four}

{0.025656, Null}

{0.004861, Null}

{0.005198, Null}

{0.007332, Null}

{False, True, False}  <----- Daniel's and Sseziwa's code disagreed.

n = 10^2;
data = RandomReal[{-100, 100}, {n, 4}];
Timing[one = valero@data;]
Timing[two = sseziwa@data;]
Timing[three = treat@data;]
Timing[four = daniel@data;]
{one == two, one == three, one == four}

{0.02548, Null}

{0.004597, Null}

{0.005269, Null}

{0.007438, Null}

{False, True, True}   <------ Daniel's code agreed.

n = 10^3;
data = RandomReal[{-100, 100}, {n, 4}];
Timing[one = valero@data;]
Timing[two = sseziwa@data;]
Timing[three = treat@data;]
Timing[four = daniel@data;]
{one == two, one == three, one == four}

{2.26575, Null}

{0.357105, Null}

{0.404373, Null}

{0.150693, Null}

{False, True, False}  <------ Daniel's code disagreed, again.

n = 10^4;
data = RandomReal[{-100, 100}, {n, 4}];
Timing[one = valero@data;]
Timing[two = sseziwa@data;]
Timing[three = treat@data;]
Timing[four = daniel@data;]
{one == two, one == three, one == four}

{254.635, Null}

{41.0605, Null}

{43.1114, Null}

{3.94189, Null}

{False, True, False}    <------ Again.

Daniel's code is faster, and it scales better. But there may be a  
discrepancy in the ordering. It usually agrees with "valero" and "treat"  
for small data sets, but not for larger ones.

Bobby

On Wed, 20 Jul 2011 05:34:56 -0500, Sseziwa Mukasa <mukasa at gmail.com>  
wrote:

> 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
>>
>>
>>
>
>


-- 
DrMajorBob at yahoo.com


  • Prev by Date: Re: Inverse of Interpolating Function?
  • Next by Date: Re: sorting a nested list of 4-tuples
  • Previous by thread: Re: sorting a nested list of 4-tuples
  • Next by thread: Re: sorting a nested list of 4-tuples