2
$\begingroup$

I have this code which animates a layer of fluid moving on the outside of an ellipse with a moving black point on the cylinder surface itself.

Is there a way to find the value of the blue outer line that is perpendicular to the ellipse surface at the point marked by the black dot as each stage of the animation?

The values for the code are:

cVals = {1., 0.992115, 0.968583, 0.929776, 0.876307, 0.809017, 0.728969, \
0.637424, 0.535827, 0.425779, 0.309017, 0.187381, 0.0627905, \
-0.0627905, -0.187381, -0.309017, -0.425779, -0.535827, -0.637424, \
-0.728969, -0.809017, -0.876307, -0.929776, -0.968583, -0.992115, \
-1., -0.992115, -0.968583, -0.929776, -0.876307, -0.809017, \
-0.728969, -0.637424, -0.535827, -0.425779, -0.309017, -0.187381, \
-0.0627905, 0.0627905, 0.187381, 0.309017, 0.425779, 0.535827, \
0.637424, 0.728969, 0.809017, 0.876307, 0.929776, 0.968583, 0.992115, \
1.}

sVals = {0., 0.125333, 0.24869, 0.368125, 0.481754, 0.587785, 0.684547, \
0.770513, 0.844328, 0.904827, 0.951057, 0.982287, 0.998027, 0.998027, \
0.982287, 0.951057, 0.904827, 0.844328, 0.770513, 0.684547, 0.587785, \
0.481754, 0.368125, 0.24869, 0.125333, 0., -0.125333, -0.24869, \
-0.368125, -0.481754, -0.587785, -0.684547, -0.770513, -0.844328, \
-0.904827, -0.951057, -0.982287, -0.998027, -0.998027, -0.982287, \
-0.951057, -0.904827, -0.844328, -0.770513, -0.684547, -0.587785, \
-0.481754, -0.368125, -0.24869, -0.125333, 0.}

