Piano Inclinato  con attrito
\(Un\ blocco\ di\ massa\ m\ parte\ da\ fermo\ dalla\ sommità\ di\ un\ piano\ inclinato\ di\ un\ angolo\ α\ e\ di\ lunghezza\ s + l;\)
\(\(\ \)\(alla\ base\ del\ piano\ urta\ una\ molla\ di\ lunghezza\ a\ riposo\ l\ e\ costante\ elastica\ Kcome\ mostrato\ in\ figura\)\)
	\(•\ \ \ \ \ \ \ Scrivere\ una\ procedura\ che\ calcoli\ la\ posizione\ del\ blocco\ in\ funzione\ dei\ parametri\ del\ moto\ \((α, s, K, m)\)\ e\ del\ tempo\)
	\(•\ \ \ \ \ \ \ Riportare\ l' 
          equazione\ oraria\ del\ moto\ in\ \ un\ grafico\ completo\ di\ etichette\ con\ unità\ di\ misura\ per\ gli\ assi\) 
	•       Animare il moto
	\(•\ \ \ \ \ \ \ Modificare\ la\ procedura\) ,nel caso in cui il piano sia scabro, con coefficiente di attrito μ .

Off[Solve::ifun];
Clear[init, s, x1, x2, t, m, K, α, s0, v0, ss, 
      a]

      
x1[t_, a_, s0_, v0_] = (1/2) a (t^2) + v0 t + 
          s0;

      
x2[t_, a_, s0_, 
          v0_, ω_] := 
Module[{xeq = a/(ω^2), 
            A, φ}, 
A = (Sqrt[(((s0 - xeq))^2) + ((((v0/ω)))^2)]); 
φ = 
            ArcTan[(v0/ω), s0 - xeq] - 
              2  π; 
xeq + 
            A Sin[ω t + φ]
];

     (* equazione oraria senza attrito *) 
s[t_, m_, 0. , K_, α_, ss_] := 
        s[t, m, 0, K, α, ss];
s[t_, m_, 0, K_, α_, 
        ss_] := 
Module[{g = 9.8 , ω = (Sqrt[K/m]), 
            a, v0, s0, v1, s1, v2, 
            s2, τ}, 
a = -g Sin[α]; 
v0 = 0; 
s0 = 
            ss; 
t0 = (Sqrt[((2  s0)/(-a))]); 
s1 = 
            0; 
v1 = -(Sqrt[-2 a s0]); 
t1 = 
            t0 + τ /. Solve[
                  x2[τ, a, s1, v1, ω] == 
                    0, τ][[1]]; 
s2 = 
            x2[t1 - t0, a, s1, v1, ω]; 
v2 = 
            D[x2[τ, a, s1, v1, ω], τ] /. τ -> 
                t1 - t0; 
t2 = 
            t1 + t0; 
τ = 
            Mod[t, t2]; 
Which[
τ < 
              t0, x1[τ, a, s0, v0], 
τ < t1, 
            x2[τ - t0, a, s1, v1, ω], 
τ < 
              t2, x1[τ - t1, a, s2, 
              v2]
]
] /; 
        NumberQ[t]

     (* 
      calcolo delle grandezze che non dipendono dal tempo nel moto con attrito*) 
init[m_, μ_, K_, α_, 
        s0_] := init[m, μ, K, α, 
          s0] = 
