# Easy way to bind rect to geometrical 2D line?

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}]


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]


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!

• 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? Commented Jul 7, 2015 at 12:52
• @Guesswhoitis. yes, precisely what I want. Commented Jul 7, 2015 at 13:00
• Why not create the graphics, and then Rotate? Commented Jul 7, 2015 at 13:10
• @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 Commented Jul 7, 2015 at 13:24
• 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. Commented Jul 7, 2015 at 13:38

## 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}]


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}]


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]


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]]}] &[
]~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}}]}]]


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 = 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}]