0
$\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.

I want to plot a line from the origin to the outer layer that goes through the moving point at each moment in time.

Once I have done this I want to calculate the size of this line between the outer layer and the base cylinder.

I have found a way to do this but for large calculations it can take a very long time and I was wondering if anyone knew of any alternatives (possibly involving the lists of points without having to actually plot the lines) or ways to improve/speed up this code?

The values used 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}]]

Then, to extract the distance between the outer layer and base cylinder passing through the moving point I have used:

positionOfOuter = 
  MapThread[
   Module[{mpt = First@Cases[#2, Point[p_] :> p[[1]], All], 
      ln = Cases[#, _Line, All][[1]], ri}, 
     RegionIntersection[HalfLine[{{0, 0}, mpt}], ln][[1, 
      1]]] &, {outerLayer, movingpoint}];

positionOfBase = 
  Flatten[Table[
    Transpose[{{a Cos[i M W - pointToTrack]}, {-b Sin[
         i M W - pointToTrack]}}], {i, 0, 10}], 1];

thickness = 
  Table[EuclideanDistance[positionOfOuter[[i]], 
    positionOfBase[[i]]], {i, 1, Length[positionOfOuter]}];

ListLinePlot[thickness, ImageSize -> Large]

Any help/tips are greatly appreciated.

$\endgroup$
  • $\begingroup$ Are you sure you couldn't simplify your code to isolate the actual problem you have? $\endgroup$ – MarcoB Jan 29 at 16:29

Your Answer

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

Browse other questions tagged or ask your own question.