Module[{g = 9.8 , ω = (Sqrt[K/m]), , 
            k, t, a1, a2, v0, t0, t1, t2 = 0, tf, xf, vs, xeq, T, s, i, 
            tt}, 
a1 = -g (Sin[α] - μ Cos[α]); 
a2 = -g (Sin[α] + μ Cos[α]); 
xeq = 
            (a1/(ω^2)); 
s[0] = 
            s0; 
T[0] = 
            0; 
tf = (π/ω); 
tt[
              0] = {0, 0, 0, 0}; 
For[k = 1, 
            t2 ≠ 
              tf, k++, 
v0 = -(Sqrt[-2 a1 s[k - 1]]); 
t0 = tt[k - 1][[4]] + 
                (v0/a1); 
t1 = 
              t /. Solve[D[x2[t, a1, 0, v0, ω], t] == 0, 
                    t][[1]]; 
xf = 
              x2[t1, a1, 0, v0, ω]; 
t2 = 
              If[x2[tf, a2, xf, 0, ω] > 0, 
                t /. Solve[x2[t, a2, xf, 0, ω] == 0, 
                      t][[2]], tf]; 
If[
              t2 ≠ tf, 
              vs = D[x2[t, a2, xf, 0, ω], t] /. t -> t2; 
              t3 = -(vs/a2), 
              t3 = 0]; 
s[
                k] = (((Tan[α] - μ) s[k - 1] + 2  μ xf)/(Tan[α] + μ)); 
tt[k] = {t0, t0 + t1, 
                t0 + t1 + t2, 
                t0 + t1 + t2 + t3};
]; 
s[
              k] = If[s[k - 1] < xeq, xeq, 
              2*xeq - s[k - 1]]; 
tt[
              k] = {tt[
                  k - 1][[4]], tt[
                    k - 1][[4]] + (π/ω), tt[
                    k - 1][[4]] + (π/ω), tt[
                    k - 1][[4]] + (π/ω)}; 
{Table[tt[i], {i, 0, k}], 
            Table[s[i], {i, 0, 
                k}]}
]

     (* equazione oraria con attrito *) 
s[t_, m_, μ_, K_, α_, 
        ss_] := 
