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