Konzept und Darstellung der nachfolgenden Ergebnisse sind Resultate von durch Studenten ausgeführten Arbeiten - WIR

Krümmung und Anschmiegekreis bei ebenen  Kurven

Kurven im (R^(2 ))

Berechnung von Krümmung und Anschmiegekreis bei ebenen Kurven

Definition der Funktion

Remove["Global`*"]

fx[t_] := t;   fy[t_] := 
      Sin[t];   f[t_] := {fx[t], fy[t]};

Definition des Bereiches der Variablen

tmin = 0;   tmax =  2 Pi;

Plot Ausgangsfunktion

origPlot = 
        ParametricPlot[Evaluate[f[t]], {t, tmin, tmax}, 
          PlotStyle -> {RGBColor[1, 0, 0]}];

Krümmung

vLen[v_] := Sqrt[v . v]

f3d[t_] := Join[f[t], {0}];  f3d[t]

Cross[D[f3d[t], t], D[f3d[t], {t, 2}]]

Cross[f3d'[t], f3d''[t]]

ϰ[
        t_] = (Cross[D[f3d[t], t], D[f3d[t], {t, 2}]]/
            vLen[D[f3d[t], t]]^3)[[3]];   ϰ[t]

Plot[Evaluate[ϰ[t]], {t, tmin, tmax}];

Krümmungsradius

ρ[t_] := Abs[1/ϰ[t]];   ρ[t]

Plot[Evaluate[ρ[t]], {t, tmin, tmax}];

Krümmungskreismittelpunkt (Evolute)

Take[
      Cross[Cross[f3d'[t], f3d''[t]], f3d'[t]]/
        vLen[Cross[
            Cross[f3d'[t], f3d''[t]], f3d'[t]]]]

n[t_] = 
      Take[Cross[Cross[f3d'[t], f3d''[t]], f3d'[t]]/
          vLen[Cross[Cross[f3d'[t], f3d''[t]], f3d'[t]]], 2];  
    n[t]

m[t_] := f[t] +  ρ[t]*n[t];   m[3]

evolute = 
        ParametricPlot[Evaluate[m[t]], {t, tmin, tmax}, 
          PlotRange -> {-8, 8}, AspectRatio -> Automatic, 
          PlotStyle -> RGBColor[0, 0, 1]];

Ursprüngliche Funktion mit den Schmiegekreisen

myCirc[t_] := Circle[m[t],  ρ[t]];   myCirc[t]

myPlotTable = 
      Table[Evaluate[myCirc[t]], {t, 0.1, tmax, 0.1}]

constrPlot = 
        Show[Graphics[Join[{RGBColor[0, 0.5, 0.5]}, myPlotTable]], 
          Axes -> True, AspectRatio -> Automatic];

Alles zusammen

Show[constrPlot, evolute, origPlot, 
        PlotRange -> {{-1, 2  Pi + 1}, {-1.5, 
              1.5}}];

Animation

tg[t_] = f'[t]/vLen[f'[t]];   tg[t]

tVec[t_] := Line[{f[t], f[t] + Evaluate[tg[t]]}];   tVec[
      t]

nVec[t_] := Line[{f[t], f[t] + n[t]}];  nVec[t]

zweibein[t_] := 
      Graphics[{RGBColor[0.01, 0.6, 0.62], nVec[t], RGBColor[1, 0, 1], 
          tVec[t] }];  zweibein[t]

circPlot[t_] := Graphics[{RGBColor[1, 0, 1], myCirc[t] }];  
    circPlot[t]

zentrum[t_] := Graphics[{RGBColor[1, 0.8, 0], Disk[m[t], 0.1] }];  
    zentrum[t]

Do[Show[evolute, origPlot, circPlot[k], zentrum[k], zweibein[k], 
        AspectRatio -> Automatic, 
        PlotRange -> {{-1, 7}, {-2, 2}}], {k, 0.1, tmax, 
        0.1}]