Displaying the inverse image of a function, with demonstrations of how the code works

By MouseOver, 7 August 2011

This Mathematica notebook is licensed under a MouseOver .
It provides software for producing the inverse image of an interval under a particular function.  I hope anyone interested will feel free to improve this work and to use it in their own publications and coursework.

Initial definitions

ycolor:=RGBColor[.7,.2,0];xcolor:=RGBColor[.2,.6,0]

cu[x_]:=x^3-2x

mint[{x_,y_}]:={{x,0},{y,0}}  (*Produces input for ListLinePlot*)

vthick:=Thickness[0.01]

setup[f_,a_,b_,x_]:=Reduce[(f[x]≥Rationalize[a,1/20])&&(f[x]≤Rationalize[b,1/20]),x,Reals](*Find interval(s)that make up inverse image*)

Examples of the effect of setup

Manipulate[
setup[cu,a,b,x]//N,{{a,3/10},-2,2,1/20,Appearance->"Labeled"},{{b,7/10},-2,2,1/20,Appearance->"Labeled"},SaveDefinitions->True] (*This shows how setup works.*)

Manipulate[
setup[cu,a,b,x]//TreeForm,{{a,3/10},-2,2,1/20,Appearance->"Labeled"},{{b,7/10},-2,2,1/20,Appearance->"Labeled"},SaveDefinitions->True](*This shows the tree structure of setup as the rational values change.  This works rather slowly.*)

Manipulate[
setup[cu,a,b,x]//N//TreeForm,{{a,3/10},-2,2,1/20,Appearance->"Labeled"},{{b,7/10},-2,2,1/20,Appearance->"Labeled"},SaveDefinitions->True] (*Note how much simpler the tree structure is after the values have been made real*)

Manipulate[
Length[setup[cu,a,b,x]]//N,{{a,3/10},-2,2,1/20,Appearance->"Labeled"},{{b,7/10},-2,2,1/20,Appearance->"Labeled"},SaveDefinitions->True]

Manipulate[
Depth[setup[cu,a,b,x]//N],{{a,3/10},-2,2,1/20,Appearance->"Labeled"},{{b,7/10},-2,2,1/20,Appearance->"Labeled"},SaveDefinitions->True]

The main demo

Manipulate[
Show[
Plot[
cu[x],{x,-1.8,1.8},PlotStyle->{Blue},AspectRatio->5/3.6
],
(*Show interval whose inverse image we want to show*)
If[a<b, (*Don't draw reversed intervals*)
ListLinePlot[
{{0,a},{0,b}},PlotStyle->{{ycolor,vthick}}
],
Plot[{},{x,-1.8,1.8} (*Kludge necessary because "If" would produce "Null" here and Show[null] gives an error messages.*)
]
],
(*Show inverse image*)
If[a<b,
ListLinePlot[
If[Depth[N[setup[cu,a,b,x]]]<3, (*(1) If inverse image consists of one segment (Length of epression is 1)the depth is 2, otherwise it is three, so when the depth is two we put an extra pair of {} around it.  (2) Change the value from rational to real because otherwise the depth is not predictable -- a value of 3/3 reduces the depth by 1 compared to 2/3 because 3/3 is converted to 1*)
{mint @{N[setup[cu,a,b,x]][[1]],N[setup[cu,a,b,x]][[-1]]}},mint @{N[setup[cu,a,b,x]][[#]][[1]],N[setup[cu,a,b,x]][[#]][[-1]]}&/@Table[
i,{i,Length[N[setup[cu,a,b,x]]]}]
],
PlotStyle->{{xcolor,vthick}}
],
Plot[{},{x,-1.8,1.8}
]
]
],
{{a,3/10},-2,2,1/10,Appearance->"Labeled"},{{b,7/10},-2,2,1/10,Appearance->"Labeled"},SaveDefinitions->True]