RE: Unions
- To: mathgroup <mathgroup at yoda.physics.unc.edu>
- Subject: RE: Unions
- From: Roberto Sierra <73557.2101 at compuserve.com>
- Date: 05 Jun 92 10:57:48 EDT
RE> Unions 10:14 PM 6/4/92
Here's a solution to the problem Zdravko Balorda
posed on computing the union of n closed intervals:
> I have the following problem:
>
> Given n closed intervals find their Union. For instance:
> [0,2];[2,4];[1,5]
> The union of the above 3 intervals would be [0,5].
>
> The union of the following:
> [0,2];[3,5]
> would be [0,2][3,5].
>
> The algorithm goes like this:
> 1. Sort all the intervals
> 2. Find unions of all adjacent pairs
> 3. Repeat step 2 while the result is changing.
>
> Could anyone make any suggestions on real Mma code for that?
SOLUTION:
This solution takes advantage of MMA's built-in pattern matching
capabilities, so it may be a bit slower than explicit code, but
it was easy to write. The sorting and merging of lists of
segments is handled by MMA's built-in Union[] function -- but
Union[] just prepares the list for the reduction pass handled
by the CrunchUnion[] function. [It takes about three minutes
to reduce one hundred integer or real segments on a Mac II with
MMA 2.0 -- faster execution will result on other platforms.]
(* Rule to flip segment bounds if reversed *)
CrunchUnion[x:___List,{a_,b_},y:___List] :=
CrunchUnion[x,{b,a},y] /;
NumberQ[a] && Im[a]==0 &&
NumberQ[b] && Im[b]==0 &&
b < a
(* Rule to reduce adjacent overlapping segments *)
CrunchUnion[x:___List,{a_,b_},{c_,d_},y:___List] :=
CrunchUnion[x,{Min[a,c], Max[b,d]},y] /;
NumberQ[a] && Im[a]==0 &&
NumberQ[b] && Im[b]==0 &&
NumberQ[c] && Im[c]==0 &&
NumberQ[d] && Im[d]==0 &&
a <= b && c <= d &&
b >= c && a <= d
(* Function which merges and reduces lists *)
ReduceUnion[lists:{__List}..] :=
Apply[List,Apply[CrunchUnion,Union[lists]]]
USAGE:
The closed intervals must be represented as a list
of elements of the form {a,b}, where a and b must
be numeric constants or expressions of constants
(integer, real or rational values will work).
A list of intervals (or multiple lists for that
matter) are reduced using the ReduceUnion[] function.
Note that CrunchUnion[] is called by ReduceUnion[],
but shouldn't be called directly for obscure reasons.
For example,
ReduceUnion[ {{0,2},{2,4},{1,5}} ]
{{0, 5}}
As another example,
ReduceUnion[ {{0,2},{3,5}} ]
{{0, 2}, {3, 5}}
Here's a bigger example with twenty segments:
biglist = {{50,53},{97,88},{52,42},{48,55},{53,55},
{54,54},{6,9},{7,-2},{93,99},{40,42},
{79,71},{81,77},{0,5},{26,24},{7,4},
{56,48},{63,53},{80,73},{62,53},{20,13}};
ReduceUnion[biglist]
produces
{{-2, 9}, {13, 20}, {24, 26}, {40, 63}, {71, 81}, {88, 99}}
You can check the result -- it's correct. Note also that bounds
that were reversed, like {52,42}, were flipped internally to the
more correct form during reduction, like {42,52}.
You can also merge one or more lists, as in:
ReduceUnion[biglist, {{0,2},{3,5}}]
This will produce the same result as ReduceUnion[biglist],
since the added segments are already contained in [-2,9].
NOTES:
If you wish to change the code to handle open intervals as
opposed to closed intervals, then change the line
b >= c && a <= d
to
b > c && a < d
Notice the difference below:
ReduceUnion[ {{0,2},{2,4}} ]
produces
{{0, 4}} for closed intervals, or
{{0, 2}, {2, 4}} for open intervals.
I wish that Mathematica had the capability to reduce
systems of inequalities directly, so that problems like
taking unions or intersections of inequalities could be
solved more generally and more elegantly.
For example, the intervals [0,2);(2,4];[1,5] could be
represented and reduced directly as inequalities, as in
(0 <= x < 2) || (2 < x <= 4) || (1 <= x <= 5)
which would produce
0 <= x <= 5
I've looked a bit into the logistics of such a problem,
but it gets complicated very fast. Does anyone know of
a package that reduces systems of inequalities, or at
least a text which describes the mechanics behind such
problems? This type of issue probably crops up quite
a bit in linear programming, I would guess, and might
be a good field to start exploring.
\\|//
- -
o o
J roberto sierra
O tempered microdesigns
\_/ 73557.2101 at compuserve.com