13
$\begingroup$

I have a polygon on which I'm applying a GeometricTransform and I want to get the coordinates of the transformed polygon. Graphics[g] works and shows it nicely, but Normal@g doesn't seem to work. What am I doing wrong?

g = GeometricTransformation[
     Polygon[{
      {-0.36551249999999996`, -0.29021463333333336`}, 
      {-0.36509784999999995`, -0.2812481916666667`}, 
      {-0.3619309499999999`, -0.2645122083333334`}, 
      {-0.3592788999999999`, -0.25668636666666667`}, 
      {-0.3520880999999999`, -0.2419782333333334`}, 
      {-0.34271569999999996`, -0.22834049999999997`}, 
      {-0.3254433499999999`, -0.209398275`}, 
      {-0.3055169`, -0.19159769999999998`}, 
      {-0.26311249999999997`,-0.15638130000000006`}, 
      {-0.24333994999999997`, -0.13744537499999998`}, 
      {-0.22632409999999997`, -0.11661089999999996`}, 
      {-0.21717969999999998`, -0.10129116666666663`}, 
      {-0.21341764999999996`, -0.09311782500000006`}, 
      {-0.16110257499999997`, 0.0714712708333333`}, 
      {-0.1087875`, 0.23606036666666666`}, 
      {-0.3035939666666666`, -0.33778329166666676`}, 
      {-0.32013196666666666`, -0.3382103666666666`}, 
      {-0.33230609999999994`, -0.33689943333333333`}, 
      {-0.3425458333333333`, -0.3340813000000001`}, 
      {-0.3508735666666666`, -0.32955116666666673`}, 
      {-0.3558780916666666`, -0.3249068666666666`}, 
      {-0.36091372499999996`, -0.3168879333333333`}, 
      {-0.3634749`, -0.3093918333333333`}, 
      {-0.365004675`, -0.3005295333333334`}, 
      {-0.36551249999999996`, -0.29021463333333336`}}
     ], 
     {{-0.14929987960875826`, -1.065591641272026`}, 
      {1.0642599291951356`, -0.14911329363618442`}
     }
   ]
$\endgroup$
4
  • $\begingroup$ I do not believe Normal will give you the coordinates, but Polygon[...][[1]] will. $\endgroup$
    – rcollyer
    Oct 2, 2012 at 18:41
  • $\begingroup$ @rcollyer he means the transformed coordinates. "When possible, Normal will perform the transformations explicitly:" $\endgroup$
    – Mr.Wizard
    Oct 2, 2012 at 18:44
  • $\begingroup$ @Mr.Wizard ah, I see it now. And, I see his problem, too. $\endgroup$
    – rcollyer
    Oct 2, 2012 at 18:47
  • 1
    $\begingroup$ @rcollyer Ohhh... you meant it looks bad in mma. Yes, that I agree with — I was bitching about it a lot in chat when I first got my laptop (which is the chat discussion I linked to). Hopefully v9 supports retina. But then, if you had it in mma, you would've seen that it had a second argument because the little red triangle didn't pop up :) $\endgroup$
    – rm -rf
    Oct 2, 2012 at 19:42

2 Answers 2

17
$\begingroup$

A bug report has been generated on this issue, but I don't believe any resources are being expended on it at the present time (note that the more user reports are received on an issue, the more likely it is that the issue will get resources). As a workaround, it is possible to hook into the internal code that is used for Graphics3D primitives. The key idea is that TransformedRegion knows how to convert 2D graphics primitives. Here are a couple examples:

TransformedRegion[Rectangle[], RotationTransform[Pi/4, {.5, .5}]]
TransformedRegion[Line[{{0,0}, {1,1}, {1,2}}], ScalingTransform[{2,3}, {1,1}]]

Parallelogram[{0.5, -0.207107}, {{-0.707107, 0.707107}, {0.707107, 0.707107}}]

Line[{{-1, -2}, {1, 1}, {1, 4}}]

So, what is needed is a way to convert objects like Rotate[Rectangle[], Pi/4] into the equivalent GeometricTransformation/TransformedRegion version. This is not as simple as it might seem because unless otherwise specified, Rotate and Scale keep some point of the body fixed. Hence the following two Graphics outputs are different:

GraphicsRow[{
    Graphics[{Rotate[Rectangle[], Pi/4]}, Axes->True, PlotRange->{{-1,1.5}, {-.5, 1.5}}],
    Graphics[{TransformedRegion[Rectangle[], RotationTransform[Pi/4]]}, Axes->True,PlotRange->{{-1,1.5}, {-.5, 1.5}}]
}]

