I have been meaning to post this code for a while now, and this is the perfect opportunity. I must admit that it is overkill for your specific needs, though.
The function listed below is called DataListPlot and it is designed to take tuples of data of the form {x, y, a1, ...} where the $a_i$ are auxiliary data fed into the formatting function which is passed in using the option PlotMarkerFunction. This gives you full control of how the data is plotted. The data passed into the PlotMarkerFunction have the following form
{datapoint, pointsize, comparisons}
where datapoint is a point in your data set, pointsize is the size of the plotted data point, and comparisons allows for comparisons between data sets. For now, ignore the last argument.
A simple example,
DataListPlot[{#, #^2} & /@ Range[0, 10],
Joined -> True,
PlotStyle -> Black,
PlotMarkerFunction -> ({If[#1[[2]] >= 20, Red, Blue], Disk[#1, Offset[#2]]} &)
]
For your data, I would use
DataListPlot[data, PlotStyle -> Directive[PointSize[Large]],
Joined -> True,
PlotMarkerFunction ->
Function[{point, size},
{If[point[[3]] == 12, Red, Black], Disk[point[[;; 2]], Offset[size]]}
],
Frame -> True
]
These are relatively simple examples. The true power of the code is that it allows comparisons between data sets. Here's some data from my research:
data = Uncompress@"1:eJyN1HsslXEYB/\
BTQunCFF2ki2qTrY0u02V5aJFKQtZmJWVSSqvzSBcdB2EYyq0JNXLpshUt1VxPxVkuFV2c\
ijg5i+VEResswtFzaGfpj9/7vn+cnXd7P3vf5/f7fb+LfY97+E8UCARBk+jHJSDopP/\
scXeT/r1Dwd8Le6PrPJ/UjgDG9DpfFgU0Px59xhODD/4nzs0q3KIISQPMs8+\
uTZWSmOvdmcMt8gF1zkxdaikhMa1deoslShZEd7uXFAJmp8ptJQ9JSD6fLeZ+\
x31AvHHyrrqIxGkj8SOWyMzQXKWAOYH1JvICElZt+59xf5WEJg/\
2XOOQRqJ28uZmluhx15gngMq+c1nqQBJG6oou7jmkgMlZCj2RHYkuG/\
UgSxi8yzux0aAG8KftNaMJ+\
iQG7S8ZhXJOXgeYfkfluClLDRgROtWKJZbvvVilsnwOaOgYYZdcMwxYPzKydVTo0jNOBwK\
D/ierRq83gMaVCb6lnQJ77HFKSmaSsdmbACss+j9uO/UNsEoUeTSaRapVlvRpMsAf+\
jqNlTVfAb0Gd6yN4Vyud4BCHTtISCKhrPtqHccQHqP7/\
h4wfqWZX4o7ieupK5zjORe4GVDh6OOQ2dcDuF4YLk5kCEWIZvYWwJAqY0NLMxLdUSlNFzm\
3pBX+/ukG3Kd7eGsKQwg3amZvA+xwVe4f9vkCaJGX25LGeeDlgO2SGVdW5SoBW+0/\
xaQzxFiZtANaT6/eIm3qAnQf6nXNHCdMGHWkjXFa86LUhL29dJivGpqKWEdAm+MXehl+\
HdOIZJt37uaVY9Fml7ilv78Dvo03zeWV4/\
T4ftfnGnE9oFLFK8eNlTHbLwySML3gtIuVMW2Ol3wYEB8ZIpFRXlrOK8d6fkWnwzRCOLTQ\
Rswnx0sOHdi5QSP62nKKxKzlHVusBkBnU+uIPb+IHPtlFx7GeEm+Jl95LwFzv+\
kktUSRKHMLLg7nXN5XgDN/\
ODT6X6LgC9ctMzvPENp2SQzLFioEJGoPXbsdybkhVC4LzCLOeD+\
iFEs9fH2jGULbLScaYl/Lc0j0W31cx6tbRLL6KJ8jJMznlNvw6hZDytd9WxKS/\
Jv8uqVNf9GDuDfUFMcGDMJ4dUtDonLK9iFqitiC+\
TJe3TLnXpksyJiEcp6CX7c8bX0QJXKjbpF19PDrlpfFXqrSTOoWedPq2HHd8gewEESL"
which in its uncompressed form is two data sets with data of the form
{hubbardU, moment, energy, converged}
To plot it I need to specify a PlotMarkerFunction of the following form
{function, "PointSize" -> int, "Global" -> ...}
as follows
DataListPlot[data,
Joined -> True,
PlotStyle -> {{Black, Dotted}, {Black, Dashed}},
PlotMarkerFunction -> {(
Module[{
x = #1[[1]], y = #[[2]], ene = #[[3]], conv = #[[4]],
size = {#2, #2}, globals = #3, color, prim
},
{color, prim} = If[
Abs[ene - Min@globals[[1]][x]] <= 10^-10,
{Darker@Red, Disk[{x, y}, Offset[size] ]},
{Darker@Blue, Rectangle[Offset[-size/Sqrt[2], {x, y}] ,
Offset[size/Sqrt[2], {x, y}] ]}
];
If[conv,
{color, prim},
{EdgeForm[{Thickness[Medium], color}], Opacity[0], White, prim}
]
]&),
"PointSize" -> 4,
"Global" -> {{1} -> 3, Method -> "ClampedInterpolation"} }
]
The comparison function is written as
"Global" -> {{independent vars} -> dependent, Method -> ... (* optional *)}
where the independent variable here has the index of 1 (hubbardU), and the dependent variable has the index of 3 (energy). It uses a method called "ClampedInterpolation" which interpolates the data, but disallows extrapolation. Inside the function, this gives me access to a function that will return a list of the values for all of the data sets for any point I pass to it, i.e.
Abs[ene - Min@globals[[1]][x]] <= 10^-10
which I compare to the current point's energy to check if it is a minimum. If it is, I color it Red and use Disk for its shape, otherwise it is a Blue square. Lastly, I use the conv variable to determine if I should hollow out the shape, or not: not converged gets hollowed out. This generates a nice plot without the fiddling that I used to have to do by hand to get it right.
BeginPackage["DataListPlot`"];
Unprotect[DataListPlot, ComparisonFunction, DLP`$PointSize, DLP`$Globals];
ClearAll[DataListPlot, ComparisonFunction, DLP`$PointSize, DLP`$Globals];
DataListPlot::usage =
"DataListPlot[lst, options] plots the data in lst where each datum in lst is of \
the form: {xi, yi, ai, ...}, and each tuple must be the same size.
If the PlotMarkerFunction option is specified, the data beyond xi and yi in each tuple \
is used to format the point. See PlotMarkerFunction for details.
DataListPlot[{lst1, lst2, ...}, options] plots each lsti using PlotMarkerFunction, if specified.";
PlotMarkerFunction::usage =
"PlotMarkerFunction is an options for DataListPlot that specifies how each data point
is to be plotted.
The function must have the form: fcn[{datapoint}, pointsize, globals].
In addition to the function itself, two sub-options are accepted \"PointSize\" and \"Global\".
\"PointSize\" defaults to 3 and it is passed to the PlotMarkerFunction when executed.
\"Global\" specifies that comparisons \
between the different data sets are to be made and that they conform to a specified functional relationship, as follows
\"Global\" -> {i ..} -> q
\"Global\" -> {{i ..} -> q .. }
\"Global\" -> { rels, Method -> methodname }
\"Global\" -> { rels, Method -> {methodname, methodOpts} }
where {i,j} -> q creates a function between a data sets ith and jth coordinates and its qth coordinate. \
These functions are accessible in order via last argument passed to the PlotMarkerFunction, and \
they return a list of all the effective q-values from the datasets. \
The Method is defined by ComparisonFunction, see it for details, and it defaults to \"ClampedInterpolation\".";
ComparisonFunction::usage =
"ComparisonFunction[comptype][dat_List,{a__}-> b_, opts] defines the methods for the \"Global\" functions available \
to PlotMarkerFunction. The built-in methods are Interpolation and \"ClampedInterpolation\".
\"ClampedInterpolation\" differs from Interpolation in that when extrapolation would be used, an Unevaluated@Sequence[] \
is returned, instead. In this way, the list returned by globals[[i]] only contains data within each datasets range.";
ComparisonFunction::typearg = "Comparison function `1` does not exist. Aborting.";
Begin["`Private`"];
(*
The function DataListPlot differs only slightly from ErrorListPlot, and
except for the modifications necessary to generalize it, DataListPlot is
essentially ErrorListPlot. The primary difference between the two is that
DataListPlot does not perform any of the data formatting that ErrorListPlot
does, and it expects its data to be rectangular in shape. The processing
required to get it into that form is up to the user. The work of transforming
the user specified Global comparison specifications into a usable function is
handled by makeMarkerFunction which is described further down.
*)
Options[DataListPlot]= Options[ListPlot]~Join~{PlotMarkerFunction-> Automatic};
DataListPlot[dat_List?MatrixQ, opts:OptionsPattern[]]:= DataListPlot[{dat}, opts]
DataListPlot[dat:{_?MatrixQ ..}, opts:OptionsPattern[]]:=
Block[{interp, plotrls, lstdat, pfcn, p, data, selfcn},
pfcn=OptionValue[PlotMarkerFunction];
pfcn = Which[
pfcn===Automatic,
makeMarkerFunction[dat, Disk[#1[[;;2]], Offset[{#2,#2}]]&],
MatchQ[pfcn, OptionsPattern[]],
makeMarkerFunction[dat, Disk[#1[[;;2]], Offset[{#2,#2}]]&, pfcn],
Head[pfcn]===List,
makeMarkerFunction[dat, Sequence@@pfcn],
True,
makeMarkerFunction[dat, pfcn]
];
plotrls =FilterRules[{opts}, Options[ListPlot]];
(* Strip all auxillary data *)
lstdat = dat /. pt:{x_?NumericQ, y_?NumericQ, ___}:> (data[N@{x,y}] = Sequence@@pt; {x,y});
p = ListPlot[lstdat, plotrls];
p[[1]] = p[[1]] /. {
g_GraphicsComplex :> markData[ g, pfcn],
l_Line :> markData[ l, pfcn],
pt_Point :> markData[pt, pfcn],
i_Inset :> markData[ i, pfcn]
};
p
]
markData[GraphicsComplex[pts_, prims_, opts___], pfcn_]:=
GraphicsComplex[pts, prims /.{
Line[l:{__Integer}] :> {Line[l], pfcn[data@pts[[#]]]& /@ l},
Line[l:{{__Integer}..}] :> {Line[l],pfcn[data@pts[[#]]]& /@ Flatten[l]},
Point[l:{__Integer}] :> {Point[l], pfcn[data@pts[[#]]]& /@ l},
Point[l:{{__Integer}..}] :> {Point[l], pfcn[data@pts[[#]]]& /@ Flatten[l]},
(l:Inset[obj_, pos_, a___]) :> {l, pfcn[data@pts[[pos]]]}
},
opts]
markData[l_Line, pfcn_] :=
{l, pfcn[data[#]]& /@ Cases[l, {_?NumericQ, _?NumericQ}, Infinity]}
markData[l_Point, pfcn_] :=
{l, pfcn[data[#]]& /@ Cases[l, {_?NumericQ, _?NumericQ}, Infinity]}
markData[l:Inset[obj_, pos_, a___], pfcn_] :=
{l, pfcn[data[pos]]}
(*
makeMarkerFunction is the consumer of the function passed to PlotMarkerFunction
and any sub-options. Essentially, it just loops over any global comparisons
specified building each ComparisonFunction as it goes, and its end product is
a pure function using the passed in function.
*)
Options[makeMarkerFunction]={"PointSize"-> 3, "Global" -> {}};
makeMarkerFunction[dat_, fcn_, opts:OptionsPattern[]]:=
Module[{ptsize, globals},
{ptsize, globals}= OptionValue[{"PointSize", "Global"}];
globals = With[{method=#[[1]], vals=#[[2]], methodOpts=#[[3;;]]},
With[{fcns = ComparisonFunction[method][dat, vals, methodOpts]},
Through[fcns[##]]&
]
]& /@ (stdform[globals]);
fcn[{##}, ptsize, globals]&
]
(*
As there are several ways to specify a global comparison function, they need
to be transformed into a standard form that can be consumed by
makeMarkerFunction. The function stdform is a simple recursive parser to do that.
*)
(*
simple parser to put Globals into std form
{{ComparisonFunctionType, {__}-> _, OptionsPattern[]} ..}
By default, if nothing is specified for the ComparisonFunctionType, Automatic is used.
*)
stdform[{rls:({__}->_).., mthd:(Method-> _):(Method->Automatic)}]:=
Thread@Which[
Length@mthd[[2]]>1,
{First@mthd[[2]],{rls},Sequence@@Rest[mthd[[2]]]},
Length@mthd[[2]]==1,
{First@mthd[[2]], {rls}},
True,
{mthd[[2]], {rls}}
]
stdform[rls:({__}->_)]:= {{Automatic,rls}}
stdform[rls:{(({__}-> _) | {{__}->_, Method->_})..}]:= If[Head[#]=!=List, {Automatic,#}, Flatten@stdform@#]&/@ rls
stdform[{}]:={}
(*
ComparisonFunction allows the user to extend the global comparison
functionality. Each ComparisonFunction takes arguments of form
ComparisonFunction[name][dat_List, {a__} -> b_, opts : OptionsPattern[]]
which it uses to construct a functional relationship between the independent
coordinates, a, and the dependent coordinate, b. An example of this extension
process is seen by "ClampedInterpolation" which uses the
ComparisonFunction[Interpolation] to operate.
*)
ClampedInterpolationFunction[a_InterpolatingFunction]:=
Quiet[Check[a[#], Unevaluated[Sequence[]]], {InterpolatingFunction::dmval}]&
ComparisonFunction["ClampedInterpolation"][a___]:= ClampedInterpolationFunction/@ ComparisonFunction[Interpolation][a];
ComparisonFunction[Interpolation][dat_List,{a__}-> b_, opts:OptionsPattern[]]:=
Interpolation[#, opts]&/@ dat[[All, All, Flatten@{a,b}]]
ComparisonFunction[Automatic][a___] := ComparisonFunction["ClampedInterpolation"][a]
ComparisonFunction[a_][___]:= (Message[ComparisonFunction::typearg ,a];Abort[])
End[]; (* Private *)
Protect[DataListPlot];
EndPackage[];
