# Filtering out function pairs with domains lying on one side (left or right) of an intersection point

I have a list of pairs of functions that intersect at one point, as shown in the image. I am attempting to remove pairs where the domain of both functions in the pair lie on one side of the intersection point, such as in the case of (4, 5, 6). Therefore, the expected output should be the third three pairs (1, 2, 3).

Does anyone have any ideas on how to accomplish this?

One method that comes to mind is selecting a point from each line of the pair, such as point A from line 1 and point B from line 2, which are different from the intersection point. After selecting these points, we can check whether the product (xA - XM) * (xB - XM) is positive or not. Here, M refers to the intersection point of the two lines. If the product is positive, then the pair lies on the same side and can be removed. However, I have noticed that this method does not work well with pair 3, so I am still searching for a more effective solution.

   functions = {
{ConditionalExpression[-x + 9, x <= 4],
ConditionalExpression[2 x - 3, x >= 4]}, {ConditionalExpression[
2.5 x \[Minus] 5.5, x <= 3],
ConditionalExpression[\[Minus]x + 5,
x >= 3]}, {ConditionalExpression[3 x + 10, x <= 5],
ConditionalExpression[\[Minus]5 x + 30,
x <= 4]}, {ConditionalExpression[-0.5 x + 5, x >= 8],
ConditionalExpression[0.5 x \[Minus] 3,
x >= 8]}, {ConditionalExpression[x, 0 <= x <= 1],
ConditionalExpression[\[Minus]0.5 x + 1.5,
x <= 1]}, {ConditionalExpression[x, x <= 1],
ConditionalExpression[\[Minus]0.5 x + 1.5, x <= 1]}};

(*Plot[Evaluate@Flatten@functions, {x, \
-0,10},GridLines\[Rule]Automatic];*)
(*expected output is the third three pairs*)
(*expectedOut ={{ConditionalExpression[-x+9, x<= 4 \
],ConditionalExpression[2x-3, x>= 4 ] },
{ConditionalExpression[2.5x\[Minus]5.5, x<= 3 \
],ConditionalExpression[\[Minus]x+5, x>=3 ] },
{ConditionalExpression[3x+10, x<= 5 \
],ConditionalExpression[\[Minus]5x+30, x<=4 ] }};*)


EDIT:

I've added one more pair to the list above to address this case. As you can see, the domains of both functions lie on the same side of the intersection point. However, the current approach used by rhermans - checking whether two functions have the same domains - doesn't work for this particular case.

Plot[{ConditionalExpression[x, 0 <= x <= 1],
ConditionalExpression[\[Minus]0.5 x + 1.5, x <= 1]}, {x, -5, 5}]


New Update (05-Jul-2023):

Unfortunately, my posted answer does not actually solve the issue. For example, consider the pairs 3 and 4 in the image below (newly added). It only happens to be correct when the sample points are located on two different sides (left and right) of the intersection point. However, it would yield incorrect results if the sample points are on the same side (either left or right) as the intersection point.

In the combined domain of the two functions in a pair, the combined domain of pairs 1, 2, 3, and 4 are lying on both sides (left and right) of the intersection point. Consequently, I would like to retain these pairs, while pairs 5 and 6 should be eliminated. Therefore, the expected outcome should consist of the first four pairs.

functions = {
{ConditionalExpression[-x + 9, x <= 4],
ConditionalExpression[2 x - 3, x >= 4]},
{ConditionalExpression[2.5 x \[Minus] 5.5, x <= 3],
ConditionalExpression[\[Minus]x + 5, x >= 3]},
{ConditionalExpression[3 x + 10, x <= 5],
ConditionalExpression[\[Minus]5 x + 30, x <= 4]},
{ConditionalExpression[3 x, 5 <= x <= 9],
ConditionalExpression[20 + 1/2 x, x >= 8]},
{ConditionalExpression[-0.5 x + 5, x >= 8],
ConditionalExpression[0.5 x \[Minus] 3, x >= 8]},
{ConditionalExpression[x, 0 <= x <= 1],
ConditionalExpression[\[Minus]0.5 x + 1.5, x <= 1]},
{ConditionalExpression[x, x <= 1],
ConditionalExpression[\[Minus]0.5 x + 1.5, x <= 1]}
};
Plot[Evaluate@functions, {x, -0, 10}, GridLines -> Automatic]


Visualize the functions

\$PlotTheme={"Scientific"};
Plot[
Evaluate@functions
, {x, -19,19}
, PlotLegends->Automatic
, PlotRange->{-25,25}
]


Define a test.

test[{f1_,f2_ }]:=Not@SameQ[FunctionDomain[f1,x],FunctionDomain[f2,x]]


Apply the test

test /@ functions
(* {True,True,True,False,False,True} *)


Visualize selection

Plot[
Evaluate@Select[functions, test]
, {x, -19,19}
, PlotLegends->Automatic
, PlotRange->{-25,25}
]


