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: [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[ #[[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

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

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[639]= {0.57, Null}

By comparison:

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

In[641]:= result2 === result
Out[641]= 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