solVals  ={{0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 
  0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 
  0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 
  0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 
  0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25}, {0.231773, 0.223102, 
  0.21736, 0.215868, 0.218506, 0.223485, 0.228702, 0.232694, 0.235165,
   0.236492, 0.237221, 0.237652, 0.237877, 0.237893, 0.237705, 
  0.237319, 0.236647, 0.235359, 0.232887, 0.22882, 0.223588, 0.218861,
   0.21709, 0.220147, 0.227946, 0.23848, 0.249499, 0.259875, 0.269195,
   0.276732, 0.281316, 0.282071, 0.27928, 0.27457, 0.269977, 0.266706,
   0.264871, 0.264107, 0.264124, 0.264923, 0.266754, 0.269912, 
  0.274217, 0.278579, 0.28118, 0.280602, 0.276577, 0.269902, 0.261582,
   0.252184, 0.241939}, {0.204681, 0.197575, 0.194278, 0.195382, 
  0.200351, 0.207264, 0.214157, 0.21958, 0.22322, 0.225323, 0.226494, 
  0.22712, 0.227439, 0.227497, 0.22732, 0.226864, 0.225938, 0.224082, 
  0.220664, 0.215287, 0.208395, 0.201638, 0.197536, 0.198316, 
  0.204589, 0.215152, 0.228384, 0.24353, 0.260356, 0.278019, 0.294529,
   0.307096, 0.313128, 0.311555, 0.303816, 0.293681, 0.285306, 
  0.281068, 0.281492, 0.286386, 0.294783, 0.303971, 0.309975, 
  0.309662, 0.302287, 0.289238, 0.273117, 0.256413, 0.24085, 0.226948,
   0.214759}, {0.184551, 0.180166, 0.17929, 0.182183, 0.188291, 
  0.195837, 0.203173, 0.208999, 0.21309, 0.215591, 0.217078, 0.217883,
   0.218312, 0.218426, 0.218291, 0.217843, 0.216893, 0.21499, 
  0.211522, 0.206047, 0.198855, 0.191341, 0.185797, 0.184447, 
  0.188255, 0.196649, 0.208661, 0.224108, 0.243331, 0.266093, 
  0.290793, 0.314318, 0.332624, 0.342013, 0.34091, 0.331365, 0.319242,
   0.31188, 0.313593, 0.322555, 0.332361, 0.33635, 0.331112, 0.316815,
   0.296317, 0.273184, 0.250723, 0.230929, 0.214746, 0.201881, 
  0.191889}, {0.170798, 0.168322, 0.168874, 0.172614, 0.179096, 
  0.186693, 0.194032, 0.199914, 0.204201, 0.206938, 0.208671, 
  0.209649, 0.210204, 0.210387, 0.210306, 0.209903, 0.209037, 
  0.207303, 0.204131, 0.19904, 0.192168, 0.184658, 0.17854, 0.175899, 
  0.177817, 0.184073, 0.194152, 0.20832, 0.227447, 0.251961, 0.280949,
   0.311696, 0.340004, 0.361346, 0.372725, 0.374318, 0.370007, 
  0.36535, 0.363685, 0.363153, 0.358975, 0.347301, 0.327639, 0.302198,
   0.274711, 0.248424, 0.225697, 0.207332, 0.193424, 0.183113, 
  0.17575}, {0.160902, 0.159482, 0.160747, 0.16481, 0.171336, 
  0.178789, 0.186007, 0.191845, 0.19624, 0.199144, 0.201088, 0.202229,
   0.202918, 0.203181, 0.203164, 0.202822, 0.202077, 0.200575, 
  0.197803, 0.193252, 0.18695, 0.179833, 0.173715, 0.170516, 0.171303,
   0.175989, 0.184288, 0.196726, 0.214589, 0.239003, 0.270116, 
  0.306391, 0.344562, 0.380065, 0.408345, 0.425993, 0.431826, 
  0.426664, 0.412733, 0.392199, 0.366874, 0.338066, 0.307513, 
  0.277087, 0.248959, 0.224498, 0.204626, 0.189183, 0.177908, 
  0.169814, 0.164355}, {0.153071, 0.152184, 0.153786, 0.15795, 
  0.164411, 0.171684, 0.178768, 0.184543, 0.189019, 0.192057, 
  0.194191, 0.195485, 0.196314, 0.196663, 0.196721, 0.196446, 
  0.195826, 0.194555, 0.19218, 0.188181, 0.182521, 0.175988, 0.170226,
   0.166971, 0.167173, 0.170712, 0.177389, 0.187948, 0.204232, 
  0.228522, 0.262741, 0.306994, 0.358345, 0.41036, 0.454678, 0.483194,
   0.490829, 0.476829, 0.445276, 0.403247, 0.3586, 0.316921, 0.280894,
   0.250584, 0.225525, 0.204925, 0.188572, 0.175861, 0.16662, 
  0.160002, 0.155699}, {0.146336, 0.145722, 0.147504, 0.151691, 
  0.158072, 0.165177, 0.172145, 0.177862, 0.182408, 0.185563, 
  0.187871, 0.189313, 0.190282, 0.190726, 0.190866, 0.190661, 
  0.190157, 0.189089, 0.187068, 0.183583, 0.178576, 0.172725, 
  0.167505, 0.164413, 0.164202, 0.16668, 0.171798, 0.180763, 0.1965, 
  0.223163, 0.2647, 0.321529, 0.388324, 0.454553, 0.507844, 0.537373, 
  0.537355, 0.508407, 0.457905, 0.39735, 0.338926, 0.290564, 0.254263,
   0.227337, 0.206708, 0.190018, 0.176595, 0.165844, 0.157912, 
  0.152158, 0.148519}, {0.140236, 0.139792, 0.141697, 0.145893, 
  0.152202, 0.159163, 0.166033, 0.1717, 0.176311, 0.179571, 0.182043, 
  0.183626, 0.184738, 0.185283, 0.185513, 0.18538, 0.184979, 0.18408, 
  0.182366, 0.179362, 0.175013, 0.169879, 0.165205, 0.162181, 
  0.161369, 0.16266, 0.166476, 0.175034, 0.193067, 0.226941, 0.281132,
   0.353204, 0.433414, 0.507461, 0.560878, 0.582599, 0.568315, 
  0.52147, 0.453123, 0.378515, 0.312536, 0.263423, 0.230779, 0.208764,
   0.192438, 0.178814, 0.167391, 0.157832, 0.150658, 0.145386, 
  0.14215}, {0.134579, 0.134271, 0.136282, 0.140487, 0.146736, 
  0.153571, 0.160357, 0.165981, 0.170654, 0.174011, 0.176636, 
  0.178355, 0.179612, 0.180262, 0.18059, 0.180529, 0.180218, 0.17946, 
  0.178026, 0.1755, 0.17182, 0.167363, 0.163027, 0.159685, 0.157866, 
  0.157933, 0.161337, 0.172054, 0.197104, 0.243862, 0.313863, 
  0.399828, 0.488222, 0.562708, 0.608647, 0.616296, 0.584004, 
  0.518625, 0.43493, 0.351166, 0.283482, 0.238368, 0.211643, 0.194655,
   0.181745, 0.170138, 0.159879, 0.150961, 0.144214, 0.139232, 
  0.136289}, {0.129289, 0.129107, 0.131217, 0.135432, 0.141628, 
  0.148348, 0.155059, 0.160644, 0.165376, 0.168822, 0.171593, 
  0.173445, 0.174845, 0.175607, 0.176037, 0.176048, 0.175815, 
  0.175184, 0.17403, 0.17201, 0.169, 0.165053, 0.160646, 0.156397, 
  0.153221, 0.152504, 0.157541, 0.174609, 0.212356, 0.275618, 
  0.360744, 0.456426, 0.546918, 0.615414, 0.64825, 0.637937, 0.586016,
   0.50304, 0.407288, 0.31931, 0.254989, 0.217072, 0.196908, 0.184148,
   0.173524, 0.163011, 0.153331, 0.144732, 0.13826, 0.133498, 
  0.130815}}

