(* :Title: DotPlot *)

(* :Author: Mark Fisher *)

(* :Context: DotPlot` *)

(* :Package Version: 3.0 April 2006 *)

(* :Mathematica Version: 5.2 *)

(* :Summary:
	DotPlot is an enhnaced version of ListPlot combining points with
	"connecting" lines that leave a gap near the points. DotPlot
	effectively replicates the kind of plot used in Edward R. Tufte's <The
	visual display of quantitative information> (1983, Graphics Press:
	Cheshire, Connecticut) on pages 74-75 and elsewhere.

	Also included is CirclePlot, another enhanced version of ListPlot that
	plots the points as circles. CirclePlot has the option Jitter which
	specifies whether to add random jitter to the data points.
*)

(* :History:
	The original version of DotPlot created the gaps by laying down
	oversized white points to mask the lines near the points. The current
	version computes the end points of the connecting lines using a
	transformation involving PlotRange and AspectRatio.

	October 2006, modified to accomodate Version 6. In particular,
	Point[{pt1, ..., ptn}] instead of {Point[pt1], ..., Point[ptn]}.
*)

(* :Notes:
	There is some slightly tricky stuff regarding the default PointSize for
	DotPlot. The idea is to set the default PointSize in such a way that if
	the user passes a PlotStyle option to change the color (for example),
	the default PointSize remains intact, while at the same time allowing a
	user-specified PointSize to control.

	Also, the FullOptions[] values for PlotRange and AspectRatio are
	imposed on both DotPlot and CirclePlot in order to prevent the default
	algorithms to reshape and resize the plot after the lines or circles
	have been added when the settings are Automatic. This may require the
	user to give an explicit PlotRange instead of All to avoid trimming
	some circles.

	The use of DeleteCases regarding the lists of options is not necessary:
	I'm just being neat and tidy, avoiding redundancies and the expense of
	a small amount of speed.

	The lines in DotPlot are computed as follows. Let {a, b} denote an
	adjacent pair of points. Then {A, B} = T.#& /@ {a, b} is the pair in
	standardized coordinates, where
		T = {{1/xr, 0}, {0, ar/yr}}
	and where ar is the aspect ration, xr is the horizontal range, and yr
	is the vertical range. The distance d = Sqrt[#.#]&[A - B] is computed,
	and if d > 2 r (where r is the circle radius) then {A, B} are moved
	toward each other and returned to the original coordinates:
		Inverse[T].#& /@ ({A, B} + {B - A, A - B}(r/d))
	If d <= 2 r, then the line length should be zero and consequently the
	pair is discarded.
*)

BeginPackage["DotPlot`", {"Utilities`FilterOptions`"}]

DotPlot::usage = "DotPlot[data] is an enhanced version of ListPlot
combining dots and lines. The radius of the line gaps are controlled by the
option DotPlotGap. The default setting is DotPlotGap -> .015. The line gaps
are computed via a transformation using PlotRange and AspectRatio.
Redisplaying the plot with different settings of these options may produce
undesirable results. Instead, recreate the plot with the desired settings."

CirclePlot::usage = "CirclePlot[data] is an enhanced version of ListPlot
using circles to indicate the points. CirclePlot takes the option
CirclePlotRadius. The default setting is CirclePlotRadius -> .01. The
circles are computed via a transformation using PlotRange and AspectRatio.
Redisplaying the plot with different settings of these options may produce
undesirable results. Instead, recreate the plot with the desired settings.
CirclePlot also takes the options Jitter and JitterFactor. If Jitter -> True,
then random jitter is added to the plotted points. The amount of jitter is
controlled by JitterFactor."

DotPlotGap::usage = "DotPlotGap is an option for DotPlot which specifies
the radius of the line gaps around the data points."

CirclePlotRadius::usage = "CirclePlotRadius is an option for CirclePlot which
specifies the radius of the circles that represent the data points."

Jitter::usage = "Jitter is an option for CirclePlot which specifies whether
to add jitter to the data points. The default setting is Jitter -> False."

JitterFactor::usage = "JitterFactor controls the amount of jitter when Jitter -> True.
The default setting is JitterFactor -> 1."

Begin["`Private`"]

Options[DotPlot] = {DotPlotGap -> .02}

DefaultPointSize = .012

DotPlot[data : ({__?NumericQ} | {{_?NumericQ, _?NumericQ} ..}),
		opts___?OptionQ] :=
	Module[{plotopts, ps, r, g, ar, pr, xr, yr, pts, ptpairs, cf,
		shrunk, lines, gp},
	plotopts = {FilterOptions[ListPlot, opts]} /.
		f_[PlotStyle, ps_] /; FreeQ[{ps}, PointSize[_]] :>
			f[PlotStyle, Flatten[{PointSize[DefaultPointSize], ps}]];
	plotopts = Sequence @@
		Append[plotopts, PlotStyle -> PointSize[DefaultPointSize]];
	ps = DeleteCases[PlotStyle /. {plotopts}, PointSize[_], {0, Infinity}];
	If[ps === Automatic, ps = {}];
	r = DotPlotGap /. {opts} /. Options[DotPlot];
	g = Block[{$DisplayFunction = Identity},
			ListPlot[data, PlotJoined -> False, Evaluate[plotopts]]];
	{ar, pr} = {AspectRatio, PlotRange} /. FullOptions[g];
	{xr, yr} = pr[[All, 2]] - pr[[All, 1]];
	pts = Cases[g[[1]], Point[p_] :> p, Infinity];
	If[$VersionNumber >= 6, pts = Flatten[pts, 1]]; (* Version 6 changes *)
	ptpairs = Partition[pts, 2, 1];
	cf = MakeLineGapFunction[{r, ar, xr, yr}];
	shrunk = DeleteCases[cf @@@ (Flatten /@ ptpairs), {{0.,0.}, {0.,0.}}];
	lines = Graphics[Flatten @ {ps, Line /@ shrunk}];
	gp = DeleteCases[g, (PlotRange -> _) | (AspectRatio -> _), Infinity];
	Show[gp, lines, PlotRange -> pr, AspectRatio -> ar]
    ]

(* helper function *)
MakeLineGapFunction[{r_, ar_, xr_, yr_}] :=
	Compile[{x1, y1, x2, y2},
	With[{d = Sqrt[ar^2*xr^2*(y1 - y2)^2 + (x1 - x2)^2*yr^2]/(xr*yr)},
	If[d <= 2*r,
		{{0, 0}, {0, 0}}, (* to be discarded *)
		{{(d*x1 + r*(-x1 + x2))/d, (d*y1 + r*(-y1 + y2))/d},
		 {(r*(x1 - x2) + d*x2)/d, (r*(y1 - y2) + d*y2)/d}}
		]
	]]

Options[CirclePlot] = {CirclePlotRadius -> .01,
	Jitter -> False, JitterFactor -> 1}

CirclePlot[data : ({__?NumericQ} | {{_?NumericQ, _?NumericQ} ..}),
		opts___?OptionQ] :=
	Module[{plotopts, r, g, ar, pr, xr, yr, gp, j, jfactor, jfun,
		pts2circles, pts},
	plotopts = FilterOptions[ListPlot, opts];
	r = CirclePlotRadius /. {opts} /. Options[CirclePlot];
	{j, jfactor} = {Jitter, JitterFactor} /. {opts} /. Options[CirclePlot];
	g = Block[{$DisplayFunction = Identity},
			ListPlot[data, PlotJoined -> False, plotopts]];
	{ar, pr} = {AspectRatio, PlotRange} /. AbsoluteOptions[g];
	{xr, yr} = pr[[All, 2]] - pr[[All, 1]];
	gp = DeleteCases[g, (PlotRange -> _) | (AspectRatio -> _), Infinity];
	If[TrueQ[j],
		jfun = MakeJitterFunction[{xr, yr}, jfactor],
		jfun = Identity
		];
	pts2circles = If[
		$VersionNumber >= 6, (* Version 6 changes *)
		(* then *)
		gp /. Point[pts:{{_, _}..}] :> (Circle[jfun[#], r * {xr, yr/ar}]& /@ pts),
		(* else *)
		gp /. Point[{x_, y_}] :> Circle[jfun[{x, y}], r * {xr, yr/ar}]
		];
	Show[pts2circles, PlotRange -> pr, AspectRatio -> ar]
	]

(* helper function *)
MakeJitterFunction[{xr_, yr_}, factor_:1] :=
	With[{a = xr/50, b = yr/50},
		Compile[{{pt, _Real, 1}},
		pt + factor * {Random[Real, {-a, a}], Random[Real, {-b, b}]}
		]
	]

End[]
EndPackage[]