Animating wave motion in water












19












$begingroup$


Further to this question I found on MSE, I tried to replicate



enter image description here



from here



this is as far as I got:



fun[a_, b_, c_, x_, y_] := 
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
tab = With[{a = #},
Flatten[Table[
Table[fun[a, 90 + 15 n, 1 - .15 m, -1 + .5 n, -.35 m], {m, 0,
10}], {n, 0, 24}], 1]] & /@ Range[1, 360, 15];

Module[{t, x, y, fun, xf, yf, a}, x = -.5; y = 1;
fun[a_, b_, c_, x_, y_] :=
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
xf[t_, a_, b_] := a t - b Sin[t]; yf[t_, a_, b_] := a - b Cos[t];
Animate[
Show[
Graphics[
{PointSize[.01], tab[[a]]},
PlotRange -> {{-1 - x, 10 + x}, {-1 - y, 1}}
],
ParametricPlot[
{(Pi/2) xf[t + 2 Pi a/24, 1.25, .6] - 4 Pi a/24 - Pi^2 + .05,
2.05 - 1.65 yf[t + 2 Pi a/24, 1.25, .6]},
{t, -4 Pi, 4 Pi}, Axes -> False
]
],
{a, 1, 24, 1}, ControlPlacement -> Top, AnimationRate -> 5,
AnimationDirection -> Backward
]
]


which is not very efficient (I'm sure Part could be applied more efficiently), and despite various tweeks, I couldn't quite manage to get the cycloid to line up with the points.



What is a better way to approach this?










share|improve this question











$endgroup$












  • $begingroup$
    See this: mathematica.stackexchange.com/questions/123127/…
    $endgroup$
    – LCarvalho
    2 days ago
















19












$begingroup$


Further to this question I found on MSE, I tried to replicate



enter image description here



from here



this is as far as I got:



fun[a_, b_, c_, x_, y_] := 
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
tab = With[{a = #},
Flatten[Table[
Table[fun[a, 90 + 15 n, 1 - .15 m, -1 + .5 n, -.35 m], {m, 0,
10}], {n, 0, 24}], 1]] & /@ Range[1, 360, 15];

Module[{t, x, y, fun, xf, yf, a}, x = -.5; y = 1;
fun[a_, b_, c_, x_, y_] :=
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
xf[t_, a_, b_] := a t - b Sin[t]; yf[t_, a_, b_] := a - b Cos[t];
Animate[
Show[
Graphics[
{PointSize[.01], tab[[a]]},
PlotRange -> {{-1 - x, 10 + x}, {-1 - y, 1}}
],
ParametricPlot[
{(Pi/2) xf[t + 2 Pi a/24, 1.25, .6] - 4 Pi a/24 - Pi^2 + .05,
2.05 - 1.65 yf[t + 2 Pi a/24, 1.25, .6]},
{t, -4 Pi, 4 Pi}, Axes -> False
]
],
{a, 1, 24, 1}, ControlPlacement -> Top, AnimationRate -> 5,
AnimationDirection -> Backward
]
]


which is not very efficient (I'm sure Part could be applied more efficiently), and despite various tweeks, I couldn't quite manage to get the cycloid to line up with the points.



What is a better way to approach this?










share|improve this question











$endgroup$












  • $begingroup$
    See this: mathematica.stackexchange.com/questions/123127/…
    $endgroup$
    – LCarvalho
    2 days ago














19












19








19


8



$begingroup$


Further to this question I found on MSE, I tried to replicate



enter image description here



from here



this is as far as I got:



fun[a_, b_, c_, x_, y_] := 
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
tab = With[{a = #},
Flatten[Table[
Table[fun[a, 90 + 15 n, 1 - .15 m, -1 + .5 n, -.35 m], {m, 0,
10}], {n, 0, 24}], 1]] & /@ Range[1, 360, 15];

Module[{t, x, y, fun, xf, yf, a}, x = -.5; y = 1;
fun[a_, b_, c_, x_, y_] :=
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
xf[t_, a_, b_] := a t - b Sin[t]; yf[t_, a_, b_] := a - b Cos[t];
Animate[
Show[
Graphics[
{PointSize[.01], tab[[a]]},
PlotRange -> {{-1 - x, 10 + x}, {-1 - y, 1}}
],
ParametricPlot[
{(Pi/2) xf[t + 2 Pi a/24, 1.25, .6] - 4 Pi a/24 - Pi^2 + .05,
2.05 - 1.65 yf[t + 2 Pi a/24, 1.25, .6]},
{t, -4 Pi, 4 Pi}, Axes -> False
]
],
{a, 1, 24, 1}, ControlPlacement -> Top, AnimationRate -> 5,
AnimationDirection -> Backward
]
]


which is not very efficient (I'm sure Part could be applied more efficiently), and despite various tweeks, I couldn't quite manage to get the cycloid to line up with the points.



What is a better way to approach this?










share|improve this question











$endgroup$




Further to this question I found on MSE, I tried to replicate



enter image description here



from here



this is as far as I got:



fun[a_, b_, c_, x_, y_] := 
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
tab = With[{a = #},
Flatten[Table[
Table[fun[a, 90 + 15 n, 1 - .15 m, -1 + .5 n, -.35 m], {m, 0,
10}], {n, 0, 24}], 1]] & /@ Range[1, 360, 15];

Module[{t, x, y, fun, xf, yf, a}, x = -.5; y = 1;
fun[a_, b_, c_, x_, y_] :=
Point[{#[[1]] + x, #[[2]] + y} &[
Part[CirclePoints[360] c,
If[a + b == 360, 360, Mod[a + b, 360]]]]];
xf[t_, a_, b_] := a t - b Sin[t]; yf[t_, a_, b_] := a - b Cos[t];
Animate[
Show[
Graphics[
{PointSize[.01], tab[[a]]},
PlotRange -> {{-1 - x, 10 + x}, {-1 - y, 1}}
],
ParametricPlot[
{(Pi/2) xf[t + 2 Pi a/24, 1.25, .6] - 4 Pi a/24 - Pi^2 + .05,
2.05 - 1.65 yf[t + 2 Pi a/24, 1.25, .6]},
{t, -4 Pi, 4 Pi}, Axes -> False
]
],
{a, 1, 24, 1}, ControlPlacement -> Top, AnimationRate -> 5,
AnimationDirection -> Backward
]
]


which is not very efficient (I'm sure Part could be applied more efficiently), and despite various tweeks, I couldn't quite manage to get the cycloid to line up with the points.



What is a better way to approach this?







performance-tuning animation






share|improve this question















share|improve this question













share|improve this question




share|improve this question








edited 2 days ago









Kuba

107k12210530




107k12210530










asked 2 days ago









martinmartin

4,01821249




4,01821249












  • $begingroup$
    See this: mathematica.stackexchange.com/questions/123127/…
    $endgroup$
    – LCarvalho
    2 days ago


















  • $begingroup$
    See this: mathematica.stackexchange.com/questions/123127/…
    $endgroup$
    – LCarvalho
    2 days ago
















$begingroup$
See this: mathematica.stackexchange.com/questions/123127/…
$endgroup$
– LCarvalho
2 days ago




$begingroup$
See this: mathematica.stackexchange.com/questions/123127/…
$endgroup$
– LCarvalho
2 days ago










1 Answer
1






active

oldest

votes


















27












$begingroup$

DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},

r[y_] := .08 y^4;
f[x_] := -2 Pi Dynamic[t] + d x;
(*f does not evaluate to a number but FE will take care of that later*)

base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];

distortion = Array[
Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}}
];

pts = base + distortion;

Row[{
Animator[Dynamic @ t, AnimationRate -> .8, AppearanceElements -> {}],
Graphics[{
LightBlue,
Polygon @ Join[ pts[[;; , -1]], {Scaled[{1, 0}], Scaled[{0, 0}]}],

Darker @ Blue, AbsolutePointSize @ 5, Point @ Catenate @ pts,

AbsolutePointSize @ 7, Orange, Thick,
Point @ pts[[15, -1]], Circle[base[[15, -1]], r @ base[[15, -1, 2]]],
Point @ pts[[15, 7]], Circle[base[[15, 7]], r @ base[[15, 7, 2]]]
},
PlotRange -> {{0 + .1, Pi - .1}, {0, 1.2}},
PlotRangePadding -> 0,
PlotRangeClipping -> True, ImageSize -> 800]
}]
]


enter image description here






share|improve this answer











$endgroup$













  • $begingroup$
    thanks - a vastly better approach!
    $endgroup$
    – martin
    2 days ago










  • $begingroup$
    @martin thanks, let me know if anything is not clear.
    $endgroup$
    – Kuba
    yesterday











Your Answer





StackExchange.ifUsing("editor", function () {
return StackExchange.using("mathjaxEditing", function () {
StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["$", "$"], ["\\(","\\)"]]);
});
});
}, "mathjax-editing");

StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "387"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);

StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});

function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});


}
});














draft saved

draft discarded


















StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f193480%2fanimating-wave-motion-in-water%23new-answer', 'question_page');
}
);

Post as a guest















Required, but never shown

























1 Answer
1






active

oldest

votes








1 Answer
1






active

oldest

votes









active

oldest

votes






active

oldest

votes









27












$begingroup$

DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},

r[y_] := .08 y^4;
f[x_] := -2 Pi Dynamic[t] + d x;
(*f does not evaluate to a number but FE will take care of that later*)

base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];

distortion = Array[
Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}}
];

pts = base + distortion;

Row[{
Animator[Dynamic @ t, AnimationRate -> .8, AppearanceElements -> {}],
Graphics[{
LightBlue,
Polygon @ Join[ pts[[;; , -1]], {Scaled[{1, 0}], Scaled[{0, 0}]}],

Darker @ Blue, AbsolutePointSize @ 5, Point @ Catenate @ pts,

AbsolutePointSize @ 7, Orange, Thick,
Point @ pts[[15, -1]], Circle[base[[15, -1]], r @ base[[15, -1, 2]]],
Point @ pts[[15, 7]], Circle[base[[15, 7]], r @ base[[15, 7, 2]]]
},
PlotRange -> {{0 + .1, Pi - .1}, {0, 1.2}},
PlotRangePadding -> 0,
PlotRangeClipping -> True, ImageSize -> 800]
}]
]


