Suppose that for certain reasons we are not yet using Mathematica version 10, or we have a version with buggy PlotMarkers. It is well known that the default markers are font glyphs, and as a result they are difficult to size consistently, as well as exhibiting inconsistent alignment. Because of this, they are impossible to use in figures intended for publication.

Unfortunately, it is a real nuisance to code markers using graphics primitives, because if we want to use anything apart from the built-in Disk and Rectangle, the size and alignment points have to be tediously worked out case-by-case in order to get nice-looking results. And the useful functions RegionCentroid and RegionMeasure are new in 10, so they cannot help either.

The Polygon graphics primitive seems like an ideal starting point, because we can change its FaceForm and EdgeForm to produce filled or open markers in a wide variety of different styles. But can anything be done so that we do not have to waste our time working out the vertex coordinates for arbitrary polygons, and then calculating their areas and centroids, whenever we just want to make a publication-quality figure?

Since tastes vary, any and all suggestions are welcome.

  • 1
    The question is about how to get nice results in v9 or earlier. But what problems does v10 really fix? Plot markers are still font glyphs, they are still not properly centred, they are still not properly sized with the Automatic setting (the squares look much smaller than the disks). So what does v10 fix? Edit: Ah, I see, we have to change the PlotTheme, right? But it only seems to have open markers. – Szabolcs Jul 21 '15 at 14:56
  • @Szabolcs I am not sure, to be honest. As you might have guessed, I am not using version 10 very much yet, partly due to its incredibly tedious "Formatting notebook contents" messages with non-default color profiles, and partly because I am still on Windows 2003 at home. So I wrote this question with the knowledge that something had been improved in version 10, but not really exactly what or how much. If you think the question can be improved, please feel free to edit it. – Oleksandr R. Jul 21 '15 at 18:37
up vote 62 down vote accepted

Based on Oleksandr's excellent design idea 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 PolygonMarker[shape, size] where shape is a name of built-in shape or a list of 2D coordinates describing a non-selfintersecting polygon. The size 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.

  • PolygonMarker[shape, size] returns Polygon graphics primitive which can be used in Graphics.

  • With Offset size specification the plot marker has fixed size specified in printer's points independent of the size of the plot.

  • PolygonMarkers with identical size specifications have equal areas (not counting the area taken by the edge of generated Polygon). PolygonMarker[shape, size] returns shape with area size2 in the internal coordinate system of Graphics. PolygonMarker[shape, Offset[size]] returns shape with area size2 square printer's points.

  • The centroid of polygon returned by PolygonMarker[shape, size] is always placed at {0, 0} in the internal coordinate system of Graphics.

  • PolygonMarker[shape, size, positions] where positions is a list of 2D coordinates evaluates to Translate[PolygonMarker[shape, size], positions]. It represents a collection of multiple identical copies of the shape with centroids placed at positions.


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

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 Exporting to PDF, EPS or SVG but affects on-screen rendering and Exporting 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

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

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

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?")

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

Here is an example of a plot where plotting symbols significantly overlap, I use here some of the symbols recommended by William Cleveland 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

Additional examples and explanations can be found in the following answers:



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[];
  • I updated my answer to be compatible with the additions you made in yours, and to correct the placement/shape of the stars and crosses. (Actually, I just copied your crosses.) I didn't want to apply N to my definitions, but I was worried about the performance of your stars, so I defined some slightly different ones that can be represented as Root expressions. That seemed like the best compromise between exactness and performance to me. – Oleksandr R. Jun 3 '15 at 22:34
  • 1
    Neat! A tiny suggestion: why not have the list of supported shapes be in the package itself, maybe something like $KnownMarkerShapes, or a property just like in the curated data functions. – J. M. is computer-less Jun 3 '15 at 22:45
  • 1
    This is, simply put, great. Even with v10---the dearth of plot markers can be quite restrictive. +1 this and @OleksandrR. – evanb Jun 3 '15 at 22:50
  • 4
    There seems to be a new way to convert text to outlines in version 10.x. I just discovered this the other day. Check the documentation of BoundaryDiscretizeGraphics: Show@BoundaryDiscretizeGraphics[Text["A"], _Text] – Szabolcs Jul 16 '15 at 7:24
  • 1
    @geordie Yes, please install the package first. Instructions are in the top section: "How to install the package." Then you should evaluate Needs["PolygonPlotMarkers`"] before using it. – Alexey Popkov Feb 2 at 5:41