enter image description here

The Rotate object keeps the center of the rectangle fixed, while the RotationTransform keeps the origin fixed. One needs to determine the coordinate that Rotate/Scale fix, and then feed that to the appropriate transform. The default case is to use the center of the bounding rectangle, which can be determined with the following function:

regionCenter[g_] := Mean /@ RegionBounds[g]

For example:

regionCenter[Rectangle[]]
regionCenter[Triangle[]]
regionCenter[Circle[{0,0}, {1, 2}, {0, Pi}]]

{1/2, 1/2}

{1/2, 1/2}

{0, 1}

Note that this is different from RegionCentroid! The other case that must be handled is when symbolic position specifications like Left and Bottom are used. Here is a function that converts these symbolic based position specifications into actual coordinates:

absolutePosition[g_, {h:(Left|Center|Right), v:(Top|Center|Bottom)}] := Module[
    {hrange,vrange},

    {hrange, vrange} = RegionBounds[g][[;;2]];
    {
        Replace[h, {Left->Min, Center->Mean, Right->Max}][hrange],
        Replace[v, {Bottom->Min, Center->Mean, Top->Max}][vrange]
    }
]
absolutePosition[g_, spec_]:=spec

Note that the regionCenter function is just a special case where the second argument is {Center, Center}. Here is an example:

Graphics[Triangle[], Axes->True, ImageSize->100]
absolutePosition[Triangle[], {Right, Top}]

enter image description here

{1, 1}

And yes, the fixed point of rotation with a position spec of {Right, Top} is indeed {1, 1}:

Graphics[
    {
        Red, PointSize[Large], Point[{1,1}],
        Green, Triangle[],
        Blue, Rotate[Triangle[], Pi/2, {Right, Top}]
    },
    Axes->True, PlotRange->{{0, 2}, {0, 1}}
]

enter image description here

Finally, GeometricTransformation evaluates to a form where the transform has been converted to the equivalent matrix version, but this form doesn't work in TransformedRegion:

GeometricTransformation[Rectangle[], TranslationTransform[{1,1}]]

GeometricTransformation[Rectangle[{0, 0}], {{{1, 0}, {0, 1}}, {1, 1}}]

TransformedRegion[Rectangle[], {{{1,0},{0,1}},{1,1}}]

TransformedRegion::vfunc: {{{1,0},{0,1}},{1,1}} evaluated at a list of length 2 should give a non-empty list.

TransformedRegion[Rectangle[{0, 0}], {{{1, 0}, {0, 1}}, {1, 1}}]

One must convert the matrix representation back into a transform representation:

TransformedRegion[Rectangle[], AffineTransform[{{{1,0},{0,1}},{1,1}}]]

Rectangle[{1, 1}, {2, 2}]

The internal code that I will hook into is System`Private`InternalNormal, which has a conditioned DownValues to convert 3D graphics. When that DownValues fails for 2D graphics, the new DownValues that I add will be used. Here is the complete code:

