Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2002
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2002

[Date Index] [Thread Index] [Author Index]

Search the Archive

RE: Re: Ball Rolling down on Cosh[t] Path

  • To: mathgroup at smc.vnet.net
  • Subject: [mg36751] RE: [mg36738] Re: Ball Rolling down on Cosh[t] Path
  • From: "DrBob" <drbob at bigfoot.com>
  • Date: Sun, 22 Sep 2002 04:32:37 -0400 (EDT)
  • Reply-to: <drbob at bigfoot.com>
  • Sender: owner-wri-mathgroup at wolfram.com

I've modified Selwyn's solution to make it more general.  In particular,
the height can be specified (up to about 35 meters).  The differential
equation is solved for t=0 to 5 first.  The quarter-period is computed
by finding a zero; then the differential equation is solved again for
t=0 to the quarter-period, and the solution is extended using reflection
and periodicity.  This yields a higher-precision solution.  Then I graph
the solution, with a stepsize equal to period/40, from t=0 to 'period',
labeling each frame with the values of t, x[t], and y[t].  Using a step
size that divides period/4 guarantees the lowest point is reached ON a
frame when appropriate.

Here's the solution as a notebook expression:

Notebook[{

Cell[CellGroupData[{
Cell["Borut L's solution:", "Subsubtitle"],

Cell[TextData[StyleBox["Having noticed your statement \" ... BEYOND \
MY MEANS \" I thing you aren't yet\nfamiliar with Lagrangian \
formalism. It's quite easy to derive a general\nequation of motion \
for a point mass, subjected to gravity and to moving on a\ncurve f = \
y(x) (i.e. f = Cosh[#]&).\n\n1) I'll leave re-deriving equation to \
you, here is what I've got (just copy\npaste it).:",
  FontFamily->"Courier New",
  FontSize->10,
  CharacterEncoding->"WindowsANSI"]], "Text"],

Cell[BoxData[
    RowBox[{"selwyn", "=", 
      RowBox[{"First", "[", 
        RowBox[{
          RowBox[{
            RowBox[{
              RowBox[{"x", "''"}], "[", "t", "]"}], "/.", 
            RowBox[{"Solve", "[", 
              RowBox[{"diffeq", ",", 
                RowBox[{
                  RowBox[{"x", "''"}], "[", "t", "]"}]}], "]"}]}], "//",
           "Simplify"}], "]"}]}]], "Input"],

Cell[BoxData[
    RowBox[{"borut", "=", 
      RowBox[{"First", "[", 
        RowBox[{
          RowBox[{
            RowBox[{"x", "''"}], "[", "t", "]"}], "/.", 
          RowBox[{"Solve", "[", 
            RowBox[{
              RowBox[{"getEq", "[", "Cosh", "]"}], ",", 
              RowBox[{
                RowBox[{"x", "''"}], "[", "t", "]"}]}], "]"}]}], 
        "]"}]}]], "Input"],

Cell[BoxData[
    RowBox[{
      RowBox[{"getEq", "[", "f_", "]"}], ":=", "\[IndentingNewLine]", 
      
      RowBox[{"Simplify", "[", 
        RowBox[{
          RowBox[{
            RowBox[{
              RowBox[{"x", "''"}], "[", "t", "]"}], "+", 
            RowBox[{
              SuperscriptBox[
                RowBox[{
                  RowBox[{"x", "'"}], "[", "t", "]"}], "2"], " ", 
              FractionBox[
                RowBox[{"2", " ", 
                  RowBox[{
                    RowBox[{"f", "'"}], "[", 
                    RowBox[{"x", "[", "t", "]"}], "]"}], " ", 
                  RowBox[{
                    RowBox[{"f", "''"}], "[", 
                    RowBox[{"x", "[", "t", "]"}], "]"}]}], 
                RowBox[{"1", "+", 
                  SuperscriptBox[
                    RowBox[{
                      RowBox[{"f", "'"}], "[", 
                      RowBox[{"x", "[", "t", "]"}], "]"}], "2"]}]]}], 
            "+", 
            FractionBox[
              RowBox[{"g", " ", 
                RowBox[{
                  RowBox[{"f", "'"}], "[", 
                  RowBox[{"x", "[", "t", "]"}], "]"}]}], 
              RowBox[{"1", "+", 
                SuperscriptBox[
                  RowBox[{
                    RowBox[{"f", "'"}], "[", 
                    RowBox[{"x", "[", "t", "]"}], "]"}], "2"]}]]}],
"==",
           "0"}], "]"}]}]], "Input"],

Cell[TextData[{
  StyleBox["2) Next, you integrate it .:",
    FontFamily->"Courier New",
    FontSize->10,
    CharacterEncoding->"WindowsANSI"],
  ""
}], "Text"],

Cell[BoxData[
    RowBox[{
      RowBox[{"getSol", "[", 
        RowBox[{"f_", ",", 
          RowBox[{"h0_", "?", "Positive"}], ",", 
          RowBox[{"x0_", "?", "Positive"}]}], "]"}], ":=", 
      RowBox[{"Module", "[", 
        RowBox[{
          RowBox[{"{", "tStop", "}"}], ",", "\[IndentingNewLine]", 
          RowBox[{"First", "@", 
            RowBox[{"NDSolve", "[", "\[IndentingNewLine]", 
              RowBox[{
                RowBox[{"{", 
                  RowBox[{
                    RowBox[{"getEq", "[", "f", "]"}], ",", 
                    RowBox[{
                      RowBox[{"x", "[", "0", "]"}], "\[Equal]", 
                      "h0"}], ",", 
                    RowBox[{
                      RowBox[{
                        RowBox[{"x", "'"}], "[", "0", "]"}], 
                      "\[Equal]", "0"}]}], "}"}], ",", 
                "\[IndentingNewLine]", "x", ",", 
                "\[IndentingNewLine]", 
                RowBox[{"{", 
                  RowBox[{"t", ",", "0", ",", "10"}], "}"}], ",", 
                "\[IndentingNewLine]", 
                RowBox[{"MaxStepSize", "\[Rule]", 
                  RowBox[{"1", "/", "100"}]}], ",", 
                RowBox[{"StoppingTest", "\[RuleDelayed]", 
                  RowBox[{"If", "[", 
                    RowBox[{
                      RowBox[{"h0", "<", "0"}], ",", 
                      RowBox[{"x", ">", "0"}], ",", 
                      RowBox[{"x", "<", "0"}]}], "]"}]}]}], 
              "\[IndentingNewLine]", "]"}]}]}], "\[IndentingNewLine]",
         "]"}]}]], "Input"],

Cell["\<\
3) Here follows animation code, specially for linear versus cosh \
case, apply my initial conditions (below)\
\>", "Text"],

Cell[BoxData[
    RowBox[{
      RowBox[{"makeDuo", "[", 
        RowBox[{"f_", ",", "g_", ",", "h0_"}], "]"}], ":=", 
      RowBox[{"Module", "[", 
        RowBox[{
          RowBox[{"{", 
            RowBox[{
              RowBox[{"solf", "=", 
                RowBox[{"getSol", "[", 
                  RowBox[{"f", ",", "h0"}], "]"}]}], ",", 
              RowBox[{"solg", "=", 
                RowBox[{"getSol", "[", 
                  RowBox[{"g", ",", "h0"}], "]"}]}], ",", "tf", ",", 
              "tg", ",", "maxT", ",", "minT"}], "}"}], ",", 
          "\[IndentingNewLine]", 
          RowBox[{
            RowBox[{"tf", "=", 
              RowBox[{"solf", "[", 
                RowBox[{"[", 
                  RowBox[{
                  "1", ",", "2", ",", "1", ",", "1", ",", "2"}], 
                  "]"}], "]"}]}], ";", "\[IndentingNewLine]", 
            RowBox[{"tg", "=", 
              RowBox[{"solg", "[", 
                RowBox[{"[", 
                  RowBox[{
                  "1", ",", "2", ",", "1", ",", "1", ",", "2"}], 
                  "]"}], "]"}]}], ";", "\[IndentingNewLine]", 
            RowBox[{"maxT", "=", 
              RowBox[{"Max", "[", 
                RowBox[{"{", 
                  RowBox[{"tf", ",", "tg"}], "}"}], "]"}]}], ";", 
            "\[IndentingNewLine]", 
            RowBox[{"minT", "=", 
              RowBox[{"Min", "[", 
                RowBox[{"{", 
                  RowBox[{"tf", ",", "tg"}], "}"}], "]"}]}], ";", 
            "\[IndentingNewLine]", 
            RowBox[{"Do", "[", 
              RowBox[{
                RowBox[{"Plot", "[", 
                  RowBox[{
                    RowBox[{"{", 
                      RowBox[{
                        RowBox[{"f", "@", "x"}], ",", 
                        RowBox[{"g", "@", "x"}]}], "}"}], ",", 
                    RowBox[{"{", 
                      RowBox[{"x", ",", "0", ",", 
                        RowBox[{"ArcCosh", "@", "h0"}]}], "}"}], ",", 
                    
                    RowBox[{"AspectRatio", "\[Rule]", "Automatic"}], 
                    ",", 
                    RowBox[{"Frame", "\[Rule]", "True"}], ",", 
                    RowBox[{"Axes", "\[Rule]", "False"}], ",", 
                    RowBox[{"Epilog", "\[Rule]", 
                      RowBox[{"{", 
                        RowBox[{
                          RowBox[{
                          "AbsolutePointSize", "[", "10", "]"}], ",", 
                          
                          RowBox[{"Hue", "[", "0", "]"}], ",", 
                          RowBox[{"Point", "[", 
                            RowBox[{
                              RowBox[{"{", 
                                RowBox[{
                                  RowBox[{"x", "[", "t", "]"}], ",", 
                                  RowBox[{"f", "@", 
                                    RowBox[{"x", "[", "t", "]"}]}]}], 
                                "}"}], "/.", "solf"}], "]"}], ",", 
                          RowBox[{"Hue", "[", ".6", "]"}], ",", 
                          RowBox[{"Point", "[", 
                            RowBox[{
                              RowBox[{"{", 
                                RowBox[{
                                  RowBox[{"x", "[", "t", "]"}], ",", 
                                  RowBox[{"g", "@", 
                                    RowBox[{"x", "[", "t", "]"}]}]}], 
                                "}"}], "/.", "solg"}], "]"}]}], 
                        "}"}]}]}], "]"}], ",", 
                RowBox[{"{", 
                  RowBox[{"t", ",", "0", ",", "minT", ",", "minT"}], 
                  "}"}]}], "]"}]}]}], "]"}]}]], "Input"],

Cell[TextData[{
  StyleBox["4) My initial conditions. In my opinion, you weren't true \
on this. Saying \"\nSTARTING FROM THE SAME HEIGHT \" is not enough - \
you should specify x as\nwell, thus specifing starting POINT and not \
just height y.",
    FontFamily->"Courier New",
    FontSize->10,
    CharacterEncoding->"WindowsANSI"],
  ""
}], "Text"],

Cell[BoxData[{
    RowBox[{"makeDuo", "[", 
      RowBox[{
        RowBox[{
          RowBox[{
            RowBox[{"Cosh", "[", "1.", "]"}], " ", "#"}], "&"}], ",", 
        
        RowBox[{
          RowBox[{"Cosh", "[", "#", "]"}], "&"}], ",", "23"}], 
      "]"}], "\[IndentingNewLine]", 
    RowBox[{"SelectionMove", "[", 
      RowBox[{
        RowBox[{"EvaluationNotebook", "[", "]"}], ",", "All", ",", 
        "GeneratedCell"}], "]"}], "\n", 
    RowBox[{
    "FrontEndTokenExecute", "[", "\"\<OpenCloseGroup\>\"", 
      "]"}], "\n", 
    RowBox[{
    "FrontEndTokenExecute", "[", "\"\<SelectionAnimate\>\"", 
      "]"}]}], "Input"]
}, Open  ]]
},
FrontEndVersion->"4.2 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 711}},
WindowSize->{815, 569},
WindowMargins->{{0, Automatic}, {Automatic, -1}},
ShowSelection->True
]