Fortunately, Wikipedia has the answer, as long as we are content to restrict ourselves to non-intersecting closed polygons. This will probably be an acceptable limitation, given that excessively complicated plot markers tend to look slightly distracting anyway.

Because we seek an aesthetic rather than rigorously well defined result, we do not need to be mathematically precise with the way that the polygons are scaled, provided that the centroids are accurate and they all look subjectively about the same size. So, I propose to normalize them by area, and if this does not look quite right, adjustments can be made until a tasteful result is obtained.

We code it in Mathematica (please see also the GitHub repository for downloads):

BeginPackage["PolygonPlotMarkers`"];

ClearAll[PolygonMarker];

Begin["`Private`"];

ClearAll[ centroidAndScale];
 centroidAndScale[coords : {{_?NumericQ, _?NumericQ} ..}] :=
  With[{
    x = coords[[All, 1]], y = coords[[All, 2]],
    i = Range@Length[coords]
    },
   With[{
     xi = x[[i]], yi = y[[i]],
     j = Mod[i + 1, Length[coords], 1]
     },
    With[{
      xj = x[[j]], yj = y[[j]]
      },
     With[{
       area = 1/2 (xi.yj - xj.yi),
       factor = xi yj - xj yi
       },
      With[{
        centroid = 1/(6 area) {(xi + xj).factor, (yi + yj).factor}
        },
       Transpose[{x, y} - centroid]/Sqrt@Abs[area]
       ]
      ]
     ]
    ]
   ];

ClearAll[ngon];
ngon[n_Integer /; n >= 3, phase_?NumericQ] :=
   centroidAndScale@Table[
    {Sin[2 Pi k/n + phase], Cos[2 Pi k/n + phase]},
    {k, 0, n - 1}
   ];