enter image description here






share|improve this answer











$endgroup$













  • $begingroup$
    thanks - a vastly better approach!
    $endgroup$
    – martin
    2 days ago










  • $begingroup$
    @martin thanks, let me know if anything is not clear.
    $endgroup$
    – Kuba
    yesterday
















27












$begingroup$

DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},

r[y_] := .08 y^4;
f[x_] := -2 Pi Dynamic[t] + d x;
(*f does not evaluate to a number but FE will take care of that later*)

base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];

distortion = Array[
Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}}
];

pts = base + distortion;

Row[{
Animator[Dynamic @ t, AnimationRate -> .8, AppearanceElements -> {}],
Graphics[{
LightBlue,
Polygon @ Join[ pts[[;; , -1]], {Scaled[{1, 0}], Scaled[{0, 0}]}],

Darker @ Blue, AbsolutePointSize @ 5, Point @ Catenate @ pts,

AbsolutePointSize @ 7, Orange, Thick,
Point @ pts[[15, -1]], Circle[base[[15, -1]], r @ base[[15, -1, 2]]],
Point @ pts[[15, 7]], Circle[base[[15, 7]], r @ base[[15, 7, 2]]]
},
PlotRange -> {{0 + .1, Pi - .1}, {0, 1.2}},
PlotRangePadding -> 0,
PlotRangeClipping -> True, ImageSize -> 800]
}]
]


enter image description here






share|improve this answer











$endgroup$













  • $begingroup$
    thanks - a vastly better approach!
    $endgroup$
    – martin
    2 days ago










  • $begingroup$
    @martin thanks, let me know if anything is not clear.
    $endgroup$
    – Kuba
    yesterday














27












27








27





$begingroup$

DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},

r[y_] := .08 y^4;
f[x_] := -2 Pi Dynamic[t] + d x;
(*f does not evaluate to a number but FE will take care of that later*)

base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];

distortion = Array[
Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}}
];

pts = base + distortion;

