Automatic Labeling in Visualization
Overview

MinHsuan Peng, Wolfram

Join the Conversation #WolframTechConf

ABSTRACT

Five Ws of automatic labeling in visualization

Where are the automatic labeling used?

Why automation?

What are automated?

How are they automated?

When were they rolled out?

Where are labeling used?

Applications of automatic labeling

Map

GeoGraphics

[source]

[source]

StarChart

WolframAlpha

Data Analysis

[source]

Scientific Plots

[source]

Anatomy

[source]

Why Automation?

Mostly because free hand labeling is time consuming and hard to reproduce.

Graphics[{Circle[],Line[{{-0.2,0},{0.2,0}}],Text[x^2+y^2<1,{0,0},{0,-1}]}]

Without algorithmic method, results can be hard to read.

SeedRandom[1];points=RandomReal[{-1,1},{30,2}];
Graphics[{Point[points],Text[RandomWord[],#,{0,-1}]&/@points}]

Using low level Text to add labels requires post processing of the plots.

plot=Plot[{Sin[x],Cos[x]},{x,0,2Pi}]

Show[{plot,Graphics[{Text["sin[x]",{Pi,Sin[Pi]+0.5}],Text["Cos[x]",{Pi,Cos[Pi]+0.15}]}]}]

Easily get distracted by labeling the plot from the plot itself.

data=EntityValue[LinguisticAssistant,{"Name","Area","Population"}];

Length[data]

Short[data[[All,1]],10]

ListLogLogPlot[data[[All,2;;3]],FrameLabel->Automatic]

What are automated?

Line Labeling

full automation

Plot[Evaluate[Table[BesselJ[x,n],{n,1,5}]],{x,0,3},PlotLabels->Automatic]

semi-automation

Table[
Plot[Sin[i x],{x,0,10},
PlotLabels->Callout[HoldForm[Sin[Pi]],Automatic,Pi,CalloutMarker->"Circle"],
ImageSize->300
]
,{i,2}]

Plot[
Evaluate@Table[BesselJ[n,x],{n,4}],
{x,0,10},
PlotLabels->Callout[Automatic,Above]
]

(*bonus*)
Plot[
Callout[Callout[BesselJ[3,x],"max",Above],"min",Below],
{x,0,10}
]

(*bonus*)
Manipulate[Plot[
Callout[BesselJ[1,x],BesselJ[1,pos],pos],
{x,0,10}
],{pos,0,10}]

2D and 3D Point Labeling

ListPlot[RandomReal[1,{50,2}]->RandomWord[50]]

Table[
ListPlot[
RandomVariate[NormalDistribution[0,σ],{100,2}]->RandomWord[100],

],
{σ,{0.2,0.5,1}}
]

FeatureSpacePlot[EntityValue[(EntityClass["Europe", EntityClass["Country","Europe"], "EntityClass[\"Country\", \"Europe\"]", "countries"]),"FlagImage"],LabelingFunction->Callout]

Table[
FeatureSpacePlot[EntityValue[(EntityClass["Europe", EntityClass["Country","Europe"], "EntityClass[\"Country\", \"Europe\"]", "countries"]),"FlagImage"],
LabelingFunction->Callout,
LabelingSize->size,
ImageSize->360,
Background->LightGray],
{size,{20,60}}
]

ListPointPlot3D[RandomReal[1,{50,3}]->RandomWord[50]]

(*bonus*)
Table[
ListPointPlot3D[
RandomVariate[NormalDistribution[0,σ],{100,3}]->RandomWord[100],
Axes->False,
BoxRatios->1,
ImageSize->300,
PlotRange->{{-4,4},{-4,4},{-4,4}},
PlotLabel->NormalDistribution[0,σ]
],
{σ,{0.2,0.5,1}}
]

Parametric Curve Labeling

full automation

ParametricPlot[
Evaluate@Table[
Tooltip[{i Cos[u],i Sin[u]},i],
{i,1,3}],
{u,0,2Pi},
PlotLabels->Automatic]

PolarPlot[{Sin[6t],1+1/5 Sin[10t]},{t,0,2Pi},PlotLabels->Automatic]

semi-automation

ParametricPlot[
Evaluate@Fold[
Callout[#,u==#2,#2]&,
{u Cos[u],u Sin[u]},
Range[0,3Pi,Pi/3]
],
{u,0,3Pi},

]

ParametricPlot3D[
Evaluate@Fold[
Callout[#,u==#2,#2]&,
{Sin[u],Cos[u],u/10},
Range[0,3Pi,Pi/3]
],
{u,0,3Pi}
]

Region Labeling

ParametricPlot[r^2{ Sqrt[t]Cos[t], Sin[t]},
{t,0,3Pi/2},
{r,1,2},
PlotLabels->Automatic]

ParametricPlot[r^2{ Sqrt[t]Cos[t], Sin[t]},
{t,0,3Pi/2},
{r,1,2},
PlotLabels->Callout[Automatic,{-4.5,3.5}]]

ParametricPlot[
Evaluate@Table[{(v+i) Cos[u],(v+i)Sin[u]},{i,1,3}],
{u,0,2Pi},
{v,0,0.75},
PlotLabels->Automatic]

RegionPlot[1<x^2-x y+y^2<2,{x,-2,2},{y,-2,2},PlotLabels->Automatic]

RegionPlot[{x^2<y^3+1,y^2<x^3+1},{x,-2,5},{y,-2,5},
PlotLabels->Callout[Automatic,{Before,After}]]

Surface Labeling

Plot3D[Sin[Sin[x]+Cos[y]],{x,-Pi,Pi},{y,-Pi,Pi},
PlotLabels->Callout[Automatic,]
]

Plot3D[Sin[Sin[x]+Cos[y]],{x,-Pi,Pi},{y,-Pi,Pi},
PlotLabels->Callout[Automatic,{-Pi/2,-Pi/2},]]

Labeling In Charts

BarChart[RandomInteger[10,20],
ChartLabels->Callout[RandomWord[20]]]

BarChart[RandomInteger[10,20],
ChartLabels->RandomWord[20],LabelingSize->20]

Table[BarChart[{1,1,2,3,5,8,13},
ChartLabels->{,,,,,,},
ImageSize->size,
LabelingSize->Automatic
],
{size,{200,400}}
]

PieChart[Sort@RandomReal[10,20],
ChartLabels->Callout[RandomWord[20],LabelStyle->14],PlotRange->All]

BubbleChart[RandomReal[1,{30,3}],ChartLabels->Callout[RandomWord[30]]]

How?

Methods of implementation of automatic labeling

Image Processing

Open, Close, Erosion, Dilation, etc...

Used in curve labeling in Plot, region labeling in ParametricPlot

Optimization

FindMinimum

Used in PieChart, Plot, curve labeling

Geometry

RegionNearest, RegionUnion...

Used in ParametricPlot, RegionPlot

Point Feature Labeling Problem

NP-hard problem

Avoid tackling the problem directly and instead to find a suboptimal solution(but much faster).

Optimization, nearest, ... dropping labels

Used in ListPlot, ListPointPlot3D, FeatureSpacePlot/3D, etc...

Others

Plot3D

Plot3D[Callout[Sin[x+y],Sin[x+y],{2,1}],{x,0,Pi},{y,0,Pi}]

TimelinePlot and BarChart

BarChart[RandomReal[1,10],ChartLabels->Callout[RandomWord[10],FrameMargins->0]]

LabelVisibility

({{      , (RefLink[All, paclet:ref/All]), always show the label}, {      , (RefLink[Infinity, paclet:ref/Infinity]), highest priority for automatic labeling}, {      , n, relative priority for automatic labeling}, {      , -(RefLink[Infinity, paclet:ref/Infinity]), lowest priority for automatic labeling}, {      , (RefLink[Automatic, paclet:ref/Automatic]), priority determined by ordering}, {      , (RefLink[None, paclet:ref/None]), never show the label}})

Label all the even numbered points in a plot, even if some of them collide :

ListPlot[RandomSample[Table[Callout[{i,i},i,LabelVisibility->If[EvenQ[i],All,None]],{i,100}]]]

Label even numbered points while avoiding collisions:

ListPlot[RandomSample[Table[Callout[{i,i},i,LabelVisibility->If[EvenQ[i],Infinity,-Infinity]],{i,100}]]]

When were they rolled out?

Timeline of labeling

TimelinePlot[data,
ImageSize->1100,
PlotRangePadding->{{Scaled[0.1],Scaled[0.1]},None},
AspectRatio->1/1.75,
PlotStyle->ColorData[108]
]

data

data={{Labeled[(DateObject["Day: ""Mon 8 Aug 2016", DateObject[{2016,8,8},"Day","Gregorian",-5.`]]),"Callout <11.0>"],Labeled[(DateObject["Day: ""Tue 18 Nov 2008", DateObject[{2008,11,18},"Day","Gregorian",-6.`]]),"Labeled <7.0>"],
Labeled[(DateObject["Day: ""Tue 18 Nov 2008", DateObject[{2008,11,18},"Day","Gregorian",-6.`]]),"Chartlabels <7.0>"],Labeled[(DateObject["Day: ""Tue 18 Nov 2008", DateObject[{2008,11,18},"Day","Gregorian",-6.`]]),"LabelingFunction <7.0>"],Labeled[(DateObject["Day: ""Mon 15 Nov 2010", DateObject[{2010,11,15},"Day","Gregorian",-6.`]]),"EventLabels <8.0>"],Labeled[(DateObject["Day: ""Wed 2 Mar 2016", DateObject[{2016,3,2},"Day","Gregorian",-5.`]]),"PlotLabels <10.4>"],
Labeled[(DateObject["Day: ""Fri 1 Mar 2019", DateObject[{2019,3,1},"Day","Gregorian",-5.`]]),"LabelVisibility <12.0>"],Labeled[(DateObject["Day: ""Thu 8 Mar 2018", DateObject[{2018,3,8},"Day","Gregorian",-5.`]]),"LabelingSize <11.3>"]},
updates,
v101~Join~v104~Join~v7~Join~v8~Join~v11~Join~v113~Join~v12};

updates=<|"Labeled Update 10.4"->(DateObject["Day: ""Wed 2 Mar 2016", DateObject[{2016,3,2},"Day","Gregorian",-5.`]]),"Vis/Charts Update 11"->(DateObject["Day: ""Mon 8 Aug 2016", DateObject[{2016,8,8},"Day","Gregorian",-5.`]]),"Vis Update 12.0"->(DateObject["Day: ""Fri 1 Mar 2019", DateObject[{2019,3,1},"Day","Gregorian",-5.`]]),
"Labeled Update 12.0"->(DateObject["Day: ""Fri 1 Mar 2019", DateObject[{2019,3,1},"Day","Gregorian",-5.`]])|>;

v101=Association[Thread[{"TimelinePlot <10.1>"}->(DateObject["Day: ""Mon 30 Mar 2015", DateObject[{2015,3,30},"Day","Gregorian",-6.`]])]];

v104=Association[Thread[{"Plots","LogPlots","ListPlots","ListLinePlot","ListLogPlots","GeoPlots"}->(DateObject["Day: ""Wed 2 Mar 2016", DateObject[{2016,3,2},"Day","Gregorian",-5.`]])]];

v7=Association[Thread[{"BarChart/3D","PieChart/3D","SectorChart/3D","BubbleChart/3D"}->(DateObject["Day: ""Tue 18 Nov 2008", DateObject[{2008,11,18},"Day","Gregorian",-6.`]])]];

v8=Association[Thread[{"FinancialCharts"}->(DateObject["Day: ""Mon 15 Nov 2010", DateObject[{2010,11,15},"Day","Gregorian",-6.`]])]];

v11=Association[Thread[{}->(DateObject["Day: ""Mon 8 Aug 2016", DateObject[{2016,8,8},"Day","Gregorian",-5.`]])]];

v113=Association[Thread[{"FeatureSpacePlot","FeatureSpacePlot3D","ListPointPlot3D"}->(DateObject["Day: ""Thu 8 Mar 2018", DateObject[{2018,3,8},"Day","Gregorian",-5.`]])]];

v12=Association[Thread[{"ParamtericPlot/3D","PolarPlot","RegionPlot","Plot3D","ListPlot3D",
"SphericalPlot","RevolutionPlot","DiscretePlot/3D","ReImPlot","ComplexListPlot","AbsArgPlot","ComplexPlot/3D"}->(DateObject["Day: ""Fri 1 Mar 2019", DateObject[{2019,3,1},"Day","Gregorian",-5.`]])]];

TimelinePlot[<|"7.0"->(DateObject["Day: ""Tue 18 Nov 2008", DateObject[{2008,11,18},"Day","Gregorian",-6.`]]),"8.0"->(DateObject["Day: ""Mon 15 Nov 2010", DateObject[{2010,11,15},"Day","Gregorian",-6.`]]),
"9.0"->(DateObject["Day: ""Wed 28 Nov 2012", DateObject[{2012,11,28},"Day","Gregorian",-6.`]]),"10.0"->(DateObject["Day: ""Wed 9 Jul 2014", DateObject[{2014,7,9},"Day","Gregorian",-6.`]]),"10.1"->(DateObject["Day: ""Mon 30 Mar 2015", DateObject[{2015,3,30},"Day","Gregorian",-6.`]]),"10.2"->(DateObject["Day: ""Tue 14 Jul 2015", DateObject[{2015,7,14},"Day","Gregorian",-6.`]]),
"10.3"->(DateObject["Day: ""Thu 15 Oct 2015", DateObject[{2015,10,15},"Day","Gregorian",-6.`]]),"10.4"->(DateObject["Day: ""Wed 2 Mar 2016", DateObject[{2016,3,2},"Day","Gregorian",-5.`]]),"11.0"->(DateObject["Day: ""Mon 8 Aug 2016", DateObject[{2016,8,8},"Day","Gregorian",-5.`]]),"11.1"->(DateObject["Day: ""Thu 16 Mar 2017", DateObject[{2017,3,16},"Day","Gregorian",-5.`]]),
"11.2"->(DateObject["Day: ""Thu 14 Sep 2017", DateObject[{2017,9,14},"Day","Gregorian",-5.`]]),"11.3"->(DateObject["Day: ""Thu 8 Mar 2018", DateObject[{2018,3,8},"Day","Gregorian",-5.`]])|>]

Bonus

l=(EntityClass["all countries, dependencies, and territories", EntityClass["Country","Countries"], "EntityClass[\"Country\", \"Countries\"]", "countries"])["Position"];
c=(EntityClass["all countries, dependencies, and territories", EntityClass["Country","Countries"], "EntityClass[\"Country\", \"Countries\"]", "countries"])["Name"];
oil=(EntityClass["all countries, dependencies, and territories", EntityClass["Country","Countries"], "EntityClass[\"Country\", \"Countries\"]", "countries"])[];
major=Quantile[QuantityMagnitude@DeleteMissing[oil],0.75];
oildata=Select[Select[Transpose[{l,oil,c}],Head@#[[2]]=!=Missing&],QuantityMagnitude[#[[2]]]>major&];
GeoBubbleChart[oildata[[All,1;;2]],ColorFunction->"Rainbow",LabelingFunction->(Callout[oildata[[All,3]][[#2[[2]]]],LabelStyle->13]&),ImageSize->1200,PlotTheme->"Marketing",GeoProjection->"Albers"]

Callout Appearance

(*markup*)
Callout[data,"label",
LabelStyle->40,
LeaderSize->{{leaderlength,angle,gap},{necklength,angle}},
Appearance->appearance,
CalloutMarker->marker,
Background->backgroundstyle,
FrameMargins->framemargins,
RoundingRadius->radius,
CalloutStyle->Thickness[0.01]]

DynamicModule[{autonangle=True,angle=45,llen=25,nlen=10,nangle=45,gap=5,app="Frame",marker=None,bgrd=White,radius=0,margin=5},Row[{Framed@Dynamic[Graphics[{PointSize[Large],Point[{0,0}],
Charting`LabelMaker[Style["label",40],{0,0},Automatic,LeaderSize->{{llen,angle Degree,gap},{nlen,If[autonangle,Automatic,nangle Degree]}},Appearance->app,CalloutMarker->{marker,15},CalloutStyle->Thickness[0.01],Background->bgrd,RoundingRadius->radius,FrameMargins->margin]
},PlotRange->0.5,ImageSize->400]],Column[{
Labeled[Slider[Dynamic[angle],{0,360}],"angle",Left],
Labeled[Slider[Dynamic[llen],{10,60}],"leader length",Left],
Labeled[Slider[Dynamic[nlen],{0,30}],"neck length",Left],
Labeled[Slider[Dynamic[gap],{0,30}],"leader gap",Left],
Labeled[Slider[Dynamic[radius],{0,30}],"rounding radius",Left],
Labeled[Slider[Dynamic[margin],{0,30}],"frame margins",Left],
Labeled[ColorSlider[Dynamic[bgrd]],"background",Left],
Row@{Labeled[Checkbox[Dynamic[autonangle]],"auto neck angle",Left],
Labeled[Slider[Dynamic[nangle],{0,360},Enabled->Dynamic@Not@autonangle],"neck angle",Left]},
Labeled[PopupMenu[Dynamic[app],{"CurvedLeader","Balloon","LineBalloon","Corners","Frame","Line"}],"appearance",Left],Labeled[PopupMenu[Dynamic[marker],{None,"CirclePoint","Circle","BoxPoint", "Box","Star", "OpenStar","Arrow", "OpenArrow"}],"marker",Left]}]
},"   "]]

init

$PlotTheme={"Presentation","Large"};