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
- References:
- sorting a nested list of 4-tuples
- From: Luis Valero <luis.valero@mac.com>
- sorting a nested list of 4-tuples