Here I present a very simple angle-based polygon reduction algorithm as described in the chapter "A Simple Algorithm" of [David Eberly's "Polyline Reduction"][1]. The only addition is that I treat the list as cyclic since we work with closed polygon, not with an open polyline. The algorithm is vastly inefficient and has no quality control (other than visual), but demonstrates the idea. Outlining the glyph, decoding `FilledCurve`s and performing uniform sampling on each of the Bézier curves: filledCurveToBeziers[fc_FilledCurve] := MapThread[processFCdata, List @@ fc]; processFCdata[desc_, pts_] := Module[{r, sd}, r = Range @@@ Partition[Prepend[Accumulate[desc[[All, 2]]], 1], 2, 1]; BezierFunction[pts[[#]]] & /@ r]; fc = Cases[ImportString[ ExportString[Style["S", FontFamily -> "Verdana", FontWeight -> Bold], "PDF"]], _FilledCurve, -1]; beziers = filledCurveToBeziers /@ fc; sample[n_] := DeleteDuplicates[Flatten[Thread[#[Range[0, 1, 1/n]]] & /@ Flatten[beziers], 1], Equal] list = sample[3]; The implementation (as weighting function for vertex I use `π` minus vector angle at the vertex): nextPoint[list_] := Ordering[Pi - Re@VectorAngle[#2 - #1, #2 - #3] & @@@ Partition[ArrayPad[list, {{1, 1}}, "Periodic"], 3, 1], 1]; deleteOnePoint[{pointToDelete_, list_}] := With[{listNext = Delete[list, pointToDelete]}, {nextPoint[listNext], listNext}]; Pre-computing data for each frame in `Manipulate`: seq = NestList[deleteOnePoint, {nextPoint[list], list}, Length[list] - 6]; Now everything is ready for the demonstration: Manipulate[Graphics[{Text[ Row[{Dynamic[Length[list] - n], " points"}, BaseStyle -> FontSize -> 22], Scaled[{.5, .5}]], EdgeForm[{Black, Thickness[.015]}], FaceForm[None], {Red, PointSize[.04], Point[seq[[n + 1, 2]][[seq[[n + 1, 1]]]]], Polygon[seq[[n + 1, 2]]], Yellow, PointSize[.015], Point[seq[[n + 1, 2]]]}}, PlotRange -> {{0, 14}, {3, 19}}], {n, 0, Length[seq] - 1, 1, AnimationRate -> 5, Appearance -> "Open", RefreshRate -> 60}] > [![animation][2]][2] ---------- ###Update: using another weighting function### A bit of experimentation showed that much better results can be obtained with more sophisticated weighting function: nextPoint[list_] := Ordering[((Pi - Re@VectorAngle[#2 - #1, #2 - #3])* (Norm[#2 - #1] Norm[#2 - #3])/(Norm[#2 - #1] + Norm[#2 - #3])) & @@@ Partition[ArrayPad[list, {{1, 1}}, "Periodic"], 3, 1], 1]; Selecting more initial sampling points allows to get better approximation: list = sample[30]; seq = NestList[deleteOnePoint, {nextPoint[list], list}, Length[list] - 6]; Here is `Manipulate` where at the top at left shown current approximation and on the right shown initial sample: c = RegionCentroid[Polygon[list]]; Manipulate[Graphics[{Text[ Row[{Dynamic[Length[list] - n], " points"}, BaseStyle -> FontSize -> 22], Scaled[{.15, .92}]], EdgeForm[{Black, Thickness[.015]}], FaceForm[None], Red, PointSize[.04], Point[seq[[n + 1, 2]][[seq[[n + 1, 1]]]]], Polygon[seq[[n + 1, 2]]], Yellow, PointSize[.015], Point[seq[[n + 1, 2]]], EdgeForm[{Thickness[.01]}], Translate[Scale[Polygon[seq[[n + 1, 2]]], 1/20, c], {-.5, 9}], Translate[Scale[Polygon[list], 1/20, c], {.5, 9}], EdgeForm[], FaceForm[Blue], Translate[Scale[Polygon[seq[[n + 1, 2]]], 1/20, c], {-.5, 10}], Translate[Scale[Polygon[list], 1/20, c], {.5, 10}]}, PlotRange -> {{0, 14}, {3, 22}}], {{n, Length[list] - 50}, Length[list] - 70, Length[seq] - 1, 1, AnimationRate -> 5, AnimationRepetitions -> None, RefreshRate -> 60}] > [![output][3]][3] As one can see, an approximation containing only 50 points is indistinguishable from the original at the usual letter sizes. For comparison, the original Bézier curves extracted from the glyph contain 101 control points... [1]: http://www.geometrictools.com/Documentation/PolylineReduction.pdf [2]: https://i.sstatic.net/4eG1Y.gif [3]: https://i.sstatic.net/iECAq.png