Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

RE: RE: List processing

  • To: mathgroup at smc.vnet.net
  • Subject: [mg37266] RE: [mg37241] RE: [mg37196] List processing
  • From: "DrBob" <drbob at bigfoot.com>
  • Date: Mon, 21 Oct 2002 02:29:32 -0400 (EDT)
  • Reply-to: <drbob at bigfoot.com>
  • Sender: owner-wri-mathgroup at wolfram.com

Wolf,

I timed your methods plus my own entry in the contest, for 500,000
elements:

list = {# - Random[], # + Random[]} & /@ NestList[# + Random[] &, 0,
500000];

List @@ IntervalUnion @@ Interval /@ list // Length // Timing

high = Sequence[];
{#[[1, 1]], Max[#[[All, -1]]]} & /@ Split[
        Sort[list], (high = Max[high, Last[#1]]) 
    ? First[#2] || (high = Last[#1]) &] // Length // Timing

maxExtends[list_] := (sl = Sort[list];
    length = Length[sl]; r = collect[]; i = 1;
    While[i ? length, {low, high} = sl[[i]];
      If[++i ? length, {curlow, curhigh} = sl[[i]];
        While[high ? curlow && (high = Max[
                high, curhigh]; ++i ? length), {curlow, curhigh} =
sl[[i]]]];
      r = collect[r, {low, high}]];
    List @@ Flatten[r])
maxExtends[list] // Length // Timing

Timing[Length@(List @@ Interval @@ list)]      (* <======= mine, Dave
Park's, Carl Woll's, Mark Westwood's *)

{8.625*Second, 57021}
{7.75*Second, 57021}
{8.202999999999989*Second,   57021}
{6.578000000000003*Second,   57021}

and here's a second trial, after more memory has been tied up:

{9.5*Second, 56841}
{8.202999999999975*Second,   56841}
{8.875*Second, 56841}
{7.125*Second, 56841}

I'm a little surprised the built-in method wins so narrowly.

Here's Daitaro's method:

Timing[data = Sort[list, #[[1]] < #2[[1]] &];Length[{{data[[1, 1]],
Fold[If[# < #2[[1]], #, 
  Max[#, #2[[2]]]] &, data[[1, 2]], Rest[data]]}, {Fold[If[# > #2[[2]],
#, Min[#, #2[[1]]]] &, (
              data = Reverse@data)[[1, 1]], Rest[data]], data[[1,
2]]}}]]
{26.359 Second, 2}

It always returns two intervals.

Bobby Treat

-----Original Message-----
From: Wolf, Hartmut [mailto:Hartmut.Wolf at t-systems.com] 
To: mathgroup at smc.vnet.net
Subject: [mg37266] [mg37241] RE: [mg37196] List processing



>-----Original Message-----
>From: John Leary [mailto:leary at paradise.net.nz]
To: mathgroup at smc.vnet.net
>Sent: Wednesday, October 16, 2002 8:26 PM
>To: mathgroup at smc.vnet.net
>Subject: [mg37266] [mg37241] [mg37196] List processing
>
>
>Greetings
>
>This problem can be solved by conventional programming, but I 
>wonder if 
>there is an elegant Mathematica solution ?
>
>A list contains pairs of values, with each pair representing 
>the lower and 
>upper edge of a sub-range.  Some of the sub-ranges partially 
>overlap, some 
>fully overlap, others don't overlap at all.  The problem is to 
>produce a 
>second list that contains the overall upper and lower edges of the 
>overlapping sub-ranges.
>
>A simple example :  {{100,200},{150,250},{120,270},{300,400}}  
>would result 
>in {{100,270},{300,400}}.
>
>In the real case, the input list has several hundred elements and the 
>output list typically has five elements.
>
>I have a working solution based on loops, but there must be a 
>more elegant 
>one.  I would be very grateful for any suggestions.
>
>
>Best regards
>
>John Leary
>
>

John,

several proposals (without any attempt to moduralize):

(1) use IntervalUnion:
 
List @@ IntervalUnion @@ Interval /@ list


(2) use Split (it's a little bit tricky to be correct):

high = Sequence[];
{#[[1, 1]], Max[#[[All, -1]]]} & /@ 
  Split[Sort[list], 
        (high = Max[high,Last[#1]]) >= First[#2] || (high = Last[#1])&]


(3) procedural programming:

maxExtends[list_] := (sl = Sort[list];
    length = Length[sl]; r = collect[]; i = 1;
    While[i <= length,
      {low, high} = sl[[i]];
      If[++i <= length,
        {curlow, curhigh} = sl[[i]]; 
        While[high >= curlow && (high = Max[high, curhigh]; ++i <=
length),
          {curlow, curhigh} = sl[[i]] ]]; 
      r = collect[r, {low, high}] ];
    List @@ Flatten[r])


Let's do some benchmarks:

10,000 Intervals:

list = {# - Random[], # + Random[]} & /@ NestList[# + Random[] &, 0,
10000];

List @@ IntervalUnion @@ Interval /@ list // Length // Timing
{2.503 Second, 1181}

high = Sequence[];
{#[[1, 1]], Max[#[[All, -1]]]} & /@ 
      Split[Sort[
          list], (high = Max[high, Last[#1]]) >= 
              First[#2] || (high = Last[#1]) &] // Length // Timing
{2.934 Second, 1181}

maxExtends[list] // Length // Timing
{3.926 Second, 1181}


The corresponding results for 100,000 Intervals:

{27.329 Second, 11266}
{30.234 Second, 11266}
{35.791 Second, 11266}

and for 500,000 Intervals

{144.058 Second, 56728}
{154.782 Second, 56728}
{181.111 Second, 56728}


To look at scaling behaviour I just collected the prior results

IntervalUnion:
{%355, %345 , %350}[[All, 1, 1]]
{2.503, 27.329, 144.058}

% // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} &
{1.09185, 1.05425}


Split:
{%357, %347, %352}[[All, 1, 1]]
{2.934, 30.234, 154.782}
% // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} &
{1.03047, 1.02389}


Procedural:
{%358, %348, %353}[[All, 1, 1]]
{3.926, 35.791, 181.111}
% // {#[[2]]/(10*#[[1]]), #[[3]]/(5*#[[2]])} &
{0.91164, 1.01205}

Due to Sort, the Split and the Procedural versions should behave as O[n
log
n], I'm not shure whether IntervalUnion does (seems to be a little bit
more
progressive at costs).

--
Hartmut Wolf






  • Prev by Date: Raising Contour Plot Graphics to 3D - II
  • Next by Date: RE: Bad Alignment of Y Axes
  • Previous by thread: RE: List processing
  • Next by thread: c++ book