Based on Oleksandr's excellent [design idea][1] here is my re-implementation of his package which offers much richer set of shapes.
----------
## How to install the package ##
The most recent version of the package can be installed from GitHub by evaluating the following:
(* Load the package code *)
package =
Import["http://raw.github.com/AlexeyPopkov/PolygonPlotMarkers/master/PolygonPlotMarkers.m", "Text"];
(* Install the package (existing file will be overwritten!) *)
Export[FileNameJoin[{$UserBaseDirectory, "Applications",
"PolygonPlotMarkers.m"}], package, "Text"];
For manual installation copy the code from the bottom of this post and save as "PolygonPlotMarkers.m" in the directory `SystemOpen[FileNameJoin[{$UserBaseDirectory, "Applications"}]]`.
----------
## Description of the package ##
> - The basic usage syntax is <code>PolygonMarker[*shape*, *size*]</code> where <code>*shape*</code> is a name of built-in shape or a list of 2D coordinates describing a non-selfintersecting polygon. The <code>*size*</code> can be given as a number or in `Scaled` or `Offset` form.
> - `PolygonMarker[All]` and `PolygonMarker[]` return the list of names of built-in shapes.
> - <code>PolygonMarker[*shape*, *size*]</code> returns `Polygon` graphics primitive which can be used in `Graphics`.
> - With `Offset` <code>*size*</code> specification the plot marker has fixed size specified in *printer's points* independent of the size of the plot.
> - `PolygonMarker`s with identical <code>*size*</code> specifications have equal areas (not counting the area taken by the **edge** of generated `Polygon`). <code>PolygonMarker[*shape*, *size*]</code> returns shape with area <code>*size*<sup>2</sup></code> in the internal coordinate system of `Graphics`. <code>PolygonMarker[*shape*, Offset\[*size*\]]</code> returns shape with area <code>*size*<sup>2</sup></code> *square printer's points*.
> - The centroid of polygon returned by <code>PolygonMarker[*shape*, *size*]</code> is always placed at `{0, 0}` in the internal coordinate system of `Graphics`.
> - <code>PolygonMarker[*shape*, *size*, *positions*]</code> where <code>*positions*</code> is a list of 2D coordinates evaluates to <code>Translate[PolygonMarker[*shape*, *size*], *positions*]</code>. It represents a collection of multiple identical copies of the shape with centroids placed at <code>*positions*</code>.
----------
## Basic examples of use ##
The complete list of built-in named shapes:
Needs["PolygonPlotMarkers`"]
allShapes = PolygonMarker[All]
Tooltip[Graphics[{FaceForm[Hue@Random[]],
EdgeForm[{Black, Thickness[0.003], JoinForm["Miter"]}], PolygonMarker[#, 1]},
ImageSize -> 30, PlotRange -> 1.5, PlotRangePadding -> 0,
ImagePadding -> 0], #] & /@ allShapes
> {"TripleCross", "Y", "UpTriangle", "UpTriangleTruncated", "DownTriangle",
> "DownTriangleTruncated", "LeftTriangle", "LeftTriangleTruncated", "RightTriangle",
> "RightTriangleTruncated", "ThreePointedStar", "Cross", "DiagonalCross", "Diamond",
> "Square", "FourPointedStar", "DiagonalFourPointedStar", "FivefoldCross", "Pentagon",
> "FivePointedStar", "FivePointedStarThick", "SixfoldCross", "Hexagon", "SixPointedStar",
> "SixPointedStarSlim", "SevenfoldCross", "SevenPointedStar", "SevenPointedStarNeat",
> "SevenPointedStarSlim", "EightfoldCross", "Disk", "H", "I", "N", "Z", "S", "Sw", "Sl"}
[![all available shapes][2]][2]
When used in conjunction with such functions as `ListPlot`, `ListLinePlot`, `ListLogPlot` etc. it is highly recommended to include **`AlignmentPoint -> {0, 0}`** option for achieving exact positioning of markers on the plot (this option with default `ImagePadding` and `ImageMargins` doesn't affect `Export`ing to PDF, EPS or SVG but [affects][3] on-screen rendering and `Export`ing to raster formats):
(* filled marker which picks up the PlotStyle automatically *)
fm[name_, size_: 7] :=
Graphics[{EdgeForm[], PolygonMarker[name, Offset[size]]}, AlignmentPoint -> {0, 0}];
SeedRandom[25] (* for reproducibility *)
ListPlot[
Table[Accumulate@RandomReal[1, 10] + i, {i, 6}],
PlotMarkers ->
fm /@ {"Triangle", "LeftTriangle", "Diamond", "ThreePointedStar", "UpTriangleTruncated",
"Square"},
Joined -> True, PlotStyle -> ColorData[54, "ColorList"]]
> [![plot][4]][3]
Automatic plot legends (*Mathematica* 10 or higher) often require larger value for `LegendMarkerSize` option in order to avoid cropping:
(* empty marker which picks up the PlotStyle automatically,
see https://mathematica.stackexchange.com/a/158221/280 *)
em[name_, size_: 7] :=
Graphics[{Dynamic@
EdgeForm@Directive[CurrentValue["Color"], JoinForm["Round"], AbsoluteThickness[2],
Opacity[1]], FaceForm[White], PolygonMarker[name, Offset[size]]},
AlignmentPoint -> {0, 0}]
SeedRandom[2]
ListPlot[
Table[Accumulate@RandomReal[1, 10] + i, {i, 3}],
PlotMarkers -> em /@ {"Triangle", "Square", "Diamond"},
Joined -> True, PlotLegends -> PointLegend[Automatic, LegendMarkerSize -> {40, 25}]
]
> [![plot][5]][4]
## Advanced usage ##
The third argument of `PolygonMarker` can be used to specify the coordinate(s) where the shape should be placed:
Graphics[{FaceForm[], EdgeForm[{Black, AbsoluteThickness[1], JoinForm["Miter"]}],
PolygonMarker["Circle", Offset[7], RandomReal[{-1, 1}, {20, 2}]],
PolygonMarker["ThreePointedStar", Offset[7], RandomReal[{-1, 1}, {20, 2}]],
PolygonMarker["FourPointedStar", Offset[7], RandomReal[{-1, 1}, {20, 2}]],
PolygonMarker["FivePointedStar", Offset[7], RandomReal[{-1, 1}, {20, 2}]]},
AspectRatio -> 1/2]
> [![plot][6]][3]
The package allows to use arbitrary polygon as a plot marker. Here is an auxiliary function which converts simple glyph into a set of points suitable for `PolygonMarker`:
pts[l_String] :=
First@Cases[
ImportString[
ExportString[Style[l, FontFamily -> "Verdana", FontSize -> 20],
"PDF"], "PDF"], c_FilledCurve :> c[[2, 1]], Infinity];
(This conversion is approximate. If precise conversion is needed one can apply one of the methods described in "[How can I adaptively simplify a curved shape?][7]")
An example of use:
ListPlot[ConstantArray[Range[5], 7] + Range[0, 12, 2],
PlotStyle -> Gray, Joined -> True, PlotMarkers -> {
Graphics[{FaceForm[LightBlue], EdgeForm[Black],
PolygonMarker[pts["U"], Scaled[0.05]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[LightBlue], EdgeForm[Black],
PolygonMarker[pts["S"], Scaled[0.05]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Red], EdgeForm[Black],
PolygonMarker["FivePointedStar", Scaled[0.05]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Yellow], EdgeForm[Black],
PolygonMarker["FourPointedStar", Scaled[0.05]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Green], EdgeForm[Black],
PolygonMarker["DownTriangle", Scaled[0.05]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Brown], EdgeForm[Black],
PolygonMarker["DiagonalSquare", Scaled[0.05]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Blue], EdgeForm[Black],
Disk[{0, 0}, Scaled[0.05/Sqrt[π]]]}, AlignmentPoint -> {0, 0}]},
PlotRange -> {{0, 6}, {0, 18}}]
> [![plot][8]][7]
Here is an example of a plot where plotting symbols significantly overlap, I use here some of the symbols [recommended][9] by [William Cleveland][10] in his early works:
SeedRandom[11] (* for reproducibility *)
ListPlot[RandomReal[{-1, 1}, {6, 20, 2}], PlotMarkers -> {
Graphics[{FaceForm[None], EdgeForm[{Black, Thickness[.008]}],
Disk[{0, 0}, Scaled[0.03/Sqrt[π]]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[None], EdgeForm[{Black, Thickness[.008]}],
PolygonMarker["UpTriangle", Scaled[0.03]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Black], EdgeForm[None],
PolygonMarker["Cross", Scaled[0.03]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Black], EdgeForm[None],
PolygonMarker[pts["U"], Scaled[0.03]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Black], EdgeForm[None],
PolygonMarker["Sl", Scaled[0.03]]}, AlignmentPoint -> {0, 0}],
Graphics[{FaceForm[Black], EdgeForm[None],
PolygonMarker[pts["W"], Scaled[0.03]]}, AlignmentPoint -> {0, 0}]},
Frame -> True, Axes -> False, PlotRangePadding -> Scaled[.1]]
> [![plot][11]][10]
Additional examples and explanations can be found in the following answers:
- [Plot markers where the boundary has the same hue as the body but is darker][15]
- [Perfect vertical alignment of `PointLegend` markers and their labels][12]
- [Making antisymmetric curvilinear marker "S"][13]
- [How to specify `PlotMarkers` that scale when graphic is resized?][14]
----------
----------
The code of the package
-----------------------
BeginPackage["PolygonPlotMarkers`"];
ClearAll[PolygonMarker];
PolygonMarker::usage =
"\!\(\*RowBox[{\"PolygonMarker\", \"[\", RowBox[{StyleBox[\"shape\", \"TI\"], \",\", \
StyleBox[\"size\", \"TI\"]}], \"]\"}]\) returns Polygon of \!\(\*StyleBox[\"shape\", \"TI\
\"]\) with centroid at {0,0} and area \!\(\*SuperscriptBox[StyleBox[\"size\", \"TI\"], \
StyleBox[\"2\", \"TR\"]]\).";
SyntaxInformation[PolygonMarker] = {"ArgumentsPattern" -> {_, _., _.}};
Begin["`Private`"];
ClearAll[PolygonArea, PolygonCentroid, LineIntersectionPoint, ngon, nstar, ncross, scale, coords];
(* The shoelace method for computing the area of polygon
https://mathematica.stackexchange.com/a/22587/280 *)
PolygonArea[pts_?MatrixQ] :=
Abs@Total[Det /@ Partition[pts, 2, 1, 1]]/2;
(* https://mathematica.stackexchange.com/a/7715/280 *)
PolygonCentroid[pts_?MatrixQ] :=
With[{dif = Map[Det, Partition[pts, 2, 1, {1, 1}]]},
ListConvolve[{{1, 1}},
Transpose[pts], {-1, -1}].dif/(3 Total[dif])];
(* https://mathematica.stackexchange.com/a/51399/280 *)
LineIntersectionPoint[{a_, b_}, {c_, d_}] :=
(Det[{a, b}] (c - d) - Det[{c, d}] (a - b))/Det[{a - b, c - d}];
ngon[n_, phase_: 0] :=
Table[{0, 1}.RotationMatrix[2 k Pi/n + phase], {k, 0, n - 1}];
(*
nn - number of vertices in related polygram
step - step at which vertices in the polygram are connected
n - number of points in the final star
an illustration:
http://en.wikipedia.org/wiki/Star_polygon#Simple_isotoxal_star_polygons
*)
nstar[n_ /; n >= 5, phase_: 0] := nstar[n, 2, n, phase];
nstar[nn_, step_, n_, phase_: 0] /;
Divisible[nn, n] && nn/2 > step > nn/n :=
Module[{a1, a2, b1, b2, ab},
{a1, a2, b1, b2} = ngon[nn][[{1, 1 + step, 1 + nn/n, nn/n - step}]];
ab = LineIntersectionPoint[{a1, a2}, {b1, b2}];
Flatten[
Table[{a1, ab}.RotationMatrix[2 k Pi/n + phase], {k, 0, n - 1}],
1]];
(* a - semiwidths of the crossing stripes *)
ncross[n_, phase_: 0, a_: 1/10] :=
Flatten[NestList[#.RotationMatrix[2 Pi/n] &, {{-a, 1}, {a, 1}, {a,
a Cot[Pi/n]}}.RotationMatrix[phase], n - 1], 1];
(* Unitizes the area of the polygon *)
scale[coords_] := Chop[#/Sqrt@PolygonArea@#] &@N[coords, {18, 18}];
coords["UpTriangle" | "Triangle"] = ngon[3] // scale;
coords["DownTriangle"] = ngon[3, Pi/3] // scale;
coords["LeftTriangle"] = ngon[3, Pi/6] // scale;
coords["RightTriangle"] = ngon[3, -Pi/6] // scale;
coords["ThreePointedStar"] = nstar[12, 5, 3] // scale;
coords["DiagonalSquare" | "Diamond"] = ngon[4, 0] // scale;
coords["Square"] = ngon[4, Pi/4] // scale;
coords["FourPointedStar"] = nstar[8, 3, 4] // scale;
coords["DiagonalFourPointedStar"] = nstar[8, 3, 4, Pi/4] // scale;
coords["Pentagon"] = ngon[5] // scale;
coords["FivePointedStar"] = nstar[5] // scale;
coords["FivePointedStarThick"] = nstar[20, 7, 5] // scale;
coords["Hexagon"] = ngon[6] // scale;
coords["SixPointedStar"] = nstar[6] // scale;
coords["SixPointedStarSlim"] = nstar[12, 5, 6] // scale;
coords["SevenPointedStar"] = nstar[7] // scale;
coords["SevenPointedStarNeat"] = nstar[14, 5, 7] // scale;
coords["SevenPointedStarSlim"] = nstar[14, 6, 7] // scale;
coords["Cross" | "+"] = ncross[4] // scale;
coords["DiagonalCross" | "X" | "x"] = ncross[4, Pi/4] // scale;
coords["TripleCross" | "TripleCrossUp"] = ncross[3] // scale;
coords["TripleCrossDown" | "Y" | "y"] = ncross[3, Pi/3] // scale;
coords["FivefoldCross"] = ncross[5] // scale;
coords["SixfoldCross"] = ncross[6] // scale;
coords["SevenfoldCross"] = ncross[7] // scale;
coords["EightfoldCross"] = ncross[8] // scale;
(* The truncated triangle shape originates from the Cross's Theorem
http://demonstrations.wolfram.com/CrosssTheorem/ *)
coords["UpTriangleTruncated" | "TriangleTruncated" | "TruncatedTriangle"] =
Flatten[{{-3, 6 + Sqrt[3]}, {3, 6 + Sqrt[3]}}.RotationMatrix[# Pi/3] & /@
{0, 2, 4}, 1] // scale;
coords["DownTriangleTruncated"] =
coords["UpTriangleTruncated"].ReflectionMatrix[{0, 1}];
coords["LeftTriangleTruncated"] =
coords["UpTriangleTruncated"].RotationMatrix[Pi/6];
coords["RightTriangleTruncated"] =
coords["UpTriangleTruncated"].RotationMatrix[-Pi/6];
(* Circle approximated by 24-gon *)
coords["Circle" | "Disk"] = ngon[24] // scale;
(* Plotting symbols recommended in [Cleveland W.S. The Elements of Graphing Data (1985)] *)
(* Symmetric symbol "H" *)
coords["H"] =
Join[#, -#] &@Join[#, Reverse@#.{{1, 0}, {0, -1}}] &@{{333, 108}, {333, 630}, {585, 630}} // scale;
(* Symmetric symbol "I" *)
coords["I"] =
Join[#, -#] &@{{-20, -68}, {-64, -68}, {-64, -104}, {64, -104}, {64, -68}, {20, -68}} // scale;
(* Antisymmetric symbol "N" *)
coords["N"] = Join[#, -#] &@{{18, -32}, {30, -32}, {30, 32}, {17, 32}, {17, -12}} // scale;
(* Antisymmetric symbol "Z" *)
coords["Z"] = Join[#, -#] &@{{-567, -432}, {-567, -630}, {567, -630}, {567, -414}, {-234, -414}} // scale;
(* Antisymmetric symbol "S" (simple) *)
coords["S"] =
Join[#, -#] &@{{-176, -54}, {116, -54}, {167, -100}, {167, -170}, {116, -216}, {-284, -216},
{-284, -324}, {176, -324}, {293, -216}, {293, -54}} // scale;
(* Antisymmetric symbol "S" (curved, long) *)
coords["LongS"|"SLong"|"Sl"] = Join[#, -#] &@ {{-49/16, -3/11}, {-425/91, 23/28}, {-141/26, 31/12},
{-165/32, 88/19}, {-167/45, 106/17}, {-24/17, 149/21}, {121/69, 233/33}, {130/27, 31/5},
{130/27, 118/29}, {127/47, 199/39}, {7/20, 233/42}, {-12/7, 139/26}, {-65/21, 139/31},
{-395/113, 114/35}, {-157/52, 77/39}, {-83/44, 56/41}, {9/22, 39/43}} // scale;
(* Antisymmetric symbol "S" curved, wide *)
coords["WideS" | "SWide" | "Sw"] =
Join[#, -#] &@{{80/11, -3/5}, {49/6, -9/4}, {97/12, -41/11}, {39/5, -35/8}, {88/13, -65/12},
{51/10, -49/8}, {2, -13/2}, {-20/11, -13/2}, {-37/8, -81/13}, {-81/13, - 40/7},
{-59/8, -54/11}, {-81/10, -26/7}, {-70/11, -29/9}, {-57/11, -46/11}, {-11/4, -33/7},
{11/7, -19/4}, {16/3, -37/9}, {31/5, -38/11}, {32/5, -38/13}, {37/6, -49/24}, {61/13, -6/5},
{23/7, -13/14}, {-25/9, -4/5}, {-23/4, -3/13}} // scale;
PolygonMarker[name_String, size_?NumericQ] :=
Polygon[size coords[name]];
PolygonMarker[name_String, (h : Scaled | Offset)[size_?NumericQ]] :=
Polygon[h[size #, {0, 0}] & /@ coords[name]];
PolygonMarker[coords : {{_?NumericQ, _?NumericQ} ..},
size_?NumericQ] :=
Polygon[size N[
scale[Transpose[
Transpose[coords] - PolygonCentroid[coords]]], {16, 16}]];
PolygonMarker[coords : {{_?NumericQ, _?NumericQ} ..},
Scaled[size_?NumericQ]] :=
Polygon[Scaled[size #, {0, 0}] & /@
N[scale[Transpose[
Transpose[coords] - PolygonCentroid[coords]]], {16, 16}]];
PolygonMarker[arg : _String | {{_?NumericQ, _?NumericQ} ..},
size : _?NumericQ | (Scaled | Offset)[_?NumericQ],
positions : {_?NumericQ, _?NumericQ} | {{_?NumericQ, _?NumericQ} ..}] :=
Translate[PolygonMarker[arg, size], positions];
(* The list of all available shapes *)
PolygonMarker[] =
PolygonMarker[All] = {"TripleCross", "Y", "UpTriangle",
"UpTriangleTruncated", "DownTriangle", "DownTriangleTruncated",
"LeftTriangle", "LeftTriangleTruncated", "RightTriangle",
"RightTriangleTruncated", "ThreePointedStar", "Cross",
"DiagonalCross", "Diamond", "Square", "FourPointedStar", "DiagonalFourPointedStar",
"FivefoldCross", "Pentagon", "FivePointedStar",
"FivePointedStarThick", "SixfoldCross", "Hexagon",
"SixPointedStar", "SixPointedStarSlim", "SevenfoldCross",
"SevenPointedStar", "SevenPointedStarNeat", "SevenPointedStarSlim",
"EightfoldCross", "Disk", "H", "I", "N", "Z", "S", "Sw", "Sl"};
(* A subset of plot markers suitable for use when plotting symbols on the plot
significantly overlap. *)
PolygonMarker["Overlap"] = {"TripleCross", "Y", "UpTriangle", "DownTriangle",
"LeftTriangle", "RightTriangle", "ThreePointedStar", "Cross", "DiagonalCross",
"Diamond", "Square", "FourPointedStar", "DiagonalFourPointedStar", "FivefoldCross",
"FivePointedStar", "FivePointedStarThick", "Disk", "H", "I", "N", "Z", "S", "Sl"};
End[];
EndPackage[];
[1]: https://mathematica.stackexchange.com/a/84858/280
[2]: https://i.sstatic.net/r7g9I.png
[3]: https://mathematica.stackexchange.com/q/137884/280
[4]: https://i.sstatic.net/1KKlH.png
[5]: https://i.sstatic.net/nZXgt.png
[6]: https://i.sstatic.net/QGBjB.png
[7]: https://mathematica.stackexchange.com/q/137937/280
[8]: https://i.sstatic.net/eZ6a2.png
[9]: https://graphicdesign.stackexchange.com/q/36908/946
[10]: http://www.stat.purdue.edu/~wsc/
[11]: https://i.sstatic.net/pH9P8.png
[12]: https://mathematica.stackexchange.com/a/137758/280
[13]: https://mathematica.stackexchange.com/a/138348/280
[14]: https://mathematica.stackexchange.com/a/145891/280
[15]: https://mathematica.stackexchange.com/a/158221/280