Bobby Treat

-----Original Message-----
From: Selwyn Hollis [mailto:slhollis at earthlink.net] 
To: mathgroup at smc.vnet.net
Subject: [mg36751] [mg36738] Re: Ball Rolling down on Cosh[t] Path

Matthias,

The simplest way to get the equation of motion is to set up the 
Lagrangian. Let's assume a 1 kg mass. Then the kinetic energy is

    KE = Simplify[(1/2)*(x'[t]^2 + D[Cosh[x[t]],t]^2)]

and the potential energy is

    PE = 9.8*Cosh[x[t]]

The Lagrangian is

    L = KE - PE

and the equation of motion is

    diffeq =
    Simplify[ D[D[L, x'[t]], t] ] == Simplify[ D[L, x[t]] ]

Now solve and animate ...

    xx[t_] = x[t]/. First[
       NDSolve[{diffeq, x[0] == -1, x'[0] == 0}, x[t], {t, 0, 5}]]

    curve = Plot[Cosh[x], {x, -1, 1}]

    Do[
       Show[curve,
            Graphics[Disk[{xx[t], Cosh[xx[t]]}, 0.025]],
            PlotRange -> {{-1.2, 1.2}, {0.9, 1.65}},
            AspectRatio -> Automatic, Axes->None],
      {t, 0, 5, 0.1}]

----
Selwyn Hollis



Matthias.Bode at oppenheim.de wrote:
> Dear Colleagues,
> 
> I intend to make an animation in which 
> 
> ball A rolls down on an inclined plane from the left whilst
> 
> ball B - starting from the same height - rolls down Cosh[t]'s path
from the
> right.
> 
> x-axis is time t, y-axis is height h.
> 
> Ball A is fine; ball B - which should arrive at h=0 before A - is
beyond my
> means.
> 
> Thank you for your consideration,
> 
> Matthias Bode
> Sal. Oppenheim jr. & Cie. KGaA
> Koenigsberger Strasse 29
> D-60487 Frankfurt am Main
> GERMANY
> Tel.: +49(0)69 71 34 53 80
> Mobile: +49(0)172 6 74 95 77
> Fax: +49(0)69 71 34 95 380
> E-mail: matthias.bode at oppenheim.de
> Internet: http://www.oppenheim.de
> 
> 







  • Prev by Date: Maintaining Multiple Forms of a Function For Different Purposes
  • Next by Date: how to plot with BOLD LINE with mathematica?
  • Previous by thread: RE: Re: Ball Rolling down on Cosh[t] Path
  • Next by thread: Re: Ball Rolling down on Cosh[t] Path