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>

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

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