6
$\begingroup$

I got stuck with the following problem. For some calculation and visualization purposes I need to draw different shapes (like rectangle) with proper slope on custom line. The trivial example:

line = Line[{{0, 0}, {1, 0}}];
hw = 0.01; (* half-width *)
hh = 0.05; (* half-height *)
Manipulate[Graphics[{line, Rectangle[{l - hw, hh}, {l + hw, -hh}]}], {l, 0, 1}]

enter image description here

But it becomes much more difficult in case of custom-shaped figures, say like:

l1 = Line[{{0, 1}, {1, 1}}]; 
cir = Circle[{1, 0}, 1, {-\[Pi]/2, \[Pi]/2}];
l2 = Line[{{0, -1}, {1, -1}}];
geom = {l1, cir, l2};

Graphics[geom]

enter image description here

Sure, there's always a straightforward way when you calculate slope and position manually, but it's time-consuming and so sombre. Is there any easier or 'automatic' way of solving such kind of tasks?

Thanks!

$\endgroup$
  • $\begingroup$ To clarify: you want the rectangle to move around your arc, such that the line through its center that is parallel to its longer sides is always normal to your arc? $\endgroup$ – J. M. is away Jul 7 '15 at 12:52
  • $\begingroup$ @Guesswhoitis. yes, precisely what I want. $\endgroup$ – funnyp0ny Jul 7 '15 at 13:00
  • $\begingroup$ Why not create the graphics, and then Rotate? $\endgroup$ – yohbs Jul 7 '15 at 13:10
  • $\begingroup$ @yohbs right, but then you have to calculate manually local curvature in each point. It's ok when you draw functions in plot (simply derivative), but when you deal with arbitrary objects you need to recalculate it manually.. I just wonder is there in Mathematica some simpler approach $\endgroup$ – funnyp0ny Jul 7 '15 at 13:24
  • $\begingroup$ I think it would be easier if you'd give a specific problem that you're trying to solve. I don't quite understand the general problem that you have. $\endgroup$ – yohbs Jul 7 '15 at 13:38
3
$\begingroup$

Motivation

In Mathematica most curves are ultimately rendered using Line, which has a straightforward derivative. Therefore it makes sense to create a function that solves the problem for the particular case of a Line object. For example

pts = Flatten[Cases[Plot[Sin[x], {x, 0, 2 Pi}], Line[pts_] :> pts, Infinity], 1];

is the list of points which make up the Line object that represents the Sin curve. So in order to draw the normal of the Sin curve you don't need to take the derivative of Sin, and the same goes for any other curve you can create with Plot, ParametricPlot etc.

Solution

markerFunction[pts_] := 
 Module[{bspline, angInterp, marker, hw = 0.01, hh = 0.1},
  bspline = BSplineFunction[MovingAverage[pts, 2], SplineDegree -> 1];
  angInterp = Interpolation[ArcTan @@@ Differences@pts];
  marker[pt_, angle_] := Rotate[Translate[Rectangle[{-hw, hh}, {hw, -hh}], pt], angle];

  Function[t, Quiet@Graphics@marker[bspline[t], angInterp[Length[pts] t]]]
  ]

Example

This example is a bit contrived since in this case the curve is not generated by for example Plot so we don't actually have a Line representation for it. But even so, all taken together, it is still a concise solution to the problem.

pts = AnglePath@Join[
    ConstantArray[{1/100, 0}, 100],
    ConstantArray[{1/100, Pi/100}, 100],
    ConstantArray[{1/100, 0}, 100]
    ];

markerf = markerFunction[pts];

Manipulate[
 Show[
  Graphics@Line@pts,
  markerf[t],
  PlotRange -> {{-0.1, 1.5}, {-0.5, 1}},
  AspectRatio -> Automatic
  ], {t, 0, 1}]

enter image description here

$\endgroup$
8
$\begingroup$

With your figure

l1 = Line[{{0, 1}, {1, 1}}];
cir = Circle[{1, 0}, 1, {-π/2, π]/2}];
l2 = Line[{{0, -1}, {1, -1}}];
geom = {l1, cir, l2};
g = Graphics[geom];

and the rectangle marker

l = 0; hw = 0.01; hh = 0.05;
marker = Rasterize@Magnify[Graphics@Rectangle[{l - hw, hh}, {l + hw, -hh}], 0.07]

one can create a binary image from the figure

bg = Binarize@g;

and for nicer visualization a rasterized version

rg = Rasterize@g;

The position of the pixels that are corresponding to the black line of the figure can be found with

pos = PixelValuePositions[bg, 0];

In the following Manipulate the position and angle of the marker gets specified by just three pixel positions