Row[{
Animator[Dynamic @ t, AnimationRate -> .8, AppearanceElements -> {}],
Graphics[{
LightBlue,
Polygon @ Join[ pts[[;; , -1]], {Scaled[{1, 0}], Scaled[{0, 0}]}],

Darker @ Blue, AbsolutePointSize @ 5, Point @ Catenate @ pts,

AbsolutePointSize @ 7, Orange, Thick,
Point @ pts[[15, -1]], Circle[base[[15, -1]], r @ base[[15, -1, 2]]],
Point @ pts[[15, 7]], Circle[base[[15, 7]], r @ base[[15, 7, 2]]]
},
PlotRange -> {{0 + .1, Pi - .1}, {0, 1.2}},
PlotRangePadding -> 0,
PlotRangeClipping -> True, ImageSize -> 800]
}]
]


enter image description here






share|improve this answer











$endgroup$



DynamicModule[{t = 0, d = 5, a = .08, base, distortion, pts, r, f, n = 10},

r[y_] := .08 y^4;
f[x_] := -2 Pi Dynamic[t] + d x;
(*f does not evaluate to a number but FE will take care of that later*)

base = Array[List, n {3, 1}, {{0, Pi}, {0, 1}} ];

distortion = Array[
Function[{x, y}, r[y] {Cos @ f @ x, Sin @ f @ x}], n {3, 1}, {{0, Pi}, {0, 1}}
];

pts = base + distortion;

Row[{
Animator[Dynamic @ t, AnimationRate -> .8, AppearanceElements -> {}],
Graphics[{
LightBlue,
Polygon @ Join[ pts[[;; , -1]], {Scaled[{1, 0}], Scaled[{0, 0}]}],

Darker @ Blue, AbsolutePointSize @ 5, Point @ Catenate @ pts,

AbsolutePointSize @ 7, Orange, Thick,
Point @ pts[[15, -1]], Circle[base[[15, -1]], r @ base[[15, -1, 2]]],
Point @ pts[[15, 7]], Circle[base[[15, 7]], r @ base[[15, 7, 2]]]
},
PlotRange -> {{0 + .1, Pi - .1}, {0, 1.2}},
PlotRangePadding -> 0,
PlotRangeClipping -> True, ImageSize -> 800]
}]
]


enter image description here







share|improve this answer














share|improve this answer



share|improve this answer








edited 2 days ago

























answered 2 days ago









KubaKuba

107k12210530




107k12210530












  • $begingroup$
    thanks - a vastly better approach!
    $endgroup$
    – martin
    2 days ago










  • $begingroup$
    @martin thanks, let me know if anything is not clear.
    $endgroup$
    – Kuba
    yesterday


















  • $begingroup$
    thanks - a vastly better approach!
    $endgroup$
    – martin
    2 days ago










  • $begingroup$
    @martin thanks, let me know if anything is not clear.
    $endgroup$
    – Kuba
    yesterday
















$begingroup$
thanks - a vastly better approach!
$endgroup$
– martin
2 days ago




$begingroup$
thanks - a vastly better approach!
$endgroup$
– martin
2 days ago












$begingroup$
@martin thanks, let me know if anything is not clear.
$endgroup$
– Kuba
yesterday




$begingroup$
@martin thanks, let me know if anything is not clear.
$endgroup$
– Kuba
yesterday


















draft saved

draft discarded




















































Thanks for contributing an answer to Mathematica Stack Exchange!


  • Please be sure to answer the question. Provide details and share your research!

But avoid



  • Asking for help, clarification, or responding to other answers.

  • Making statements based on opinion; back them up with references or personal experience.


Use MathJax to format equations. MathJax reference.


To learn more, see our tips on writing great answers.




draft saved


draft discarded














StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f193480%2fanimating-wave-motion-in-water%23new-answer', 'question_page');
}
);

Post as a guest















Required, but never shown





















































Required, but never shown














Required, but never shown












Required, but never shown







Required, but never shown

































Required, but never shown














Required, but never shown












Required, but never shown







Required, but never shown







Popular posts from this blog

Plaza Victoria

Puebla de Zaragoza

Musa