Re: List processing
- To: mathgroup at smc.vnet.net
- Subject: [mg37218] Re: List processing
- From: Sseziwa Mukasa <mukasa at jeol.com>
- Date: Thu, 17 Oct 2002 00:08:42 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
On Wednesday, October 16, 2002, at 02:25 PM, John Leary wrote:
> 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.
>
>
I'm not sure about elegance, but I will tell you my approach to the
problem. The general algorithm would seem to be: sort the ranges such
that the first range has a left edge smaller than all other ranges. If
two ranges have matching left edges, sort them according to their right
edge. While there are two or more ranges in the list, operate on the
rest of the list, compare the first range to the result of operating on
the rest of the list. If the right edge of the first edge is larger
than the left edge of the first element of the result return a list
with the first element being a range with the left edge of the first
range and the right being the larger of the right edge of the first
element or the right edge of the first range in the result of operating
on the list. That statement probably isn't very clear, it's a good
thing I'm not employed as a teacher. Here is code which is probably
easier to follow:
(*Handle some degenerate cases here *)
compress[{}] := {};
compress[lst : {{_?NumericQ, _?NumericQ}}] := lst
(*This pattern is the stopping point of the recursion*)
compress[rng : {_?NumericQ, _?NumericQ}, {}] := {rng}
(*This function operates on the rest of the list then creates the first
element appropriately*)
compress[rng : {_?
NumericQ, _?NumericQ}, lst : {{_?NumericQ, _?NumericQ} ..}] :=
With[{tl = compress[First[lst], Rest[lst]]},
If[rng[[2]] > Last[tl][[2]], {rng},
If[rng[[2]] > tl[[1, 1]], {{rng[[1]], If[tl[[1, 2]] > rng[[2]],
tl[[1, 2]], rng[[2]]]}, Sequence @@ Rest[tl]},
{rng, Sequence @@ tl}]]]
(*This function sorts the list properly then starts the recursion*)
compress[lst : {{_?NumericQ, _?NumericQ} ..}] := With[{s = Sort[lst]},
compress[First[s], Rest[s]]]
You will probably have to increase $RecursionLimit. This algorithm ran
in 2 seconds on a list of 1000 elements on a 1GHz G4 PowerMac. There
are probably optimizations that can be made though.
Regards,
Ssezi