Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
1  
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? –  Szabolcs Jan 28 '13 at 23:02

1 Answer 1

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 NDSolve`FEM` context that will reassemble the polygons back into a GraphicsComplex.

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

Needs["NDSolve`FEM`"];
Show[
 reg,
 Graphics[{Red, EdgeForm[Gray], 
   GraphicsPrimitiveToGraphicsComplex[truncate[#, 1] & /@ polys]}]
 ]

Mathematica graphics

Truncate 3D polyhedra:

Normal@PolyhedronData["Icosahedron"] /. 
 p_Polygon :> {FaceForm[Red, Blue], truncate[p, 1]}

Mathematica graphics

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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