To build the plot I have used:

a = 1;
b = 0.5;
M = 0.1;
W = 1;

tbl = Map[Transpose[{a cVals + a cVals #, b sVals + b sVals #}] &, 
   solVals];

outerLayer = 
  Map[ListLinePlot[#, AspectRatio -> 1, ImageSize -> Large, 
     PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}] &, tbl];

pointToTrack = 0;

movingpoint = 
  Table[ListPlot[
    Transpose[{{a Cos[i M W - pointToTrack]}, {-b Sin[
         i M W - pointToTrack]}}], AspectRatio -> 1, 
    PlotStyle -> Black, PlotMarkers -> {Automatic, Medium}, 
    PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}], {i, 0, 10}];

baseCylinder = 
  ListLinePlot[Transpose[{a cVals, b sVals}], PlotStyle -> Red, 
   Filling -> Axis, ImageSize -> Large, AspectRatio -> 1];

ListAnimate[
 MapThread[Show[#1, #2, baseCylinder] &, {outerLayer, movingpoint}]]

I want to plot the values of the blue outer line that are perpendicular to the ellipse surface at the point marked by the moving black point on a separate graph later but I am unsure how to extract the values needed for this.

Any help/tips are greatly appreciated!

Edit:

Instead of finding the value above the moving point perpendicular to the surface, is there any way to find the length of a straight line from the center of the ellipse to the outer blue line passing through the moving point?

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ @C.E. the values for cVals, sVals, and solVals are given near the top of the post. $\endgroup$
    – James
    Commented Nov 4, 2019 at 19:01

1 Answer 1

Reset to default
2
$\begingroup$

Replace the option PlotMarkers -> {Automatic, Medium} with BaseStyle -> PointSize[Large] in movinpoint. Then use

ListAnimate[MapThread[
  Module[{mpt = First@Cases[#2, Point[p_] :> p[[1]], All], 
     ln = Cases[#, _Line, All][[1]], rn, ri}, 
    Show[#1, #2, baseCylinder, 
     Epilog -> {Red, PointSize -> Large , 
       Point[rn = RegionNearest[ln, mpt]], Green, Arrowheads[Medium], 
       Arrow[{mpt, rn}], Purple, 
       ri = RegionIntersection[HalfLine[{{0, 0}, mpt}], ln], Thick, 
       Dashed, Cyan, Arrow[{{0, 0}, ri[[1, 1]]}], 
       Text[Style["●   " <> ToString[Round[ri[[1, 1]], .001]], 16, Purple], 
         {.4, 1.2}, Left],
       Text[Style["●   " <> ToString[Round[rn, .001]], 16, Red], {.4, .8}, 
         Left],
       Text[Style[Row[{"length = ", Norm[ri[[1, 1]]]}], 16, Cyan], {.4,  1.}, 
         Left]}]] &, 
     {outerLayer, movingpoint}]]

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ Thank you for your help! Do you know if there is any way to extract the values for the length and the coordinates of the purple marker on the outer layer? $\endgroup$
    – James
    Commented Nov 13, 2019 at 14:45
  • 1
    $\begingroup$ @James, please see the new version. $\endgroup$
    – kglr
    Commented Nov 13, 2019 at 15:01
  • $\begingroup$ sorry I should have been mores specific. Is there a way to extract the values for the length and the coordinates of the purple marker on the outer layer as a list of some sort so that I could use those values in separate calculations later? $\endgroup$
    – James
    Commented Nov 14, 2019 at 0:38
  • $\begingroup$ @James, I will update with an alternative approach to get the coordinates and lengths. $\endgroup$
    – kglr
    Commented Nov 14, 2019 at 0:58

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.