# How can I truncate only a single vertex of a polygon?

One can truncate all the vertices of a polygon at once with Truncate. I want to do exactly that -- but only on a single vertex. Is this possible with Mathematica 9? How?

• I believe you will have to implement this from scratch. You'll need to extract the points from the Polygon expression and work with the coordinates. Have you tried doing this? If yes, where did you get stuck? Jan 28 '13 at 23:02

It isn't perfectly clear what the desired scope and outcome is. For instance, Truncate will close a hole created in a polyhedron. That's not possible, if we truncate just one vertex of one polygon. If we truncate the right ones on the right polygons, then it could be done. The code below does not handle that case. It's a rather special case and would need a special command to be programmed (exercise for the reader).

ClearAll[truncate];
Options[truncate] := {Tolerance -> 1*^-8};
truncate::nvert = "Point(s)  not sufficiently close to a vertex are ignored.";
truncate::nidcs = "Some indices in  are not between 1 and the number of vertices .";
truncate[poly : Polygon[_?MatrixQ],
v_Integer | v : List[___Integer] | All, ratio_: 3/10,
OptionsPattern[]] :=
Module[{vertices, n},
n = Length@First@poly;
If[v === All,
vertices = Range@n,
vertices = Flatten[{v}];
];
If[vertices =!= {} && ! TrueQ[1 <= Max[vertices] <= n],
Message[truncate::nidcs, vertices, n]
];
ReplacePart[poly,
Function[{vi}, {1, vi} :>
Sequence @@ ({{ratio, 1 - ratio, 0},
{0, 1 - ratio, ratio}}.RotateLeft[First@poly, vi - 2][[;; 3]])
] /@ vertices
] /; vertices === {} || TrueQ[1 <= Max[vertices] <= n]
];
truncate[poly : Polygon[_?MatrixQ],
v_?(MatrixQ[#, NumericQ] &) (* should check dimension - TBD *),
ratio_: 3/10, OptionsPattern[]] :=
With[{indices = Nearest[First@poly -> Automatic, v, {1, OptionValue[Tolerance]}]},
If[! FreeQ[indices, {}],
Message[truncate::nvert, Extract[v, Position[indices, {}]]]
];
truncate[poly, Union @@ indices, ratio]
];


Examples:

Truncate two vertices by index:

truncate[Polygon[{{1, 2}, {3, 4}, {4, -5}}], {2, 3}]
(* Polygon[{{1, 2}, {12/5, 17/5}, {33/10, 13/10}, {37/10, -(23/10)}, {31/10, -(29/10)}}] *)


Truncate by specifying a point. The code uses Nearest in case a point is sufficiently close but not an exact match. "Sufficiently close" is determined by the option Tolerance. In this

truncate[Polygon[{{1, 2}, {3, 4}, {4, -5}}], {{2, 3}, {4.000000001, -5.}}]


truncate::nvert: Point(s) {{2,3}} not sufficiently close to a vertex are ignored.

Polygon[{{1, 2}, {3, 4}, {37/10, -(23/10)}, {31/10, -(29/10)}}]


Graphics with GraphicsComplex need to be converted to normal form. This also converts compound polygon expressions to simple polygon expressions. If desired, there is a function in the NDSolveFEM context that will reassemble the polygons back into a GraphicsComplex.

reg = DiscretizeRegion[Disk[], MaxCellMeasure -> 0.2];
polys = Cases[Normal@Show@reg, _Polygon, Infinity];

Needs["NDSolveFEM"];
Show[
reg,
Graphics[{Red, EdgeForm[Gray],
GraphicsPrimitiveToGraphicsComplex[truncate[#, 1] & /@ polys]}]
] Truncate 3D polyhedra:

Normal@PolyhedronData["Icosahedron"] /.
p_Polygon :> {FaceForm[Red, Blue], truncate[p, 1]} • I had this topic on "todo" list too :P +1
– Kuba
Dec 1 '15 at 7:36