NormalizeGraphics[g_] := Internal`InheritedBlock[{System`Private`InternalNormal},
    Unprotect[System`Private`InternalNormal];
    System`Private`InternalNormal[
        gr:_Rotate|_Translate|_Scale|_GeometricTransformation,
        _
    ] := Module[{tmp = Quiet[transform2D[gr], TransformedRegion::reg]},
        tmp /; Head[tmp]=!=TransformedRegion
    ];
    Normal[g, {Rotate, Scale, Translate, GeometricTransformation}]
]

transform2D[Rotate[g_, r_, p___]] := TransformedRegion[
    g,
    RotationTransform[r, absolutePosition[g, p]]
]

transform2D[Translate[g_, t_]] := TransformedRegion[
    g,
    TranslationTransform[t]
]

transform2D[Scale[g_, s_, p___]] := TransformedRegion[
    g,
    ScalingTransform[s, absolutePosition[g, p]]
]

transform2D[GeometricTransformation[g_, tf_]] := TransformedRegion[
    g,
    tf /. Except[_TransformationRegion] :> AffineTransform[tf]
]

absolutePosition[g_] := absolutePosition[g, {Center, Center}]
absolutePosition[g_, {h:(Left|Center|Right), v:(Top|Center|Bottom)}] := Module[
    {hrange,vrange},

    {hrange, vrange} = RegionBounds[g][[;;2]];
    {
        Replace[h, {Left->Min, Center->Mean,Right->Max}][hrange],
        Replace[v,{Bottom->Min,Center->Mean,Top->Max}][vrange]
    }
]
absolutePosition[g_, spec_]:=spec

And here is an example of NormalizeGraphics in action:

g = Graphics[{
    GeometricTransformation[Circle[], TranslationTransform[{-1,1}]],
    Rotate[Rectangle[], Pi/4],
    Scale[Triangle[], {1,2}]
}]

enter image description here

normal = NormalizeGraphics @ g
normal //InputForm

enter image description here

Graphics[{Circle[{-1, 1}, 1], Polygon[{{1/2, (1 - Sqrt[2])/2}, {1/2 - 1/Sqrt[2], 1/Sqrt[2] + (1 - Sqrt[2])/2}, {1/2, Sqrt[2] + (1 - Sqrt[2])/2}, {1/2 + 1/Sqrt[2], 1/Sqrt[2] + (1 - Sqrt[2])/2}}], Triangle[{{0, -1/2}, {1, -1/2}, {0, 3/2}}]}]

Note the absence of Rotate, Scale and GeometricTransformation!

Finally, the example from the OP:

NormalizeGraphics @ Graphics[g]
% //InputForm

enter image description here

Graphics[Polygon[{{0.3638212597003222, -0.34572544753218604}, {0.35420478721328924, -0.34662116780165864}, {0.3358982454760883, -0.34574632062896415}, {0.3271631432644535, -0.34409078711013413}, {0.3104166937514485, -0.3386310850158512}, {0.2944851409139063, -0.3306899825905281}, {0.27172170451125205, -0.3151322501610421}, {0.2497785439953863, -0.29657963026179973}, {0.20592127070481253, -0.25670155991424687}, {0.18279126797050033, -0.23848202539603736}, {0.15804976120376862, -0.22347943526827302}, {0.14035992359815785, -0.2160317926667024}, {0.13108880542481546, -0.21324674749600434}, {-0.05210659373892817, -0.18211233165697607}, {-0.2353019929026718, -0.15097791581794784}, {0.4052655948346296, -0.2727349143130483}, {0.4081898037937953, -0.29027196246219794}, {0.40861048083253815, -0.3034238823286141}, {0.40713629246244065, -0.31474184134416383}, {0.40355234983267335, -0.3242802173337974}, {0.39935059755311264, -0.3302988596255873}, {0.39155750867161554, -0.3368538119611556}, {0.38395211028863324, -0.3406973360457382}, {0.3747369127095167, -0.3436469010211146}, {0.3638212597003222, -0.34572544753218604}}]]

$\endgroup$
1
  • 2
    $\begingroup$ This is really nifty. Thank you for posting it! $\endgroup$ Aug 17, 2017 at 12:23
5
$\begingroup$

I don't know why Normal does not work, but you can perform at least the transformation shown like this:

pts = {{-0.36551249999999996`, -0.29021463333333336`}, \
{-0.36509784999999995`, -0.2812481916666667`}, {-0.3619309499999999`, \
-0.2645122083333334`}, {-0.3592788999999999`, -0.25668636666666667`}, \
{-0.3520880999999999`, -0.2419782333333334`}, {-0.34271569999999996`, \
-0.22834049999999997`}, {-0.3254433499999999`, -0.209398275`}, \
{-0.3055169`, -0.19159769999999998`}, {-0.26311249999999997`, \
-0.15638130000000006`}, {-0.24333994999999997`, \
-0.13744537499999998`}, {-0.22632409999999997`, \
-0.11661089999999996`}, {-0.21717969999999998`, \
-0.10129116666666663`}, {-0.21341764999999996`, \
-0.09311782500000006`}, {-0.16110257499999997`, 
    0.0714712708333333`}, {-0.1087875`, 
    0.23606036666666666`}, {-0.3035939666666666`, \
-0.33778329166666676`}, {-0.32013196666666666`, \
-0.3382103666666666`}, {-0.33230609999999994`, \
-0.33689943333333333`}, {-0.3425458333333333`, -0.3340813000000001`}, \
{-0.3508735666666666`, -0.32955116666666673`}, {-0.3558780916666666`, \
-0.3249068666666666`}, {-0.36091372499999996`, -0.3168879333333333`}, \
{-0.3634749`, -0.3093918333333333`}, {-0.365004675`, \
-0.3005295333333334`}, {-0.36551249999999996`, -0.29021463333333336`}};

tf = AffineTransform[{{-0.14929987960875826`, -1.065591641272026`}, \
{1.0642599291951356`, -0.14911329363618442`}}];

Graphics@Polygon[tf /@ pts]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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