Chapter Four Visualizing Data in Two Dimensions

4.3.3 Legends

Needs["Graphics`Legend`"]

Plot[{4 Exp[-x^2],3(1-x^2)},{x,-1,1},
     PlotRange -> {Automatic,{-4,4}},
     PlotStyle -> {AbsoluteThickness[1],
	              {AbsoluteThickness[0.5], AbsoluteDashing[{4,4}]}},
     PlotLegend -> {"Theory","Expt"}]

dataone = Table[N[{2 Pi i/20, Sin[2 Pi i/20]}], {i, 0, 40}];
datatwo = Table[N[{2 Pi i/20, Cos[2 Pi i/20]}], {i, 0, 40}];

fnone = Interpolation[dataone];
fntwo = Interpolation[datatwo];

Plot[{fnone[x], fntwo[x]}, {x, 0, 4 Pi},
	PlotStyle -> {
    {AbsoluteThickness[1], RGBColor[0, 0, 1]},
    {AbsoluteThickness[1], AbsoluteDashing[{4,4}]}},
	PlotLegend -> {" Sindata"," Cosdata"},
	LegendPosition -> {1.2, 0},
	LegendShadow -> {0, 0},
	LegendSize -> {1, 0.5},
	LegendLabel -> FontForm["Key", {"Helvetica"  ,12}]]

ShowLegend[
		ParametricPlot[{{s, s^2}, {Sin[s], Sin[2 s]}}, 
		{s, -2 Pi, 2 Pi}, 
		PlotStyle -> {{AbsoluteThickness[1]}, 
					  {AbsoluteThickness[2], 
						RGBColor[1, 0, 0]}},
		DisplayFunction -> Identity],
	{{{Graphics[{AbsoluteThickness[1], 
	Line[{{-0.05, 0}, {0.05,0}}]}], " y = x^2"},  
	{Graphics[{AbsoluteThickness[2], RGBColor[1, 0, 0], 
	Line[{{-0.05, 0}, {0.05,0}}]}], " BowTie"}},
	LegendPosition -> {0.7, 0.15}}]

stdstyles = {{AbsoluteThickness[1]}, 
			 {AbsoluteDashing[{5, 5, 5, 5}], AbsoluteThickness[1]},
			 {RGBColor[1, 0, 0], AbsoluteThickness[1]},
			 {RGBColor[0, 0, 1], AbsoluteThickness[1]}};
stdline = Line[{{-1, 0}, {1,0}}];

