Want more features on Pastebin? Sign Up, it's FREE!

Cycloid Evolute

By: Matthen on Nov 22nd, 2012  |  syntax: None  |  size: 2.03 KB  |  views: 203  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. x[t_] := Sin[t] + t;
  2. y[t_] := Cos[t];
  3. tmin = -5; tmax = 5;
  4. n = 41;
  5. notzero[x_] := If[x == 0, 0.001, x];
  6. normals = N@Table[{y'[t], -x'[t]}, {t, tmin, tmax, (tmax - tmin)/n}];
  7. ps = N@Table[{x[t], y[t]}, {t, tmin, tmax, (tmax - tmin)/n}];
  8. ts = N@Table[t, {t, tmin, tmax, (tmax - tmin)/n}];
  9. X[t_] := x[t] -
  10.    y'[t] ( x'[t]^2 + y'[t]^2)/notzero[x'[t] y''[t] - x''[t] y'[t]];
  11. Y[t_] := y[t] +
  12.    x'[t] ( x'[t]^2 + y'[t]^2)/notzero[x'[t] y''[t] - x''[t] y'[t]];
  13. frame[\[Tau]_] :=
  14.   Show[
  15.    Graphics[{
  16.      
  17.      }, PlotRange -> {{-4, 4}, {-4, 2}}, ImageSize -> {300, 300}],
  18.    Reverse@Table[
  19.      ParametricPlot[
  20.       ps[[i]] + t normals[[i]]/notzero@Norm[normals[[i]]], {t, -100,
  21.        100},
  22.       PlotStyle ->
  23.        If[i == \[Tau] || i == \[Tau] - Length@ts,
  24.         Directive[Thickness[0.01], RGBColor[0.4, 0.4, 0.9]],
  25.         Directive[Thick, Opacity[0.4], RGBColor[0.1, 0.1, 0.1]]]
  26.       ], {i, If[\[Tau] > Length[ts], \[Tau] - Length[ts], 1],
  27.       If[\[Tau] > Length[ts], Length[ts], \[Tau]]}],
  28.    ParametricPlot[{{x[t], y[t]}, {X[t], Y[t]}}, {t, tmin, tmax},
  29.     PlotStyle -> {Directive[Thick, RGBColor[0.9, 0.2, 0.3]],
  30.       Directive[Thick, RGBColor[1.0, 0.1, 0.2]]}],
  31.    Graphics[{PointSize[0.05], RGBColor[0.2, 0.2, 0.6],
  32.      Point[ps[[Mod[\[Tau], Length@ts, 1]]]],
  33.      \[Theta] = ts[[Mod[\[Tau], Length@ts, 1]]];
  34.      Point[{Sin[\[Theta] + Pi] + \[Theta], Cos[\[Theta] + Pi] - 2}],
  35.      Thick, Black,
  36.      Line[{{-4, -1}, {4, -1}}],
  37.      Circle[{\[Theta], 0}, 1],
  38.      Table[
  39.       Line[{{Sin[\[Theta] + dt], Cos[\[Theta] + dt]} + {\[Theta],
  40.           0}, {Sin[\[Theta] + dt + Pi],
  41.           Cos[\[Theta] + dt + Pi]} + {\[Theta], 0}}]
  42.       , {dt, 0, Pi, Pi/2}],
  43.      
  44.      Line[{{-4, -3}, {4, -3}}],
  45.      Circle[{\[Theta], -2}, 1],
  46.      Table[
  47.       Line[{{Sin[\[Theta] + dt],
  48.           Cos[\[Theta] + dt]} + {\[Theta], -2}, {Sin[\[Theta] + dt +
  49.             Pi], Cos[\[Theta] + dt + Pi]} + {\[Theta], -2}}]
  50.       , {dt, 0, Pi, Pi/2}]
  51.      }]
  52.    ];
  53. Manipulate[frame[\[Tau]], {\[Tau], 1, 2 Length[ts], 1}]
clone this paste RAW Paste Data