       Re: sorting a nested list of 4-tuples

• To: mathgroup at smc.vnet.net
• Subject: [mg120359] Re: sorting a nested list of 4-tuples
• From: Daniel Lichtblau <danl at wolfram.com>
• Date: Wed, 20 Jul 2011 06:31:19 -0400 (EDT)
• References: <201107191055.GAA10229@smc.vnet.net>

```On 07/19/2011 05: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[ #[] , nearest = Flatten @@ Nearest[ Map[ Rule[ #[[{1, 2}]], #]&, #[] ], Last[ #[] ] [[{1, 2}]], 1] ],
>      	    Delete[ #[], Position[ #[], nearest ] ]  }&, { {list[] }, Delete[ list, 1 ] }, Length[ list ] - 2], 1] ];
>
>
> but I need to improve the temporal efficiency
>
> Thank you

The complexity will show up either in needing to obtain a growing number
of nearest items (to account for the fact that many may already ahve
appeared), or removing selected items from further consideration. There
may be a fancy way around these but I'm not seeing it offhand. At least
not if we want to couple with a fast search for nearest items, using
Nearest[].

A way to alleviate this is to gather newly selected items every so often
and remove them in one shot. This adds to the coding complexity
(required some debugging to get it to work, for one thing). But it does
seem faster.

I made no effort to tune for the removal interval (which need not be
constant). There ar also some parts of the code that might be made
slightly faster in other ways.

n = 3000;
data = RandomReal[{-100, 100}, {n, 4}];

chunksize = Ceiling[Log[n]]^2;
denom = 10000.;
moddata =
Map[Take[#, 3] &, MapThread[Prepend, {data, Range[n]/denom}]];
nf = Nearest[moddata];
next = moddata[];
taken = ConstantArray[False, n];
result = ConstantArray[{0., 0., 0., 0.}, n];
remove = ConstantArray[{0., 0., 0.}, chunksize];
result[] = data[];
remove[] = moddata[];
taken[] = True;

Timing[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}]]

Out= {0.57, Null}

By comparison:

In:= Timing[result2 = orderedList[data];]
Out= {14.71, Null}

In:= result2 === result
Out= True

Daniel Lichtblau
WOlfram Research

```

• Prev by Date: Re: Generating Arbitrary Linear Combinations of Functions
• Next by Date: Re: sorting a nested list of 4-tuples
• Previous by thread: sorting a nested list of 4-tuples
• Next by thread: Re: sorting a nested list of 4-tuples