5
$\begingroup$

I hope everyone had a great start to the New Year!

I want to create a NumberLinePlot. Naturally, I have tried to utilise NumberLinePlot, but it did not serve my purpose as the duplicate values would present themselves as a single point.

  1. I want to stack duplicate values;
  2. and I want to use Callout to label data points in the plot. However, if there are duplicate entries, I only want the last point to have the Callout.

Here is where I am at this moment in time. I was wondering if somebody could provide advice on how-to "wolframify" the code and achieve the desired outcome. Bonus points for "asthetics"

data = Split @ { 1000, 5000, 5000, 5000, 4000, 3344, 2500 };

Flatten[Map[ Table[{First @  # , i}, {i, Length @ #}] &, data], 1] // 
 ListPlot[#, Axes -> {True, False}, AspectRatio -> .2] &

Map[Table[ {First @ #, i}, { i, Length @ # }] &, data] // 
  Map[ Callout[Last @ #, ToString @ First[#[[1]]], Above] &, #] & // 
  ListPlot[#, Axes -> {True, False}, AspectRatio -> .2] &

points

labels

Here is the input and output specification...

(* input *)
{ 1000, 5000, 5000, 5000, 4000, 3344, 2500, 2500 }

(* output *)
{ 
   Callout[{1000, 1}, 1000, Above] , 
   {5000, 1}, {5000, 2}, Callout[{5000, 3}, 5000, Above], 
   Callout[{4000, 1}, 4000, Above], 
   Callout[{3344, 1}, 3344, Above], 
   {2500, 1}, Callout[{2500, 2}, 2500, Above] 
}
$\endgroup$
5
$\begingroup$

You may useSplitBy, MapIndexed, and MapAt.

With

data = {1000, 5000, 5000, 5000, 4000, 3344, 2500, 2500}

then

ListPlot[
 Flatten[
  MapAt[Callout[#, First@#, Above] &, -1] /@
   MapIndexed[Flatten[{##}] &] /@
    SplitBy[data, Identity]
  , 1
  ]
 , Axes -> {True, False}
 , AspectRatio -> .2
 ]

Mathematica graphics

  1. SplitBy Identity (could also use #&) to get the runs of values.
  2. Then MapIndexed each value of each run with its position.
  3. Finally, MapAt the last value in each indexed run the Callout.

Hope this helps.

$\endgroup$
5
$\begingroup$
data = {1000, 5000, 5000, 5000, 4000, 3344, 2500, 2500};
pts = Table[{First@#, i}, {i, 1, Length@#}]~
      Join~{Callout[{First@#, Length@#}, First@#, Above]} & /@ 
      Split@data // Catenate;

ListPlot[pts, Axes -> {True, False}]

Mathematica graphics

$\endgroup$
4
$\begingroup$

A way to add Callout labels to NumberLinePlot: Pre-process input data to add Tooltips and post-process NumberLinePlot output to replace tooltips with callout labels:

raggedTranspose = Join[## & @@ Map[List, #, {-1}], 2] &;

addTooltips = MapAt[List @* Tooltip, #, {All, -1}] &;

preProcess = ReplaceAll[Tooltip -> Tooltip @* First] @* raggedTranspose @*  addTooltips; 

postProcess = ReplaceAll[Tooltip -> 
     ({#, First[ListPlot[{Callout[#[[1, 1]], #2, Above]}, PlotStyle -> None]]} &)];

numberLinePlotWithCallouts = postProcess @ NumberLinePlot[preProcess @ #, ##2] &;

Example:

data = Split @ {1000, 5000, 5000, 5000, 4000, 3344, 2500, 2500};

numberLinePlotWithCallouts[data, 
 ImageSize -> 500, 
 ImagePadding -> {{Automatic, Automatic}, {Automatic, 20}}, 
 PlotStyle -> AbsolutePointSize[7]] 

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.