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?

$\endgroup$
  • 1
    $\begingroup$ @C.E. the values for cVals, sVals, and solVals are given near the top of the post. $\endgroup$ – James Nov 4 '19 at 19:01
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

$\endgroup$
  • $\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 Nov 13 '19 at 14:45
  • 1
    $\begingroup$ @James, please see the new version. $\endgroup$ – kglr Nov 13 '19 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 Nov 14 '19 at 0:38
  • $\begingroup$ @James, I will update with an alternative approach to get the coordinates and lengths. $\endgroup$ – kglr Nov 14 '19 at 0:58

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.