Search code examples
wolfram-mathematicaintervals

Plotting a number line in Mathematica


I would like to plot a simple interval on the number line in Mathematica. How do I do this?


Solution

  • Here's another attempt that draws number lines with the more conventional white and black circles, although any graphics element that you want can be easily swapped out.

    It relies on LogicalExpand[Simplify@Reduce[expr, x]] and Sort to get the expression into something resembling a canonical form that the replacement rules can work on. This is not extensively tested and probably a little fragile. For example if the given expr reduces to True or False, my code does not die gracefully.

    numLine[expr_, x_Symbol:x, range:{_, _}:{Null, Null}, 
      Optional[hs:_?NumericQ, 1/30], opts:OptionsPattern[]] := 
     Module[{le = {LogicalExpand[Simplify@Reduce[expr, x]]} /. Or -> List,
       max, min, len, ints = {}, h, disk, hArrow, lt = Less|LessEqual, gt = Greater|GreaterEqual},
      If[TrueQ@MatchQ[range, {a_, b_} /; a < b],
       {min, max} = range,
       {min, max} = Through[{Min, Max}@Cases[le, _?NumericQ, \[Infinity]]]];
      len =Max[{max - min, 1}]; h = len hs;
      hArrow[{x1_, x2_}, head1_, head2_] := {{Thick, Line[{{x1, h}, {x2, h}}]},
                                             Tooltip[head1, x1], Tooltip[head2, x2]};
      disk[a_, ltgt_] := {EdgeForm[{Thick, Black}], 
        Switch[ltgt, Less | Greater, White, LessEqual | GreaterEqual, Black], 
        Disk[{a, h}, h]};
      With[{p = Position[le, And[_, _]]}, 
           ints = Extract[le, p] /. And -> (SortBy[And[##], First] &); 
           le = Delete[le, p]];   
      ints = ints /. (l1 : lt)[a_, x] && (l2 : lt)[x, b_] :> 
         hArrow[{a, b}, disk[a, l1], disk[b, l2]];
      le = le /. {(*_Unequal|True|False:>Null,*)
         (l : lt)[x, a_] :> (min = min - .3 len; 
           hArrow[{a, min}, disk[a, l], 
            Polygon[{{min, 0}, {min, 2 h}, {min - Sqrt[3] h, h}}]]),
         (g : gt)[x, a_] :> (max = max + .3 len; 
           hArrow[{a, max}, disk[a, g], 
            Polygon[{{max, 0}, {max, 2 h}, {max + Sqrt[3] h, h}}]])};
      Graphics[{ints, le}, opts, Axes -> {True, False}, 
       PlotRange -> {{min - .1 len, max + .1 len}, {-h, 3 h}},
       GridLines -> Dynamic[{{#, Gray}} & /@ MousePosition[
                               {"Graphics", Graphics}, None]], 
       Method -> {"GridLinesInFront" -> True}]
      ]
    

    (Note: I had originally tried to use Arrow and Arrowheads to draw the lines - but since Arrowheads automatically rescales the arrow heads with respect to the width of the encompassing graphics, it gave me too many headaches.)

    OK, some examples:

    numLine[0 < x], 
    numLine[0 > x]
    numLine[0 < x <= 1, ImageSize -> Medium]
    

    enter image description here
    enter image description here
    enter image description here

    numLine[0 < x <= 1 || x > 2, Ticks -> {{0, 1, 2}}]
    

    enter image description here

    numLine[x <= 1 && x != 0, Ticks -> {{0, 1}}]
    

    enter image description here

    GraphicsColumn[{
      numLine[0 < x <= 1 || x >= 2 || x < 0],
      numLine[0 < x <= 1 || x >= 2 || x <= 0, x, {0, 2}]
      }]
    

    enter image description here

    Edit: Let's compare the above to the output of Wolfram|Alpha

    WolframAlpha["0 < x <= 1 or x >= 2 or x < 0", {{"NumberLine", 1}, "Content"}]
    WolframAlpha["0 < x <= 1 or x >= 2 or x <= 0", {{"NumberLine", 1}, "Content"}]
    

    output of the above

    Note (when viewing the above in a Mathematica session or the W|A website) the fancy tooltips on the important points and the gray, dynamic grid lines. I've stolen these ideas and incorporated them into the edited numLine[] code above.

    The output from WolframAlpha is not quite a normal Graphics object, so it's hard to modify its Options or combine using Show. To see the various numberline objects that Wolfram|Alpha can return, run WolframAlpha["x>0", {{"NumberLine"}}] - "Content", "Cell" and "Input" all return basically the same object. Anyway, to get a graphics object from

    wa = WolframAlpha["x>0", {{"NumberLine", 1}, "Content"}]
    

    you can, for example, run

    Graphics@@First@Cases[wa, GraphicsBox[__], Infinity, 1]
    

    Then we can modify the graphics objects and combine them in a grid to get

    aligned