Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Computer-Based Maths sorted by activeFind shaded area between two arcs
https://community.wolfram.com/groups/-/m/t/1613233
###Please download the notebook at the end of the discussion
----------
![question][1]
This is a problem posted by a TikTok user. The origional version is for middle school students, so it is safe to assume the two arcs in the problem are from two separated circles. They are tangent to each other at the left top corner of the given rectangle.
Let's extend this problem to a more general case if the longer arc is part of conic section. We can give the coordinates to some points in the picture: $(0,0)$, $(2,0)$,$(4,0)$,$(6,0)$, where the origin is at the left bottom corner.
Clear["Global`*"]
longArc[x_, y_] := x^2/a^2 + (y + h)^2/(h + 4)^2
`longArc` is the implicit form of an ellipse of which the two axes are parallel to x and y axis respectively. The center of the ellipse is said to move downward along the y axis. So the coordinate of the center of ellipse is $(0, -h)$. The semi minor axis in y direction is $b = h+4$. We denote `a` for the semi-major axis. Solve for `a` in terms of `h`:
Reduce[36/a^2+h^2/(4+h)^2==1&&h>0&&a>0,{a}]
we have
h>0&&a==(3 Sqrt[(16+8 h+h^2)/(2+h)])/Sqrt[2]
Now we can define eccentricity of the ellipse as
ecc[h_]:=With[{a=(3 Sqrt[(16+8 h+h^2)/(2+h)])/Sqrt[2]},Sqrt@Abs[a^2-(h+4)^2]/Max[a,h+4]]
in case there is a switch. Use `Manipulate` function to verify the set of valid ellipses:
Manipulate[
a = (3 Sqrt[(16 + 8 h + h^2)/(2 + h)])/Sqrt[2];
GraphicsRow@{ContourPlot[{x^2/a^2 + (y + h)^2/(h + 4)^2 == 1,
x^2 + y^2 == 16}, {x, -10, 10}, {y, -10, 10},
Epilog -> {Point[{6, 0}], Line[{{0, 4}, {6, 4}, {6, 0}}]},
Axes -> True],
Plot[ecc[t], {t, 0, 8}, PlotLabel -> "Eccentricity",
Epilog -> {PointSize[0.03], Point[{h, ecc[h]}]}]
}, {h, 0, 8}]
![ecc][2]
Note that if the eccentrity is zero (downward cusp), we have the a circle that is to be found in the original question.
##Discussion
- If `h` is negative, as the center of ellipse move upward, the ellipse will intersect with the vertical line on the right twice:
![moveup][3]
- If `h` approaches positive infinite, as the ellipse is stretched very long downward, there exists a limit:
![movedown][4]
Because `h` is very large, the eccentricity is very close to 1 according to the graph on the right side. Thus the limit of the streched ellipse is a parabola, with vertex at $(4,0)$ and facing downward. The closed form expression is:
y - 4 = -1/9 x^2
![limit][5]
Use the following plot function in the `Manipulate` function above to see the animation with three curves in one plot:
ContourPlot[
{
x^2/a^2 + (y + h)^2/(h + 4)^2 == 1,
x^2 + y^2 == 16,
9*(y - 4) == -x^2
}, {x, -10, 10}, {y, -10, 10}...]
##Find Numeric Area
`ImplicitRegion` is used in a very straight forward manner. Given `h` is 4:
Module[{h=4,a},
a=(3 Sqrt[(16+8 h+h^2)/(2+h)])/Sqrt[2];
\[ScriptCapitalR]=ImplicitRegion[x^2+y^2> 16&&x^2/a^2+(y+h)^2/(h+4)^2< 1&&x>0&&y>0,{x,y}];
DiscretizeRegion[\[ScriptCapitalR]]
]
![area][6]
Compute the area of the region by:
Area[%]
=> 4.45849
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=102041.jpg&userId=23928
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2571loop.gif&userId=23928
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1.PNG&userId=23928
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2.PNG&userId=23928
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4190loop2.gif&userId=23928
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=area.PNG&userId=23928Shenghui Yang2019-02-14T11:37:15ZWalking strandbeest dynamics
https://community.wolfram.com/groups/-/m/t/863933
Many of you have seen the strandbeest (from Dutch, meaning beach-beast). These PVC tube animals created by Theo Jansen walk along the beach and are wind powered:
![enter image description here][1]
Years ago (2009 to be more exact) I made a post on my blog about the movement of the legs, as evidenced by the still-nicely-working Mathematica notebook:
![enter image description here][2]
At the time the proportions of the legs were not known publicly so I meticulously studied frames of (low quality) YouTube videos. I made the following diagram in Illustrator of what I thought I saw:
![enter image description here][3] ![enter image description here][4]
On the left the length of the legs in red, and in blue the numbers of the joints. On the right the trajectory of the joints that I calculated at the time in Mathematica. It's funny that my blog does not exist any more (for years actually), but these images live on, as I found out when I looked for strandbeest on Google Images:
![enter image description here][5]
My images! But not on my website! Nice to see people still use it. Now, in 2016, I saw these files on my laptop, and thought: is there finally more known about them? Well yes, there is! The exact proportions are now known and there is tons and tons of videos, lectures, 3D-printable strandbeest models, interviews with Theo Jansen and other stuff! So now we can find the exact dimensions readily on the internet:
![enter image description here][6]
Notice that I (wrongly) assumed that the legs had 'feet'! oops! I was very happy to see that my lengths were not that wrong though! Let's recreate the strandbeest. We do so by first creating a function that quickly finds the intersection of two circles:
Clear[FindPoint, FindLines]
FindPoint[p1 : {x1_, y1_}, p2 : {x2_, y2_}, R_, r_, side_] := Module[{d, x, y, vc1, vc2, p, sol, sol1, sol2, s1, s2, sr},
d = N@Sqrt[(x2 - x1)^2 + (y2 - y1)^2];
x = (d^2 - r^2 + R^2)/(2 d);
y = Sqrt[R^2 - x^2];
vc1 = Normalize[{x2 - x1, y2 - y1}];
vc2 = Cross[vc1];
p = {x1, y1} + x vc1;
{sol1, sol2} = {p + y vc2, p - y vc2};
s1 = Sign[Last[Cross[Append[(p2 - p1), 0], Append[(sol1 - p1), 0]]]];
s2 = Sign[Last[Cross[Append[(p2 - p1), 0], Append[(sol2 - p1), 0]]]];
sr = If[side === Left, 1, -1];
Switch[sr, s1,
sol1
,
s2
,
sol2
]
]
This finds on the side 'side' (Left/Right) the intersection point of two circles positioned at p1 and p2, with radii R and r, respectively. And now we can easily compute all the little vertices/joints of our beast:
FindLines[\[Theta]_] := Module[{p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15},
{p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15} = FindPoints[\[Theta]];
{{p1, p2}, {p2, p3}, {p3, p4}, {p1, p4}, {p2, p6}, {p4, p6}, {p3, p5}, {p4, p5}, {p5, p8}, {p6, p8}, {p6, p7}, {p7, p8}, {p1,
p11}, {p10, p11}, {p2, p10}, {p2, p13}, {p11, p13}, {p10, p12}, {p11, p12}, {p12, p14}, {p13, p14}, {p13, p15}, {p14, p15}}
]
FindPoints[\[Theta]_] := Module[{p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16},
p1 = {0, 0};
p4 = {38, -7.8};
p11 = {-38, -7.8};
p2 = 15 {Cos[\[Theta]], Sin[\[Theta]]};
p3 = FindPoint[p2, p4, 50, 41.5, Left];
p6 = FindPoint[p2, p4, 61.9, 39.3, Right];
p5 = FindPoint[p3, p4, 55.8, 41.5, Left];
p8 = FindPoint[p5, p6, 39.4, 36.7, Left];
p7 = FindPoint[p6, p8, 49, 65.7, Right];
p10 = FindPoint[p2, p11, 50, 41.5, Right];
p13 = FindPoint[p2, p11, 61.9, 39.3, Left];
p12 = FindPoint[p10, p11, 55.8, 41.5, Right];
p14 = FindPoint[p12, p13, 39.4, 36.7, Right];
p15 = FindPoint[p13, p14, 49, 65.7, Left];
{p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15}
]
Now we can plot it easily:
trajectoriesdata = (FindPoints /@ Subdivide[0, 2 Pi, 100])\[Transpose];
Manipulate[
Graphics[{Arrowheads[Large], Arrow /@ trajectoriesdata, Thick, Red, Line[FindLines[\[Theta]]]},
PlotRange -> {{-150, 150}, {-120, 70}},
ImageSize -> 800
]
,
{\[Theta], 0, 2 \[Pi]}
]
![enter image description here][7]
We can also make an entire bunch of legs at the same time and make a 3D beast!
Manipulate[
mp = 60;
n = 12;
\[CurlyPhi] = Table[Mod[5 \[Iota], n, 1], {\[Iota], 1, n}];
Graphics3D[{Darker@Yellow, Table[
Line[
Map[Prepend[mp \[Iota]],
FindLines[\[Theta] + \[CurlyPhi][[\[Iota]]] (2 Pi/n)], {2}]],
{\[Iota], n}
]
, Black, Line[{{mp 1, 0, 0}, {mp n, 0, 0}}]
}
,
Lighting -> "Neutral",
PlotRangePadding -> Scaled[.1],
PlotRange -> {{-mp, (n + 1) mp}, {-150, 150}, {-150, 150}},
Boxed -> False,
ImageSize -> 700
]
,
{\[Theta], 0, 2 \[Pi]}
]
![enter image description here][8]
From the side we can look at how the legs of 4-pair-legged and 6-pair-legged versions of the beasts work:
![enter image description here][9] ![enter image description here][10]
Hope you enjoyed this! Perhaps someone else can make this thing actually walk over a (bumpy) surface?
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=LVDKumerus2.jpg&userId=73716
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-05-29at00.51.53.png&userId=73716
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=strandbeest_sketch.png&userId=73716
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=strandbeest_trajectories.png&userId=73716
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-05-29at00.16.23.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Strandbeest_Leg_Proportions-01.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3493strandwalk.gif&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3587strandwalk3D.gif&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=4legged.gif&userId=73716
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=6legged.gif&userId=73716Sander Huisman2016-05-28T23:02:16Z