Revisions to How can we make publication-quality PlotMarkers without version 10?

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/

Source Link

edited Apr 13, 2017 at 12:56

1

Everything seems good. It may not look absolutely perfect on-screen, because graphics objects are snapped to the pixel grid 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.

adding GitHub link

Source Link

edited Jul 16, 2015 at 19:34

Oleksandr R.

23.1k
4
87
126

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

added 5121 characters in body

Source Link

edited Jun 3, 2015 at 22:29

Oleksandr R.

23.1k
4
87
126

BeginPackage["PolygonPlotMarkers`"];

ClearAll[PolygonMarker];

Begin["`Private`"];

ClearAll[centroidedAndScaled];ClearAll[ centroidAndScale];
centroidedAndScaled[coords 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] :=
  centroidedAndScaled@Table[ 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"] = {
   {26/270, 5/16Root[1296 - 4500 #1^4 + 3125 #1^8 &, 4, 0]},
   {12/61Root[1 - 900 #1^4 + 162000 #1^8 &, 3/11}, {1/3630], 93/92Root[1 - 22500 #1^4 + 4050000 #1^8 &, 4, 0]},
   {Root[81 -17/86 1800 #1^4 + 2000 #1^8 &, 4, 0], Root[81 - 9000 #1^4 + 50000 #1^8 &, 3/11, 0]},
   {Root[1 -26/27 1800 #1^4 + 162000 #1^8 &, 6/194, 0], Root[1 - 9000 #1^4 + 4050000 #1^8 &, 2, 0]},
   {Root[81 -8/25 900 #1^4 + 2000 #1^8 &, -3/29, 0], Root[81 - 22500 #1^4 + 50000 #1^8 &, 1, 0]},
   {-31/520, Root[16 -31/38 4500 #1^4 + 253125 #1^8 &, 1, 0]},
   {0Root[81 - 900 #1^4 + 2000 #1^8 &, 2, 0], Root[81 -64/191 22500 #1^4 + 50000 #1^8 &, 1, 0]},
   {28/47Root[1 - 1800 #1^4 + 162000 #1^8 &, 1, 0], Root[1 -14/17 9000 #1^4 + 4050000 #1^8 &, 2, 0]},
   {8/25Root[81 - 1800 #1^4 + 2000 #1^8 &, 1, 0], Root[81 - 9000 #1^4 + 50000 #1^8 &, 3/29, 0]},
   {26/27Root[1 - 900 #1^4 + 162000 #1^8 &, 5/162, 0], Root[1 - 22500 #1^4 + 4050000 #1^8 &, 4, 0]}
   };
coords["Hexagon"] = ngon[6, 0];
coords["SixPointedStar"] = {
   {17/260, -5Sqrt[2/133]}, {71/16,(2 0}Sqrt[6]), {171/26,(2 5/13Sqrt[2])}, {51/23Sqrt[2], 51/13Sqrt[6]},
   {01/Sqrt[6], 19/250}, {-51/23Sqrt[2], 5-(1/13Sqrt[6])}, {-171/26,(2 5/13}Sqrt[6]), {-71/16,(2 0Sqrt[2])},
   {-17/260, -5Sqrt[2/133]}, {-51/23(2 Sqrt[6]), -51/13(2 Sqrt[2])}, {0-(1/Sqrt[2]), -19(1/25Sqrt[6])},
   {5-(1/23Sqrt[6]), -5/130},
  {-(1/Sqrt[2]), 1/Sqrt[6]}, {17-1/26(2 Sqrt[6]), -51/13(2 Sqrt[2])}
   };
coords["Cross"]coords["SixfoldPinwheel"] = {
   {20/170, Root[-25 + 27 #1^4 &, 2/19, 0]},
   {20/17Root[-1 + 75 #1^4 &, 5/46}2, {3/260], 5/46Root[-1 + 675 #1^4 &, 2, 0]},
   {3/26Root[-25 + 48 #1^4 &, 57/492, 0], Root[-25 + 432 #1^4 &, 2, 0]},
   {Root[-1 + 75 #1^4 &, 2/17, 57/490], Root[-1 + 675 #1^4 &, 1, 0]},
   {Root[-25 + 48 #1^4 &, 2/17, 5/460], Root[-25 + 432 #1^4 &, 1, 0]},
   {0, Root[-34/2916 + 675 #1^4 &, 5/461, 0]}, {-34/290, Root[-2/1925 + 27 #1^4 &, 1, 0]},
   {Root[-2/171 + 75 #1^4 &, 1, 0], Root[-2/191 + 675 #1^4 &, 1, 0]},
   {Root[-2/1725 + 48 #1^4 &, 1, 0], Root[-7/625 + 432 #1^4 &, 1, 0]},
   {3/26Root[-1 + 75 #1^4 &, 1, 0], Root[-7/61 + 675 #1^4 &, 2, 0]},
   {3/26Root[-25 + 48 #1^4 &, 1, 0], Root[-25 + 432 #1^4 &, 2/19, 0]},
   {20/170, Root[-16 + 675 #1^4 &, 2/19, 0]}
   };
coords["DiagonalCross"]coords["EightPointedStar"] = {
   {35/380, Root[1 -23/30 16 #1^4 + 32 #1^8 &, 4, 0]},
   {7/45Root[1 - 2048 #1^4 + 524288 #1^8 &, 03, 0], Root[1 - 10240 #1^4 + 524288 #1^8 &, 4, 0]},
   {35/38Root[1 - 64 #1^4 + 512 #1^8 &, 13/174, 0], Root[1 - 64 #1^4 + 512 #1^8 &, 4, 0]},
   {13/17Root[1 - 10240 #1^4 + 524288 #1^8 &, 23/254, 0], Root[1 - 2048 #1^4 + 524288 #1^8 &, 3, 0]},
   {0,Root[1 5/- 16 #1^4 + 32 #1^8 &, 4, 0], 0},
   {Root[1 -13/17 10240 #1^4 + 524288 #1^8 &, 23/254, 0], Root[1 - 2048 #1^4 + 524288 #1^8 &, 2, 0]},
   {Root[1 -35/38 64 #1^4 + 512 #1^8 &, 13/174, 0], Root[1 - 64 #1^4 + 512 #1^8 &, 1, 0]},
   {Root[1 -7/45 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 -35/38 2048 #1^4 + 524288 #1^8 &, 2, 0], Root[1 -23/30 10240 #1^4 + 524288 #1^8 &, 1, 0]},
   {Root[1 -13/17 64 #1^4 + 512 #1^8 &, 1, 0], Root[1 -23/25 64 #1^4 + 512 #1^8 &, 1, 0]},
   {0Root[1 - 10240 #1^4 + 524288 #1^8 &, 1, 0], Root[1 -5/ 2048 #1^4 + 524288 #1^8 &, 2, 0]},
   {Root[1 - 16 #1^4 + 32 #1^8 &, 1, 0], 0},
   {13/17Root[1 - 10240 #1^4 + 524288 #1^8 &, 1, 0], Root[1 -23/25 2048 #1^4 + 524288 #1^8 &, 3, 0]},
   {35/38Root[1 - 64 #1^4 + 512 #1^8 &, 1, 0], Root[1 -23/30 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]NumericQ, 
   offset : {_?NumericQ, _?NumericQ} : {0, 0}] :=
  Polygon[sizePolygon@Transpose[Transpose[size coords[name]];coords[name]] + offset];
PolygonMarker[name_String, Scaled[size_?NumericQ]]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] & /@ coords[name]];centroidAndScale[coords]];

End[];

EndPackage[];

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]]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 five-pointed star 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

BeginPackage["PolygonPlotMarkers`"];

ClearAll[PolygonMarker];

Begin["`Private`"];

ClearAll[centroidedAndScaled];
centroidedAndScaled[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, phase_?NumericQ] :=
  centroidedAndScaled@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"] = {
   {26/27, 5/16}, {12/61, 3/11}, {1/363, 93/92}, {-17/86, 3/11},
   {-26/27, 6/19}, {-8/25, -3/29}, {-31/52, -31/38}, {0, -64/191},
   {28/47, -14/17}, {8/25, -3/29}, {26/27, 5/16}
   };
coords["Hexagon"] = ngon[6, 0];
coords["SixPointedStar"] = {
   {17/26, -5/13}, {7/16, 0}, {17/26, 5/13}, {5/23, 5/13},
   {0, 19/25}, {-5/23, 5/13}, {-17/26, 5/13}, {-7/16, 0},
   {-17/26, -5/13}, {-5/23, -5/13}, {0, -19/25}, {5/23, -5/13},
    {17/26, -5/13}
   };
coords["Cross"] = {
   {20/17, -2/19}, {20/17, 5/46}, {3/26, 5/46}, {3/26, 57/49},
   {-2/17, 57/49}, {-2/17, 5/46}, {-34/29, 5/46}, {-34/29, -2/19},
   {-2/17, -2/19}, {-2/17, -7/6}, {3/26, -7/6}, {3/26, -2/19},
   {20/17, -2/19}
   };
coords["DiagonalCross"] = {
   {35/38, -23/30}, {7/45, 0}, {35/38, 13/17}, {13/17, 23/25},
   {0, 5/32}, {-13/17, 23/25}, {-35/38, 13/17}, {-7/45, 0},
   {-35/38, -23/30}, {-13/17, -23/25}, {0, -5/32}, {13/17, -23/25},
   {35/38, -23/30}
   };

PolygonMarker[name_String, size_?NumericQ] :=
  Polygon[size coords[name]];
PolygonMarker[name_String, Scaled[size_?NumericQ]] :=
  Polygon[Scaled[size #, {0, 0}] & /@ coords[name]];

End[];

EndPackage[];

Graphics[{
  FaceForm[Blue], EdgeForm@Directive[Red, Thickness[0.02]],
  PolygonMarker["FivePointedStar", Scaled[0.2]]
  }, Axes -> True, PlotRange -> {{-1, 1}, {-1, 1}}
 ]

plot of five-pointed star

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[];

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

"UpTriangle" got lost somehow

Source Link

edited May 31, 2015 at 18:38

Oleksandr R.

23.1k
4
87
126

Loading

added 350 characters in body

Source Link

edited May 31, 2015 at 18:18

Oleksandr R.

23.1k
4
87
126

Loading

Source Link

created May 31, 2015 at 17:15

Oleksandr R.

23.1k
4
87
126

Loading

Stack Exchange Network

Return to Answer