makelegend[data_List, styles_List, line_] := 
Module[{len, baseprims, outlist},
len = Length[data];
lenstyles = Length[styles];
baseprims = Map[Graphics, Map[Append[#, stdline]&, stdstyles]];
outlist = {};
Do[outlist = Append[outlist, {baseprims[[1]], data[[i]]}];
baseprims = RotateLeft[baseprims],
{i, 1, len}];
outlist]

ShowLegend[
		ParametricPlot[{{Sin[s], Sin[2 s]}, 
						{Sin[s], Sin[3 s]},
						{Sin[s], Sin[4 s]},
						{Sin[s], Sin[5 s]}},
		{s, - Pi/2,  Pi/2}, 
		PlotStyle -> stdstyles,
		DisplayFunction -> Identity],
{{{Graphics[{stdstyles[[1, 1]], stdline}], " Sin[2 s]"},  
{Graphics[{stdstyles[[2, 1]], stdline}], " Sin[3 s]"},
{Graphics[{stdstyles[[3, 1]], stdstyles[[3, 2]], stdline}], " Sin[4 s]"},  
{Graphics[{stdstyles[[4, 1]], stdstyles[[4, 2]], stdline}], " Sin[5 s]"}},
LegendPosition -> {1.2, -0.3},
LegendSize -> {0.7, 0.6}}]

ShowLegend[
		ParametricPlot[{{Sin[s], Sin[2 s]}, 
						{Sin[s], Sin[3 s]},
						{Sin[s], Sin[4 s]},
						{Sin[s], Sin[5 s]}},
		{s, - Pi/2,  Pi/2}, 
		PlotStyle -> stdstyles,
		DisplayFunction -> Identity],
	{makelegend[{"Sin[2 s]", "Sin[3 s]", "Sin[4 s]", "Sin[5 s]"}, 
				stdstyles, stdline],
	LegendPosition -> {1.2, -0.3},
	LegendSize -> {0.7, 0.6}}]

Combining MultipleListPlot and Legend

Needs["Graphics`MultipleListPlot`"];
gaussdata = Table[ N[1000 Exp[-i/5]] ,{i,1,10}];
cubedata = Table[i^3,{i,1,10}];

NewMakeSymbol[{a_, Line[x_]}] := 
  Module[{yugh, y}, y = Line[(Scaled[#1, yugh] & ) /@ x]; 
    y = y /. yugh -> #1; Evaluate[{a, y}]&]

NewMakeSymbol[Line[x_]] := 
NewMakeSymbol[{AbsoluteThickness[0.1], Line[x]}]

diamond = RegularPolygon[4, 0.02];
star = RegularPolygon[5, 0.02, {0, 0}, 0, 2];

MultipleListPlot[gaussdata, cubedata,
DotShapes -> {NewMakeSymbol[diamond], NewMakeSymbol[star]}]

ShowLegend[
		MultipleListPlot[gaussdata, cubedata,
		DotShapes -> {NewMakeSymbol[diamond], NewMakeSymbol[star]},
		DisplayFunction -> Identity],
	{{{Graphics[diamond], " gaussdata"},  
	  {Graphics[star], " cubedata"}},
	LegendPosition -> {1.2, -0.25}}]

4.7 Exploring an Historic Data Set

Built-in Approach

temps = Map[#[[2]]&, tempdata]

ListPlot[temps, 
DefaultFont -> {"Helvetica", 12}, PlotJoined -> True, 
AxesOrigin -> {1,0}, PlotRange -> {{1, 9}, {-30, 0}},
Frame -> True,
RotateLabel -> False,
FrameLabel -> {"Observation Point", "Deg R",
"Temperature on Napoleon's Return from Moscow", " "}]

Adding Functionality via Packages

Needs["Miscellaneous`Calendar`"]

dates = Map[#[[1]]&, tempdata]

?DaysBetween

dayseps = Map[DaysBetween[#, dates[[1]] ]&, dates]

plottemp = Transpose[{dayseps, temps}]

ListPlot[plottemp, 
DefaultFont -> {"Helvetica", 12}, PlotJoined -> True, 
AxesOrigin -> {0,0}, PlotRange -> All,
Frame -> True,
RotateLabel -> False,
FrameLabel -> {"Elapsed Days", "Deg R",
"Temperature on Napoleon's Return from Moscow", " "}]

Adding the Fate of the Army

armydata = {
{{1812,10,18},100000},{{1812,10,24}, 96000},
{{1812,11, 1}, 87000},{{1812,11, 4}, 87000},
{{1812,11, 4}, 55000},{{1812,11, 9}, 55000},
{{1812,11, 9}, 37000},{{1812,11,14}, 37000},
{{1812,11,14}, 24000},{{1812,11,19}, 24000},
{{1812,11,19}, 20000},{{1812,11,25}, 20000},
{{1812,11,25}, 50000},{{1812,11,28}, 50000},
{{1812,11,28}, 28000},{{1812,12, 6}, 12000},
{{1812,12, 7},  8000}};

Elapsify[datedata_, yscale_] :=
Module[{dates, values, days},
dates =  Map[#[[1]]&, datedata];
values = Map[#[[2]]&, datedata];
days =   Map[DaysBetween[#, dates[[1]] ]&, dates];
Transpose[{days, values/yscale}]]

elapsedarmy = Elapsify[armydata, 1000]

Needs["Graphics`MultipleListPlot`"];
Needs["Graphics`Legend`"]

snowflake = Line[{{0,0},{0,0.025},{0,0},{Sqrt[3]/80,0.0125},{0,0},
{Sqrt[3]/80,-0.0125},{0,0},{0,-0.025},{0,0},
{-Sqrt[3]/80,-0.0125},{0,0},{-Sqrt[3]/80, 0.0125},{0,0}} ];

gundata = {{-0.0375,0.005},{0.0375,0.005},{0.0375, 0.},
{0.,0.},{0.,-0.005},{-0.0125, -0.005}, 
{-0.0125, 0.},{-0.0375, -0.0125},{-0.0375, 0.005}};

gun = Line[Map[Dot[N[{{1/Sqrt[2], -1/Sqrt[2]}, 
{1/Sqrt[2], 1/Sqrt[2]}}],   #]&, gundata]];

Show[Graphics[{gun, snowflake}], 
AspectRatio -> Automatic]

ShowLegend[
MultipleListPlot[
	plottemp, elapsedarmy,
	DotShapes -> {NewMakeSymbol[snowflake],
				 NewMakeSymbol[gun]},
	PlotRange -> {{-4, 55}, {-40, 120}},
	PlotJoined -> True,
	LineStyles ->{{AbsoluteThickness[1], Dashing[{0.01,0.02}]},
	{AbsoluteThickness[1], Dashing[{0.01,0.01}] }},
	PlotLabel -> 
	FontForm["Napoleon's Return from Moscow",
	{"Helvetica-Bold", 18}],
	AxesLabel -> {"Days Elapsed", " "},
	DisplayFunction -> Identity
	],
{Graphics[If[#==1, snowflake, gun]]&, 
2, "Soldiers [1000s]", "Temp [Deg R]", 
LegendPosition -> {0.0, 0.15},
LegendSize ->{1, 0.15}}]

Minard's Chart and Full use of Primitives

TempData = {{0.955, 0.306, 0},{0.885, 0.304, 0},{0.7, 0.259, -9},
{0.612, 0.228, -21},{0.433, 0.177, -11},{0.372, 0.17, -20},
{0.316, 0.201, -24}, {0.279, 0.181, -30},{0.158, 0.195, -26}};

TitleData = {{0.5,0.45, "Napoleon's Russian Campaign of 1812"}};
PointData = {{0.965,0.396, "Moscow"}};
TextData = {{0.98, 0.085, "0"}, {0.98, 0.026, "-30"},
 {0.111, 0.1502, "R. Niemen"}, {0.37, 0.20, "R. Berezina"},
{0.5,0.015,"Temperature in degrees Reaumur - return march"},
{0.1, 0.22, "422,000"},{0.9, 0.38, "100,000"},{0.04, 0.175, "10,000"},
{0.4, 0.4, "Strength of army = approximate thickness of track"},
{0.4, 0.38, "Return marches shown in black"}};

StrengthData = {
{{0.142, 0.238, 50000, 1},{0.257, 0.331, 50000, 1},{0.312, 0.326, 50000, 1},
{0.312, 0.326, 33000, 1},{0.392, 0.318, 33000, 0}},{{0.392, 0.318, 30000, 0},
{0.433, 0.177, 30000, 0}},{{0.105, 0.242, 22000, 1},{0.111,0.351, 22000, 1}},
{{0.103, 0.353,  6000, 0},{0.0916,0.193, 6000, 0}},{{0.0565, 0.23, 422000,1},
{0.105, 0.242, 422000, 1},{0.105, 0.242, 400000, 1},{0.181, 0.234, 400000, 1},
{0.181, 0.234, 340000, 1},{0.333, 0.273, 257000, 1},{0.476, 0.288, 175000, 1},
{0.595, 0.250, 145000, 1},{0.704, 0.290, 136000, 1},{0.789, 0.368, 127000, 1},
{0.84 , 0.355, 127000, 1},{0.84,  0.355, 100000, 1},{0.856, 0.349, 100000, 1},
{0.955, 0.4  , 100000, 1}},{{0.965, 0.382,100000, 0},{0.953, 0.374, 100000, 0},
{0.945, 0.312, 100000, 0},{0.932, 0.302,  98000, 0},{0.838, 0.326,  87000, 0},
{0.768, 0.296,  87000, 0},{0.768, 0.296,  55000, 0},{0.7,   0.259,  55000, 0},
{0.7  , 0.259,  37000, 0},{0.612, 0.228,  37000, 0},{0.612, 0.228,  24000, 0},
{0.511, 0.209,  24000, 0},{0.511, 0.209,  20000, 0},{0.433, 0.177,  20000, 0},
{0.433, 0.177,  50000, 0},{0.390, 0.162,  50000, 0},{0.380, 0.164,  50000, 0},
{0.380, 0.164,  28000, 0},{0.316, 0.201,  22000, 0},{0.279, 0.181,  22000, 0},
{0.248, 0.191,  14000, 0},{0.158, 0.195,   8000, 0},{0.125, 0.193,   8000, 0},
{0.125, 0.193,   4000, 0},{0.0916,0.193,   4000, 0},{0.0916,0.193,  10000, 0},
{0.0682,0.193, 10000, 0}}};

RiverData = {{{0.39, 0.123}, {0.39, 0.131}, {0.388, 0.135}, {0.388, 0.14}, {0.382, 0.144}, 
  {0.382, 0.152}, {0.378, 0.156}, 
  {0.38, 0.17}, {0.376, 0.17}, {0.378, 0.177}, {0.374, 0.187}, {0.376, 0.195}, {0.372, 0.199}, {0.366, 0.199}, 
   {0.357, 0.203}, {0.349, 0.214}}, {{0.513, 0.123}, {0.513, 0.133}, {0.511, 0.138}, {0.509, 0.15}, {0.517, 0.166}, 
   {0.517, 0.181}, {0.509, 0.185}, {0.511, 0.195}, {0.509, 0.199}, {0.511, 0.207}, {0.513, 0.212}, {0.522, 0.226}, 
   {0.536, 0.23}, {0.548, 0.23}, {0.55, 0.234}}, 
  {{0.0702, 0.121}, {0.0712, 0.13}, {0.076, 0.134}, {0.077, 0.142}, {0.0721, 0.148}, {0.0673, 0.153}, 
   {0.0653, 0.156}, {0.0692, 0.161}, {0.0721, 0.165}, {0.0712, 0.169}, {0.0692, 0.173}, {0.0692, 0.175}, 
   {0.0712, 0.179}, {0.076, 0.184}, {0.076, 0.191}, {0.0702, 0.202}, {0.0692, 0.212}, {0.0682, 0.218}, 
   {0.0624, 0.222}, {0.0575, 0.224}, {0.0546, 0.23}, {0.0575, 0.238}, {0.0585, 0.245}, {0.0585, 0.251}, 
   {0.0546, 0.255}, {0.0546, 0.259}, {0.0507, 0.265}, {0.0507, 0.271}, {0.0448, 0.275}, {0.039, 0.276}, 
   {0.0331, 0.275}, {0.0292, 0.277}, {0.0292, 0.283}, {0.0292, 0.287}, {0.0224, 0.286}, {0.0175, 0.281}, 
   {0.0146, 0.278}, {0.0107, 0.278}, {0.00487, 0.278}}, 
  {{0.847, 0.363}, {0.847, 0.365}, {0.847, 0.371}, 
   {0.844, 0.374}, {0.843, 0.379}, {0.841, 0.381}, {0.833, 0.382}, 
   {0.830, 0.383}, {0.828, 0.383}, {0.825, 0.383}, {0.822, 0.383}, {0.821, 0.385}, {0.817, 0.386}, 
   {0.814, 0.388}, {0.813, 0.392}, {0.811, 0.394}, {0.809, 0.397}, {0.807, 0.4}, 
   {0.804, 0.402}, {0.804, 0.405}, {0.802, 0.407}, {0.798, 0.411}, {0.794, 0.415}}};

StrengthData = {
{{0.142, 0.238, 50000, 1},{0.257, 0.331, 50000, 1},{0.312, 0.326, 50000, 1},
{0.312, 0.326, 33000, 1},{0.392, 0.318, 33000, 0}},{{0.392, 0.318, 30000, 0},
{0.433, 0.177, 30000, 0}},{{0.105, 0.242, 22000, 1},{0.111,0.351, 22000, 1}},
{{0.103, 0.353,  6000, 0},{0.0916,0.193, 6000, 0}},{{0.0565, 0.23, 422000,1},
{0.105, 0.242, 422000, 1},{0.105, 0.242, 400000, 1},{0.181, 0.234, 400000, 1},
{0.181, 0.234, 340000, 1},{0.333, 0.273, 257000, 1},{0.476, 0.288, 175000, 1},
{0.595, 0.250, 145000, 1},{0.704, 0.290, 136000, 1},{0.789, 0.368, 127000, 1},
{0.84 , 0.355, 127000, 1},{0.84,  0.355, 100000, 1},{0.856, 0.349, 100000, 1},
{0.955, 0.4  , 100000, 1}},{{0.965, 0.382,100000, 0},{0.953, 0.374, 100000, 0},
{0.945, 0.312, 100000, 0},{0.932, 0.302,  98000, 0},{0.838, 0.326,  87000, 0},
{0.768, 0.296,  87000, 0},{0.768, 0.296,  55000, 0},{0.7,   0.259,  55000, 0},
{0.7  , 0.259,  37000, 0},{0.612, 0.228,  37000, 0},{0.612, 0.228,  24000, 0},
{0.511, 0.209,  24000, 0},{0.511, 0.209,  20000, 0},{0.433, 0.177,  20000, 0},
{0.433, 0.177,  50000, 0},{0.390, 0.162,  50000, 0},{0.380, 0.164,  50000, 0},
{0.380, 0.164,  28000, 0},{0.316, 0.201,  22000, 0},{0.279, 0.181,  22000, 0},
{0.248, 0.191,  14000, 0},{0.158, 0.195,   8000, 0},{0.125, 0.193,   8000, 0},
{0.125, 0.193,   4000, 0},{0.0916,0.193,   4000, 0},{0.0916,0.193,  10000, 0},
{0.0682,0.193, 10000, 0}}};

BoxData = {{{0, 0.121},{1.05, 0.121},{1.05, 0}, {0, 0}, {0, 0.121}},
{{0, 0.121}, {1.05, 0.121}, {1.05, 0.474}, {0, 0.474}, {0, 0.121}}
};

Needs["Minard`"]

?Minard

NapoleonicMarchOnMoscowAndBackAgainPlot[StrengthData, TempData, RiverData,
BoxData, TitleData, PointData, TextData]

BeginPackage["Minard`"]

Minard::usage = "Minard.m is a package for producing thematic maps
in the style of C. J. Minard"

ProcessTemp::usage = "ProcessTemp[list] computes the graphics primitives to be associated with a list of elements of the form {x, y, temp}"

stuff::usage = "stuff[list] computes the graphics primitives to be associated with a list of elements of the form {x, y, strength}"

ProcessStrength::usage = "ProcessStrength[list] computes the graphics primitives to be associated with a list of elements of the form {{x1, y1, strength1},....., {xn, yn, strengthn}}"

ProcessRivers::usage = "ProcessRivers[list] computes the graphics primitives to be associated with a list of river coordinates"

ProcessPoints::usage = "ProcessPoints[list] computes the graphics primitives to be associated with a list of city or other point coordinates"

ProcessTitle::usage = "ProcessTitle[location, title] computes the graphics primitives to be associated with the title"

ProcessBoxes::usage = "ProcessBoxes[list] computes the graphics primitives to be associated with a list of box coordinates"

ProcessText::usage = "ProcessText[list] computes the graphics primitives to be associated with a list of coordinates and associated text"

NapoleonicMarchOnMoscowAndBackAgainPlot::usage = 
"NapoleonicMarchOnMoscowAndBackAgainPlot[strength_list, temp_list, riverdata_list, boxdata_list, titledata_list, pointdata_list, textdata_list] shows the thematic chart associated with the strength temperature, river, box, title, point and text lists, in the style of C. J. Minard."

Begin["`Private`"]

ProcessTemp[tdata_] :=
Module[{tprimlist, coords = Array[coordarr, 100], numb, k,
temprules, firstx, lastx},
temprules = {0, -10, -20, -30};
firstx = First[tdata][[1]];
lastx = Last[tdata][[1]];
tprimlist = Map[({Thickness[0.001], Line[{{firstx, 0.0916 + 0.00188333*#}, 
{lastx, 0.0916 + 0.00188333*#}}]})&, temprules];
numb = Length[tdata];
Do[
coords[[k]] = {tdata[[k, 1]], 0.0916 + tdata[[k,3]]*0.0018833}
,{k, 1, numb}];
Do[
tprimlist = Append[tprimlist, 
{Thickness[0.001], Line[{tdata[[k, Range[2]]] , coords[[k]]} ]}];
,{k, 1, numb}];
Do[
tprimlist = Append[tprimlist, 
{Thickness[0.001], Line[{coords[[k]] , coords[[k+1]]} ]}];
,{k, 1, numb-1}];
tprimlist]

stuff[sd_] := Module[{k, m, primlist,pca, pcb, pcc, pcd,
scale, dir = Array[dirarr, 100], 
rotdir = Array[rotdirarr, 100], 
l = Array[larr, 100],
avevec  = Array[avevecarr, 100]},
scale = 10500000;
primlist = { };
k = Length[sd];
Do[(dir[[m]] = sd[[m+1, Range[2] ]] - sd[[m, Range[2] ]];
l[[m]] = Sqrt[dir[[m, 1]]^2 + dir[[m, 2]]^2]),
{m, 1, k-1}];
Do[
If[l[[m]] > 0.0001,
rotdir[[m]] = {-dir[[m, 2]], dir[[m, 1]]}/l[[m]], 
rotdir[[m]] = 
{-dir[[m+1, 2]], dir[[m+1, 1]]}/l[[m+1]]], 
{m, 1, k-1}];
avevec[[1]] = rotdir[[1]];
avevec[[k]] = rotdir[[k-1]];
Do[
avevec[[m]] = 
(rotdir[[m]] + rotdir[[m-1]])/(1 + 
rotdir[[m,1]]*rotdir[[m-1,1]]
+ rotdir[[m,2]]*rotdir[[m-1,2]]), {m, 2, k-1}];
Do[
pca = sd[[m,Range[2]]] - sd[[m,3]]*avevec[[m]]/scale;
pcb = sd[[m+1,Range[2]]] - sd[[m+1,3]]*avevec[[m+1]]/scale;
pcc = sd[[m+1,Range[2]]] + sd[[m+1,3]]*avevec[[m+1]]/scale;
pcd = sd[[m,Range[2]]] + sd[[m,3]]*avevec[[m]]/scale;
u = {If[sd[[m, 4]] == 1,
RGBColor[0,1,0],
RGBColor[0,0,0]], 
Polygon[{pca, pcb, pcc, pcd}]};
primlist = Append[primlist, u],
{m, 1, k-1}];
primlist]

ProcessStrength[data_] :=
Module[{strengthprims, str, len, v},
strengthprims = {};
len = Length[data];
Do[
(strengthprims = 
Append[strengthprims, stuff[data[[v]]]]),
{v, 1, len}];
strengthprims
]

ProcessTitle[titledata_] := 
Text[FontForm[titledata[[1, 3]],{"Helvetica-Bold", 14}],
 {titledata[[1, 1]], titledata[[1, 2]]}]

ProcessPoints[pointdata_] := 
Map[({Point[Drop[#, -1]], Text[FontForm[Last[#], {"Times-Roman",   8}], 
Drop[#, -1]+{0.01,0.01}, {0, -1}]})&, pointdata]

ProcessText[textdata_] := 
Map[(Text[FontForm[Last[#], {"Times-Roman",   6}], Drop[#, -1], {0, -1}])&,  textdata]

ProcessRivers[riverdata_] := 
Map[({RGBColor[0, 0, 1], Thickness[0.001], Line[#]}&), riverdata]

ProcessBoxes[boxdata_] := 
Map[({RGBColor[0, 0, 0], Thickness[0.002], Line[#]}&), boxdata]

NapoleonicMarchOnMoscowAndBackAgainPlot[sdata_, tdata_, riverdata_, boxdata_, titledata_, pointdata_, textdata_] := 
Show[Graphics[
{ProcessStrength[sdata],
 ProcessTemp[tdata],
 ProcessRivers[riverdata],
 ProcessBoxes[boxdata],
 ProcessTitle[titledata],
 ProcessPoints[pointdata],
 ProcessText[textdata]}
]]

End[]
EndPackage[]