ClearAll[coords];
coords["UpTriangle"] = ngon[3, 0];
coords["DownTriangle"] = ngon[3, Pi/3];
coords["LeftTriangle"] = ngon[3, Pi/6];
coords["RightTriangle"] = ngon[3, -Pi/6];
coords["DiagonalSquare" | "Diamond"] = ngon[4, 0];
coords["Square"] = ngon[4, Pi/4];
coords["Pentagon"] = ngon[5, 0];
coords["FivePointedStar"] = {
   {0, Root[1296 - 4500 #1^4 + 3125 #1^8 &, 4, 0]},
   {Root[1 - 900 #1^4 + 162000 #1^8 &, 3, 0], Root[1 - 22500 #1^4 + 4050000 #1^8 &, 4, 0]},
   {Root[81 - 1800 #1^4 + 2000 #1^8 &, 4, 0], Root[81 - 9000 #1^4 + 50000 #1^8 &, 3, 0]},
   {Root[1 - 1800 #1^4 + 162000 #1^8 &, 4, 0], Root[1 - 9000 #1^4 + 4050000 #1^8 &, 2, 0]},
   {Root[81 - 900 #1^4 + 2000 #1^8 &, 3, 0], Root[81 - 22500 #1^4 + 50000 #1^8 &, 1, 0]},
   {0, Root[16 - 4500 #1^4 + 253125 #1^8 &, 1, 0]},
   {Root[81 - 900 #1^4 + 2000 #1^8 &, 2, 0], Root[81 - 22500 #1^4 + 50000 #1^8 &, 1, 0]},
   {Root[1 - 1800 #1^4 + 162000 #1^8 &, 1, 0], Root[1 - 9000 #1^4 + 4050000 #1^8 &, 2, 0]},
   {Root[81 - 1800 #1^4 + 2000 #1^8 &, 1, 0], Root[81 - 9000 #1^4 + 50000 #1^8 &, 3, 0]},
   {Root[1 - 900 #1^4 + 162000 #1^8 &, 2, 0], Root[1 - 22500 #1^4 + 4050000 #1^8 &, 4, 0]}
   };
coords["Hexagon"] = ngon[6, 0];
coords["SixPointedStar"] = {
   {0, Sqrt[2/3]}, {1/(2 Sqrt[6]), 1/(2 Sqrt[2])}, {1/Sqrt[2], 1/Sqrt[6]},
   {1/Sqrt[6], 0}, {1/Sqrt[2], -(1/Sqrt[6])}, {1/(2 Sqrt[6]), -1/(2 Sqrt[2])},
   {0, -Sqrt[2/3]}, {-1/(2 Sqrt[6]), -1/(2 Sqrt[2])}, {-(1/Sqrt[2]), -(1/Sqrt[6])},
   {-(1/Sqrt[6]), 0}, {-(1/Sqrt[2]), 1/Sqrt[6]}, {-1/(2 Sqrt[6]), 1/(2 Sqrt[2])}
   };
coords["SixfoldPinwheel"] = {
   {0, Root[-25 + 27 #1^4 &, 2, 0]},
   {Root[-1 + 75 #1^4 &, 2, 0], Root[-1 + 675 #1^4 &, 2, 0]},
   {Root[-25 + 48 #1^4 &, 2, 0], Root[-25 + 432 #1^4 &, 2, 0]},
   {Root[-1 + 75 #1^4 &, 2, 0], Root[-1 + 675 #1^4 &, 1, 0]},
   {Root[-25 + 48 #1^4 &, 2, 0], Root[-25 + 432 #1^4 &, 1, 0]},
   {0, Root[-16 + 675 #1^4 &, 1, 0]}, {0, Root[-25 + 27 #1^4 &, 1, 0]},
   {Root[-1 + 75 #1^4 &, 1, 0], Root[-1 + 675 #1^4 &, 1, 0]},
   {Root[-25 + 48 #1^4 &, 1, 0], Root[-25 + 432 #1^4 &, 1, 0]},
   {Root[-1 + 75 #1^4 &, 1, 0], Root[-1 + 675 #1^4 &, 2, 0]},
   {Root[-25 + 48 #1^4 &, 1, 0], Root[-25 + 432 #1^4 &, 2, 0]},
   {0, Root[-16 + 675 #1^4 &, 2, 0]}
   };
coords["EightPointedStar"] = {
   {0, Root[1 - 16 #1^4 + 32 #1^8 &, 4, 0]},
   {Root[1 - 2048 #1^4 + 524288 #1^8 &, 3, 0], Root[1 - 10240 #1^4 + 524288 #1^8 &, 4, 0]},
   {Root[1 - 64 #1^4 + 512 #1^8 &, 4, 0], Root[1 - 64 #1^4 + 512 #1^8 &, 4, 0]},
   {Root[1 - 10240 #1^4 + 524288 #1^8 &, 4, 0], Root[1 - 2048 #1^4 + 524288 #1^8 &, 3, 0]},
   {Root[1 - 16 #1^4 + 32 #1^8 &, 4, 0], 0},
   {Root[1 - 10240 #1^4 + 524288 #1^8 &, 4, 0], Root[1 - 2048 #1^4 + 524288 #1^8 &, 2, 0]},
   {Root[1 - 64 #1^4 + 512 #1^8 &, 4, 0], Root[1 - 64 #1^4 + 512 #1^8 &, 1, 0]},
   {Root[1 - 2048 #1^4 + 524288 #1^8 &, 3, 0], Root[1 - 10240 #1^4 + 524288 #1^8 &, 1, 0]},
   {0, Root[1 - 16 #1^4 + 32 #1^8 &, 1, 0]},
   {Root[1 - 2048 #1^4 + 524288 #1^8 &, 2, 0], Root[1 - 10240 #1^4 + 524288 #1^8 &, 1, 0]},
   {Root[1 - 64 #1^4 + 512 #1^8 &, 1, 0], Root[1 - 64 #1^4 + 512 #1^8 &, 1, 0]},
   {Root[1 - 10240 #1^4 + 524288 #1^8 &, 1, 0], Root[1 - 2048 #1^4 + 524288 #1^8 &, 2, 0]},
   {Root[1 - 16 #1^4 + 32 #1^8 &, 1, 0], 0},
   {Root[1 - 10240 #1^4 + 524288 #1^8 &, 1, 0], Root[1 - 2048 #1^4 + 524288 #1^8 &, 3, 0]},
   {Root[1 - 64 #1^4 + 512 #1^8 &, 1, 0], Root[1 - 64 #1^4 + 512 #1^8 &, 4, 0]},
   {Root[1 - 2048 #1^4 + 524288 #1^8 &, 2, 0], Root[1 - 10240 #1^4 + 524288 #1^8 &, 4, 0]}
   };
coords["EightfoldPinwheel"] = {
   {0, Root[-1 + 2 #1^4 &, 2, 0]},
   {Root[-1 + 128 #1^4 &, 2, 0], Root[-1 + 128 #1^4 &, 2, 0]},
   {Root[-1 + 8 #1^4 &, 2, 0], Root[-1 + 8 #1^4 &, 2, 0]},
   {Root[-1 + 32 #1^4 &, 2, 0], 0},
   {Root[-1 + 2 #1^4 &, 2, 0], 0},
   {Root[-1 + 128 #1^4 &, 2, 0], Root[-1 + 128 #1^4 &, 1, 0]},
   {Root[-1 + 8 #1^4 &, 2, 0], Root[-1 + 8 #1^4 &, 1, 0]},
   {0, Root[-1 + 32 #1^4 &, 1, 0]},
   {0, Root[-1 + 2 #1^4 &, 1, 0]},
   {Root[-1 + 128 #1^4 &, 1, 0], Root[-1 + 128 #1^4 &, 1, 0]},
   {Root[-1 + 8 #1^4 &, 1, 0], Root[-1 + 8 #1^4 &, 1, 0]},
   {Root[-1 + 32 #1^4 &, 1, 0], 0},
   {Root[-1 + 2 #1^4 &, 1, 0], 0},
   {Root[-1 + 128 #1^4 &, 1, 0], Root[-1 + 128 #1^4 &, 2, 0]},
   {Root[-1 + 8 #1^4 &, 1, 0], Root[-1 + 8 #1^4 &, 2, 0]},
   {0, Root[-1 + 32 #1^4 &, 2, 0]}
   };
coords["Cross"] = 
  centroidAndScale@With[{a = 1/6}, 
    Join @@ NestList[#.{{0, -1}, {1, 0}} &, {{-a, 1}, {a, 1}, {a, a}}, 3]
   ];
coords["DiagonalCross"] = coords["Cross"].RotationMatrix[Pi/4];

PolygonMarker[name_String, size_?NumericQ, 
   offset : {_?NumericQ, _?NumericQ} : {0, 0}] :=
  Polygon@Transpose[Transpose[size coords[name]] + offset];
PolygonMarker[name_String, Scaled[size_?NumericQ], 
   offset : {_?NumericQ, _?NumericQ} : {0, 0}] :=
  Polygon[Scaled[size #, offset] & /@ coords[name]];
PolygonMarker[coords : {{_?NumericQ, _?NumericQ} ..}, size_?NumericQ, 
   offset : {_?NumericQ, _?NumericQ} : {0, 0}] :=
  Polygon@Transpose[Transpose[size centroidAndScale[coords]] + offset];
PolygonMarker[coords : {{_?NumericQ, _?NumericQ} ..}, 
   Scaled[size_?NumericQ], 
   offset : {_?NumericQ, _?NumericQ} : {0, 0}] :=
  Polygon[Scaled[size #, offset] & /@ centroidAndScale[coords]];

End[];

EndPackage[];

Here, the coordinates of the polygons other than the n-gons have come from the font glyphs after converting them to outlines, centroiding, and scaling.

The polygon sizes can be given either in absolute or scaled forms, and the results look okay:

Graphics[{
  FaceForm[Blue], EdgeForm@Directive[Red, Thickness[0.02]],
  PolygonMarker["DiagonalCross", Scaled[0.2], {0.5, 0.5}],
  FaceForm[Green], EdgeForm@Directive[Black, Thickness[0.02]],
  PolygonMarker["UpTriangle", Scaled[0.2], {-0.5, 0.5}],
  FaceForm[Yellow], EdgeForm@Directive[Blue, Thickness[0.02]],
  PolygonMarker["FivePointedStar", Scaled[0.2], {-0.5, -0.5}],
  FaceForm[Black], EdgeForm@Directive[Purple, Thickness[0.02]],
  PolygonMarker["SixfoldPinwheel", Scaled[0.2], {0.5, -0.5}]
  }, Axes -> True, PlotRange -> {{-1, 1}, {-1, 1}}, 
 GridLines -> {{-0.5, 0.5}, {-0.5, 0.5}}
 ]

plot of four of the polygons

Here are all of them together:

shapes = {
   "UpTriangle", "DownTriangle", "LeftTriangle",
   "RightTriangle", "Cross", "DiagonalCross",
   "Diamond", "Square", "Pentagon",
   "FivePointedStar", "Hexagon", "SixPointedStar",
   "SixfoldPinwheel", "EightPointedStar", "EightfoldPinwheel"
   };
Graphics[{
    FaceForm[Hue@Random[]], EdgeForm@Directive[Black, Thickness[0.03]],
    PolygonMarker[#, Scaled[1]]
    }, ImageSize -> 40] & /@ shapes

all named plot markers together

Let's check it as an actual plot marker:

ListPlot[
 ConstantArray[Range[5], 4] + Range[0, 6, 2],
 PlotStyle -> Black, Joined -> True,
 PlotMarkers -> {
   Graphics[{FaceForm[Red], EdgeForm[Red], 
     PolygonMarker["FivePointedStar", Scaled[0.05]]}],
   Graphics[{FaceForm[None], EdgeForm[Green], 
     PolygonMarker["UpTriangle", Scaled[0.05]]}],
   Graphics[{FaceForm[Blue], EdgeForm[Blue], 
     PolygonMarker["DiagonalSquare", Scaled[0.05]]}],
   Graphics[{FaceForm[None], EdgeForm[Black], 
     Disk[{0, 0}, Scaled[0.03]]}]
   },
 PlotRange -> {{0, 6}, All}
]

polygonal PlotMarkers used on a ListPlot

Everything seems good. It may not look absolutely perfect on-screen, because graphics objects are snapped to the pixel grid for display. But exporting the resulting plot as e.g. a PDF file will demonstrate that the placement is correct.

  • 1
    Excellent! Off-center PlotMarkers have been irking me intermittently (but reliably) . – Yves Klett May 31 '15 at 17:28
  • 2
    Notes: I implemented the shoelace method for area here, and a procedure for the centroid here. Could be useful… :) – J. M. is computer-less May 31 '15 at 17:32
  • 1
    The only downside: now I'll have to redo quite a few figures right away. – Yves Klett May 31 '15 at 17:35
  • @J.M. your formulations are considerably more elegant than mine. I suppose that's what comes of knowing where these expressions come from, rather than just copying a result from Wikipedia out of sheer frustration. – Oleksandr R. May 31 '15 at 17:40
  • 1
    @J.M. on the other hand, my formulation evaluates in about one sixth of the time for a 1 million point polygon. Of course it's open to question whether it is sensible to consider such a polygon anyway... – Oleksandr R. May 31 '15 at 17:54

Here is an alternative answer. Of course, since you answered your own question, you may not need this. But I think the following is a viable alternative that may end up looking comparable, and has additional dynamic features.

Instead of ListPlot, just use BubbleChart.

data = ConstantArray[Range[5], 4] + Range[0, 6, 2];

newData = Map[MapIndexed[Join[#2, {#, 1}] &, #] &, data];

Show[BubbleChart[newData, BubbleSizes -> {.05, .05}, 
  ChartElementFunction -> {ChartElementDataFunction["MarkerBubble", 
     "Shape" -> "Diamond", "Filled" -> False],
    ChartElementDataFunction["MarkerBubble", "Shape" -> "Square", 
     "Filled" -> True],
    ChartElementDataFunction["PolyhedronBubble", 
     "Polyhedron" -> "Octahedron"], 
    ChartElementDataFunction["MarkerBubble", "Shape" -> "CirclePlus", 
     "Filled" -> False]}],
 ListLinePlot[data]]

bubbles

This example with a lot of customizations shows that the marker alignment in BubbleChart is quite reliable when you use one of the "MarkerBubble" chart elements. The alignment can still look bad if you use bubbles that are not of the type "MarkerBubble".

Of course, the variety of shapes is more limited, but there is a special palette called Chart Element Schemes in the menu bar, which lets you choose the appearance interactively. And of course you can also design your own markers, analogously to ListPlot. I did something along those lines here.

  • Good suggestion. I hadn't considered this. Thanks. – Oleksandr R. May 31 '15 at 21:47
  • It is worth to add that we have also built-in (but undocumented) ChartElementData["PlotMarkers"] as uncovered in this answer by rcollyer. – Alexey Popkov Sep 25 '15 at 16:20
  • Thanks @AlexeyPopkov, I just looked at that answer and I like it... – Jens Sep 25 '15 at 16:37

Your Answer

 
discard

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.