Manipulate[vectors = (# - p & /@ Nearest[pos, p, 37][[2 ;;]]);
 directionV = Subtract @@ Reverse@SortBy[vectors[[{-2, -1}]], Last]; 
 If[Norm[directionV] == 1, 
  directionV = Subtract @@ Reverse@SortBy[vectors[[{-3, -1}]], Last]];
 angles = VectorAngle[directionV, {1, 0}];
 Pane[rg, FrameMargins -> {{15, 15}, {15, 15}}],
 {angles, None}, {vectors, None}, {directionV, None}, {{p, pos[[1]]}, 
  Locator, TrackingFunction -> (p = Nearest[pos, #][[1]]; &), 
  Appearance -> Rotate[marker, angles]}, TrackedSymbols :> {p}]

GIF

Using a Manipulator to control the position and multiple points to determine the rectangle rotation:

posT = pos[[FindShortestTour[pos][[-1, ;; -2]]]];
Manipulate[
 angle = Median[
   VectorAngle[#, {1, 0}] & /@ (DeleteCases[
       Subtract @@ Reverse@SortBy[#, Last] & /@ 
        Partition[Nearest[pos, posT[[p]], 37][[2 ;;]], 2, 1],
         _?(Norm[#] == 1 &)] /. {} -> {{1, 0}})];
 LocatorPane[posT[[p]], rg, Appearance -> Rotate[marker, angle], 
  FrameMargins -> {{15, 15}, {15, 15}}, Background -> White],
 {angle, None}, {p, 1, Length@posT, 1}, TrackedSymbols :> {p}, 
 Deployed -> True]

GIF2


A version that is more stable for graphics with sharp corners

rectOnGraphics[g_Graphics] := DynamicModule[{w = 17, angles, 
   marker = Rasterize@Magnify[Graphics@Rectangle[{-0.01, 0.05}, {0.01, -0.05}], 0.07],
   rg = Rasterize@g, 
   posT = #[[FindShortestTour[#][[-1, ;; -2]]]] &[PixelValuePositions[Binarize@g, 0]]},
  angles = Function[pNr,
     Median[
      ArcCos[#[[1]]/Norm[#]] &[Subtract @@ Reverse@SortBy[#, Last]] & /@ 
       (Thread[{#[[pNr ;; pNr - 1 + w]], Reverse@#[[pNr + 1 + w ;; pNr + 2 w]]}] &[
         ArrayPad[posT, {{w}, {0}}, "Periodic"]])]
     ]~Array~Length[posT];
  Manipulate[
   Pane[rg, FrameMargins -> {{15, 15}, {15, 15}}], 
   {p, 1, Length@posT, 1, TrackingFunction -> (p = #; locator = posT[[#]]; &)}, 
   {{locator, posT[[1]]}, Locator, 
    TrackingFunction -> (p = Nearest[posT -> Automatic, #][[1]]; locator = posT[[p]]; &), 
    Appearance -> Rotate[marker, angles[[p]]]}, 
   TrackedSymbols :> {p}]]

rectOnGraphics[
 Graphics[{Circle[{0, 0}, 1, {-π/2, π/2}], Line[{{0, 1}, {1, 1}}], 
  Circle[{1, 0}, 1, {-π/2, π/2}], Line[{{0, -1}, {1, -1}}]}]]

GIF3

$\endgroup$
6
$\begingroup$

Some of this code is based on the last example of the docs on GradientOrientationFilter You can also smooth out the resulting path and reparametrize the interpolation based on the curve length to get a "constant velocity" displacement for the rectangle-

l1 = Line[{{0, 1}, {1, 1}}];
cir = Circle[{1, 0}, 1, {-π/2, π/2}];
l2 = Line[{{0, -1}, {1, -1}}];
geom = {l1, cir, l2};
g = Graphics[geom];

g = Graphics[geom];
img = Erosion[g, 1];
orientation = ImageData[GradientOrientationFilter[img, 5]];
orientation = Image@ArcTan[Sin[orientation], -Cos[orientation]];
n = 100;
nearst = Nearest[ImageValuePositions[MorphologicalPerimeter[Binarize[img, {0, .5}]], 1]]
pos = RandomChoice[ImageValuePositions[Binarize@g, 0], n];
curve = FindShortestTour[pos, Method -> "GreedyCycle"];
int = Interpolation /@ Transpose@pos[[Last@curve]];
tint[t_] := Through[int[t]]
o[t_] := ImageValue[orientation, nearst[tint[t], 1]]

Manipulate[
 ParametricPlot[tint[t], {t, 1, n}, 
  Epilog -> {Black, Thickness[Large], 
             Line[tint[t] + #*{Cos[o@t], Sin[o@t]} & /@ {-15, 15}]}], 
{t, 2, n-1}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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