• Thanks. The code looks pretty clean, but I'm not entirely sure if it always works correctly since it doesn't seem to take the intersection point into account. I'm just thinking about a scenario where it might not work.
– hana
Mar 1, 2023 at 17:36
• @hana it does work with your example. If you were to extend the examples to edge cases we can address the issue that may appear. Otherwise you are making us guess. Mar 1, 2023 at 17:37
• Could it be modified to remove this case as well? {ConditionalExpression[x, 0 <= x <= 1], ConditionalExpression[\[Minus]0.5 x + 1.5, x <= 1]}
– hana
Mar 1, 2023 at 17:44
• @hana please edit your question if you want to modify the goal. Comments is not for that. Mar 1, 2023 at 17:48
• Done. Technically, it's not an exception since the principle of removal remains the same. However, considering the range same does not always work.
– hana
Mar 1, 2023 at 17:52

I'll share the solution I came up with several days ago. It may not be the most concise, but it does work. To start, let's visualize the functions:

Plot[#, {x, -10, 10}, PlotRange -> {{-10, 10}, {-10, 30}},
GridLines -> Automatic] & /@ functions


Then, we can write a function to determine whether a given point lies on one side of the function's domains.

ClearAll[removeQ];
removeQ[{function1_, function2_}] :=
Module[{intersectPoint, point1, point2, cond},
intersectPoint =
Rationalize[
x /. Solve[{function1[[1]] == function2[[1]], function1[[2]],
function2[[2]]}, x][[1, 1]]];
point1 =
RandomPoint[
ImplicitRegion[
function1[[2]] &&
x != intersectPoint && (-10 < x < 10), {x}]][[1]];
point2 =
RandomPoint[
ImplicitRegion[
function2[[2]] &&
x != intersectPoint && (-10 < x < 10), {x}]][[1]];
cond = (point1 - intersectPoint)*(point2 - intersectPoint);
If[cond > 0, False, True]
]

removeQ /@ functions
(* {True, True, True, False, False, False} *)


My attempt:

test[{f1_, f2_}] := !SameQ[Head[Reduce@{FunctionRange[f1, x, y], FunctionRange[f2, x, y]}], Equal]

Plot[Evaluate@Select[Map[Rationalize, functions, {2}], test], {x, 0, 10}, GridLines -> Automatic]


• Thank you. Unfortunately, it does not work for these two cases. Both of them return "False" while it should be "True". test[{ConditionalExpression[-x, x <= -1], ConditionalExpression[ 1, -1 <= x <= 0]}] and test[{ConditionalExpression[x, 1/2 <= x <= 1], ConditionalExpression[x, x >= 1]}]
– hana
Jul 11, 2023 at 9:58
functions2 = Join[functions,
{{ConditionalExpression[x, 1/2 <= x <= 1],
ConditionalExpression[1 - x, 0 <= x <= 1/2]},
{ConditionalExpression[x, 1/2 <= x <= 1],
ConditionalExpression[x, x >= 1/2]}}];


Using the functions xBounds and pred from this answer:

xBounds = First @ RegionBounds @
ImplicitRegion[Or @@ Map[FunctionDomain[{#, 0 <= x <= 10}, x] &] @ #, {x}] &;

pred = FreeQ[{a_Real, a_}] @ N[# /. (List /@ Thread[x -> xBounds[#]])] &;

pred /@ functions2

{True, True, True, True, False, False, False, True, False}

selected = Select[pred] @ functions2;

Plot[Evaluate @ Flatten @ selected, {x, 0, 10},
GridLines -> Automatic, ImageSize -> Large,  Frame -> True,
Axes -> False,
PlotLegends -> LineLegend[Flatten@selected,
LegendLayout -> (Grid[Map[Row[#, Spacer[5]] &] /@ Partition[#, 2],
Alignment -> {Left, Center},
Dividers -> All,
FrameStyle -> Directive[AbsoluteThickness[1/2], Gray]] &)]]


styles = Flatten[If[MemberQ[selected, #],
{#, #} & @ AbsoluteThickness[2],
{#, #} & @ Directive[AbsoluteThickness[5], CapForm["Round"],
JoinForm["Round"], Opacity[.5]]] & /@ functions2];

Plot[Evaluate @ Flatten @ functions2, {x, 0, 10},
PlotStyle -> styles,GridLines -> Automatic, ImageSize -> Large,
Frame -> True, Axes -> False,
PlotLegends -> LineLegend[
Flatten[If[pred @ #, #,
Highlighted[#, Background -> None] & /@ #] & /@ functions2],
LegendLayout -> (Grid[Map[Row[#, Spacer[5]] &] /@ Partition[#, 2],
Alignment -> {Left, Center}, Dividers -> All,
FrameStyle -> Directive[AbsoluteThickness[1/2], Gray]] &)]]


• Thank you. It's very nice presentaion. The only shortcoming is that not dealing with coline.
– hana
Jul 19, 2023 at 18:58
• can you explain "not dealing with coline"?
– kglr
Jul 19, 2023 at 19:13
• Sorry, I meant to say colinear lines. I just checked it again and it seems that you actually coved that case as well. {ConditionalExpression[x, 1/2 <= x <= 1], ConditionalExpression[x, x >= 1]}.
– hana
Jul 19, 2023 at 19:22