Module[{g = 9.8 , ω = (Sqrt[K/m]), 
            T, sk, tt, a1, a2, v0, s0, v1, s1, v2, s2, v3, s3, k = 0, kmx, 
            tmax}, 
{T, sk} = 
            init[m, μ, K, α, ss]; 
kmx = 
            Length[T]; 
tmax = 
            T[[kmx, 
                4]]; 
a1 = -g (Sin[α] - μ Cos[α]); 
a2 = -g (Sin[α] + μ Cos[α]); 
If[
            t < tmax, 
While[
              t ≥ T[[++k, 4]]]; 
s0 = 
              sk[[k - 1]]; 
v0 = 
              0; 
If[k == kmx, s1 = s0; v1 = v0, 
              s1 = 0; v1 = -(Sqrt[-2 a1 s0])]; 
v2 = 0; 
s2 = 
              x2[T[[k, 2]] - T[[k, 1]], a1, s1, 
                v1, ω]; 
s3 = 
              x2[T[[k, 3]] - T[[k, 2]], a2, s2, 
                v2, ω]; 
v3 = 
              D[x2[tt, a2, s2, v2, ω], tt] /. 
                tt -> (T[[k, 3]] - 
                      T[[k, 
                          2]]); 
Which[
t ≤ T[[k, 1]], 
              x1[t - T[[k - 1, 4]], a1, s0, 
                v0], 
t ≤ T[[k, 2]], 
              x2[t - T[[k, 1]], a1, s1, 
                v1, ω], 
t ≤ 
                T[[k, 3]], 
              x2[t - T[[k, 2]], a2, s2, 
                v2, ω], 
t ≤ 
                T[[k, 4]], 
              x1[t - T[[k, 3]], a2, s3, 
                v3]], 
sk[[kmx]]
]
] /; NumberQ[t]
Clear[Molla]
Needs["Geometry`Rotations`"]
\(Molla[a_, b_, S_String] := 

      Module[{d = \@\(\((b - a)\) . \((b - a)\)\), α, x, y, t, 
          v = 0.3, l, c, s = 0.04, n = 8, k, ofs, 
          np = 10}, 
k = 
          2  n + 1; 
α = 
          ArcTan[b[\([1]\)] - a[\([1]\)], 
            b[\([2]\)] - a[\([2]\)]]; 
ofs = {2.3 
               Sign[Sin[α]], \(-2.3\)}; 
c = 
          a + \(b - a\)\/np; 
x[
            t_] = \(d\/\(2 + k\ π\ v\)\) \((1 - 2\/np)\) \((\(-Cos[t]\) + 
                  v\ \ t + 1)\) + c[\([1]\)]; 
y[t_] = 
          s\ Sin[t] + 
            c[\([2]\)]; 
l = \(ParametricPlot[{x[t], 
                y[t]}, {t, 0, k\ π}, 
              DisplayFunction -> Identity]\)[\([1, 1, 1, 
              1]\)]; 
{Line[
            Join[{a}, Map[Rotate2D[#, \(-α\), c] &, l], {b}]], 
          Text[S, \(a + b\)\/2, ofs]}
]\)
Clear[time]
\(time[t_] := 

      Module[{i, ore, minuti, secondi, decimi, fm}, 
	
        fm[i_] := If[StringLength[ToString[i]] == 2, 
            ToString[i], "0" <> ToString[i]]; 
	
        ore = IntegerPart[t/3600]; 
	
        minuti = IntegerPart[\((t - 3600\ ore)\)/60]; 
	
        secondi = IntegerPart[t - 3600\ ore - 60\ minuti]; 
	
        decimi = 
          IntegerPart[100 \((t - 3600\ ore - 60\ minuti - secondi)\)]; 
	
        fm[ore] <> ":" <> fm[minuti] <> ":" <> 
          fm[secondi] <> "." <> fm[decimi]
]\)
Clear[Animazione]
\(Animazione[m_, μ_, K_, α_, s0_, 
        nf_] := 
Module[{g = 9.8, l, h, a, Tk, 
          sk, ω = \@\(K/m\), A, B, C, P, Q, ΔP, ss, xeq, 
          t, T}, 
xeq = \(m\ g\ \((Sin[α])\)\)\/K; 
l = 
          xeq + \@\(xeq\^2 + xeq\ s0\) + 
            s0/5; 
h = \((s0 + l)\) 
            Sin[α]; 
a = \((s0 + l)\) 
            Cos[α]; 
If[
          N[μ] == 0. , 
T = 
            2 \@\(\( 2  s0\)\/\(g\ Sin[α]\)\) + 
                t /. \(Solve[
                  x2[t, \(-g\)\ Sin[α], 
                      0, \(-\@\(2\ g\ Sin[α]\ s0\)\), ω] == 0, t]\)[\([1]\)], 
{Tk, sk} = 
            init[m, μ, K, α, s0]; 
          T = Tk[\([Length[Tk], 4]\)]]; 
A = {0, 
            0}; 
B = {0, h}; 
C = {a, 
            0}; 
ΔP = 
          0.037 {Sin[α], 
              Cos[α]}; 
Do[
ss = 
            s[t, m, μ, K, α, 
              s0]; 
P = {\((s0 - ss)\) 
                  Cos[α], \((ss + l)\) 
                  Sin[α]} + ΔP\/2; 
Q = If[ss < 0, 
              P + ΔP\/2, {s0\ Cos[α], 
                  l\ Sin[α]} + ΔP]; 
Show[
            Graphics[{
Text[
                  time[t], {0.8  a, 0.9  h}], 
PointSize[
                  0.035], 
                Point[P], 
Line[{A, B, C, 
                    A}], 
Line[{C, 
                    C + 2  ΔP}], 
Line[{Q - ΔP, Q + ΔP}], 
Molla[
                  C + ΔP, Q, " "]}], 
            PlotRange -> {{\(-0.05\), a + 0.05}, {0, h + 0.05}}, 
            AspectRatio -> Sin[α], Axes -> True, 
            AxesLabel -> {"x(m)", "y(m)"}], 
{t, 0, T, T/nf}]
]\)

Clear[m, μ, K, α, s0]
m = 1.  ;
μ = 0.2;
K = 100;
α = 30  °;
s0 = 1;
Plot[s[t, m, 0, K, α, s0], {t, 0, 4}, 
        AxesLabel -> {"t(sec)", "s(m)"}];
Plot[s[t, m, μ, K, α, s0], {t, 0, 4}, 
        AxesLabel -> {"t(sec)", "s(m)"}];

m = 1.  ;
μ = 0;
K = 100;
α = 30  °;
s0 = 1;
nf = 100;
Animazione[m, μ, K, α, s0, nf];

μ = 0.2;
Animazione[m, μ, K, α, s0, 100];