b

Gekoppelte Pendel

Ungekoppelte Schwingung

Wir importieren zunächst die Daten der ungekoppelten Pendel:

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/ungekoppelt.txt","Table"]];

(Subscript[ungekoppelt, 1])=Transpose[{time,p1}];

(Subscript[ungekoppelt, 2])=Transpose[{time,p2}];

(Subscript[plot, u1])=ListPlot[(Subscript[ungekoppelt, 1]),Joined->True,ImageSize->Full]

(Subscript[plot, u2])=ListPlot[(Subscript[ungekoppelt, 2]),Joined->True,ImageSize->Full]

maxQ[{{x1_,y1_},{x2_,y2_},{x3_,y3_}}]:=y1<y2&&y2≥y3;

minQ[{{x1_,y1_},{x2_,y2_},{x3_,y3_}}]:=y1≥y2&&y2<y3;

Durch Messung der Abstände der Peaks und Mittlung finden wir die Periodendauer und daraus die Winkelfrequenz:

(max_u1)=Select[Map[#[[2]]&,Select[Partition[(Subscript[ungekoppelt, 1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_u1)=Select[Map[#[[2]]&,Select[Partition[(Subscript[ungekoppelt, 1]),3,1],minQ[#]&]],#[[1]]>6&]

(Subscript[periods, u1])=Quantity[Join[Differences[(max_u1)[[All,1]]],Differences[(min_u1)[[All,1]]]],"Seconds"]

(Subscript[T, u1])=Mean[(Subscript[periods, u1])];(Subscript[ΔT, u1])=StandardDeviation[(Subscript[periods, u1])];

Die Winkelfrequenz des ersten Pendels ist mit Fehler:

(Subscript[ω, u1])=((2π)/(Subscript[T, u1]))//N

(Subscript[Δω, u1])=((2π (Subscript[ΔT, u1]))/((Subscript[T, u1])^2))//N

(max_u2)=Select[Map[#[[2]]&,Select[Partition[(Subscript[ungekoppelt, 2]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_u2)=Select[Map[#[[2]]&,Select[Partition[(Subscript[ungekoppelt, 2]),3,1],minQ[#]&]],#[[1]]>6&]

(Subscript[periods, u2])=Quantity[Select[Join[Differences[(max_u2)[[2;;,1]]],Differences[(min_u2)[[All,1]]]],#>1&],"Seconds"]

(Subscript[T, u2])=Mean[(Subscript[periods, u2])];(Subscript[ΔT, u2])=StandardDeviation[(Subscript[periods, u2])];

Die Winkelfrequenz des zweiten Pendels ist mit Fehler:

(Subscript[ω, u2])=((2π)/(Subscript[T, u2]))//N

(Subscript[Δω, u2])=((2π (Subscript[ΔT, u2]))/((Subscript[T, u2])^2))//N

Schwache Kopplung (Aufhängung oben)

Die Aufhängung der Feder befand sich hier bei

(Subscript[l, oben])=Quantity[5.5,"Centimeters"]

(Subscript[Δl, oben])=Quantity[0.1,"Centimeters"]

Wir importieren zunächst wieder die Rohdaten:

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-oben-antisymmetrisch.txt","Table"]];

(Subscript[gekoppelt, oben,asym,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, oben,asym,2])=Transpose[{time,p2}];

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-oben-symmetrisch.txt","Table"]];

(Subscript[gekoppelt, oben,sym,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, oben,sym,2])=Transpose[{time,p2}];

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-oben-schwebung.txt","Table"]];

(Subscript[gekoppelt, oben,schweb,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, oben,schweb,2])=Transpose[{time,p2}];

ListPlot[{ (Subscript[gekoppelt, oben,sym,1]),(Subscript[gekoppelt, oben,sym,2])},Joined->True,ImageSize->Full]

Aus Gründen der Datenqualität (Größe der Peaks) nutzen wir die ersten 20 Sekunden:

(Subscript[gekoppelt, oben,sym,1])=Select[(Subscript[gekoppelt, oben,sym,1]),#[[1]]≤20&];

(Subscript[gekoppelt, oben,sym,2])=Select[(Subscript[gekoppelt, oben,sym,2]),#[[1]]≤20&];

ListPlot[{ (Subscript[gekoppelt, oben,sym,1]),(Subscript[gekoppelt, oben,sym,2])},Joined->True,ImageSize->Full,PlotRange->{Full,{-5,5}}]

Nun bestimmen wir die Frequenz (Subscript[ω, oben,1]) anhand der Daten von beiden Pendeln. Wir nutzen die Methode von oben.

(max_(oben,sym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,sym,1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(oben,sym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,sym,1]),3,1],minQ[#]&]],#[[2]]<0&]

(max_(oben,sym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,sym,2]),3,1],maxQ[#]&]],#[[2]]>0&][[2;;]]

(min_(oben,sym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,sym,2]),3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, oben,1])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(oben,sym,1)),(min_(oben,sym,1)),(max_(oben,sym,2)),(min_(oben,sym,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, oben,1])=Mean[(Subscript[periods, oben,1])];(Subscript[ΔT, oben,1])=StandardDeviation[(Subscript[periods, oben,1])];

(Subscript[ω, oben,1])=((2π)/(Subscript[T, oben,1]))//N

(Subscript[Δω, oben,1])=((2π (Subscript[ΔT, oben,1]))/((Subscript[T, oben,1])^2))//N

Das Ergebnis stimmt innerhalb der Fehlergrenzen mit den Frequenzen ohne Kopplung überein.

Antisymmetrische Schwingung

ListPlot[{ (Subscript[gekoppelt, oben,asym,1]),(Subscript[gekoppelt, oben,asym,2])},Joined->True,ImageSize->Full]

Es muß eine Störung dazu geführt haben, daß nach den ersten Perioden die Schwingungen sich gegeneinander verschieben. Daher betrachten wir nur die ersten 5 Sekunden:

(Subscript[gekoppelt, oben,asym,1])=Select[(Subscript[gekoppelt, oben,asym,1]),#[[1]]≤5&];

(Subscript[gekoppelt, oben,asym,2])=Select[(Subscript[gekoppelt, oben,asym,2]),#[[1]]≤5&];

ListPlot[{ (Subscript[gekoppelt, oben,asym,1]),(Subscript[gekoppelt, oben,asym,2])},Joined->True,ImageSize->Full,PlotRange->{Full,{-5,5}}]

Nun bestimmen wir die Frequenz (Subscript[ω, oben,2]) anhand der Daten von beiden Pendeln.

(max_(oben,asym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,asym,1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(oben,asym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,asym,1]),3,1],minQ[#]&]],#[[2]]<0&]

(max_(oben,asym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,asym,2]),3,1],maxQ[#]&]],#[[2]]>0&][[2;;]]

(min_(oben,asym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, oben,asym,2]),3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, oben,2])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(oben,asym,1)),(min_(oben,asym,1)),(max_(oben,asym,2)),(min_(oben,asym,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, oben,2])=Mean[(Subscript[periods, oben,2])];(Subscript[ΔT, oben,2])=StandardDeviation[(Subscript[periods, oben,2])];

(Subscript[ω, oben,2])=((2π)/(Subscript[T, oben,2]))//N

(Subscript[Δω, oben,2])=((2π (Subscript[ΔT, oben,2]))/((Subscript[T, oben,2])^2))//N

Wie erwartet, ist diese Frequenz etwas größer.

Schwebung

ListPlot[ (Subscript[gekoppelt, oben,schweb,1]),Joined->True,ImageSize->Full]

ListPlot[ (Subscript[gekoppelt, oben,schweb,2]),Joined->True,ImageSize->Full,PlotStyle->Red]

Da die Schwebung das Vorzeichen der Schwingung umkehrt, ist es am besten, zur Bestimmung von (Subscript[ω, oben,Ι]) nur einen Schwebungsblock zu nutzen. Wir wählen von beiden Pendeln die ersten 20 Sekunden. Zur Bestimmung der Schwebungsfrequenz (Subscript[ω, oben,ΙΙ]) wählen wir manuell (mithilfe der graphischen Funktion »Get Coordinates«) Schwebungspeaks aus und ermitteln deren Differenzen. (Wir erhalten dann die doppelte Frequenz, da die Einhüllende ja auch Ausschläge nach Oben und Unten hat.

Zunächst ermitteln wir (Subscript[ω, oben,ΙΙ]):

(Subscript[peaks, oben,schweb,1])={{24.56,3.047},{81.97,2.133},{137.3,1.293},{192.8,0.6317},{247.8,0.2222}}

(Subscript[peaks, oben,schweb,2])={{52.96,2.931},{108.5,2.023},{165.4,1.241},{220.3,0.6513}}

(Subscript[periods, oben,II])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(Subscript[peaks, oben,schweb,1]),(Subscript[peaks, oben,schweb,2])})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, oben,II])=Mean[(Subscript[periods, oben,II])];(Subscript[ΔT, oben,II])=StandardDeviation[(Subscript[periods, oben,II])];

In diesem Schritt schreiben wir in den Zähler nur π, um die Dopplung (s. o.) aus der Rechnung zu entfernen.

(Subscript[ω, oben,II])=(π/(Subscript[T, oben,II]))//N

(Subscript[Δω, oben,II])=((π (Subscript[ΔT, oben,II]))/((Subscript[T, oben,II])^2))//N

Nun bestimmen wir (Subscript[ω, oben,Ι]):

(max_(oben,schweb,1))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, oben,schweb,1]),#[[1]]≤20&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(oben,schweb,1))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, oben,schweb,1]),#[[1]]≤20&],3,1],minQ[#]&]],#[[2]]<0&]

(max_(oben,schweb,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, oben,schweb,2]),#[[1]]≤20&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(oben,schweb,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, oben,schweb,2]),#[[1]]≤20&],3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, oben,I])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(oben,schweb,1)),(min_(oben,schweb,1)),(max_(oben,schweb,2)),(min_(oben,schweb,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, oben,I])=Mean[(Subscript[periods, oben,I])];(Subscript[ΔT, oben,I])=StandardDeviation[(Subscript[periods, oben,I])];

(Subscript[ω, oben,I])=((2π)/(Subscript[T, oben,I]))//N

(Subscript[Δω, oben,I])=((2π (Subscript[ΔT, oben,I]))/((Subscript[T, oben,I])^2))//N

Vergleich der Frequenzen

Aus den nun ermittelten Frequenzen für symmetrische und antisymmetrische Schwingung lassen sich die theoretischen Werte für Schwingungs- und Schwebungsfrequenzen ermitteln und so (Subscript[ω, oben,Ι]) und (Subscript[ω, oben,ΙΙ]) – theoretisch und gemessen – vergleichen.

((Subscript[ω, oben,Ι])= (1/2)((Subscript[ω, oben,1])+(Subscript[ω, oben,2])) und (Subscript[Δω, oben,Ι])=(1/2)((Subscript[Δω, oben,1])+(Subscript[Δω, oben,2])), (Subscript[ω, oben,ΙΙ])= (1/2)((Subscript[ω, oben,2])-(Subscript[ω, oben,1])) und (Subscript[Δω, oben,ΙΙ])=(1/2)((Subscript[Δω, oben,1])+(Subscript[Δω, oben,2])))

(Subscript[ω, oben,I,theor])=(1/2)((Subscript[ω, oben,1])+(Subscript[ω, oben,2]))

(Subscript[Δω, oben,I,theor])=(1/2)((Subscript[Δω, oben,1])+(Subscript[Δω, oben,2]))

(Subscript[ω, oben,II,theor])=(1/2)((Subscript[ω, oben,2])-(Subscript[ω, oben,1]))

(Subscript[Δω, oben,II,theor])=(1/2)((Subscript[Δω, oben,2])+(Subscript[Δω, oben,1]))

Grid[{{Null,Text["Theoretischer Wert"],Text["Gemessener Wert"]},{Text["(Subscript[ω, oben, Ι])"],NumberForm[(Subscript[ω, oben,I,theor]),3]±NumberForm[(Subscript[Δω, oben,I,theor]),1],NumberForm[(Subscript[ω, oben,I]),3]±NumberForm[(Subscript[Δω, oben,I]),1]},{Text["(Subscript[ω, oben, ΙΙ])"],NumberForm[(Subscript[ω, oben,II,theor]),1]±NumberForm[(Subscript[Δω, oben,II,theor]),1],NumberForm[(Subscript[ω, oben,II]),3]±NumberForm[(Subscript[Δω, oben,II]),1]}},Frame->All]

Wir stellen fest, daß insbesondere der relative Fehler auf (Subscript[ω, oben,ΙΙ]) sehr groß ist, nichtsdestoweniger alle Werte innerhalb ihrer Fehlergrenzen übereinstimmen.

Kopplungsgrad

Nun berechnen wir den Kopplungsgrad aus den gemessenen Frequenzen:

(Subscript[κ, oben])=((((Subscript[ω, oben,2])^2)-((Subscript[ω, oben,1])^2))/(((Subscript[ω, oben,2])^2)+((Subscript[ω, oben,1])^2)))

Mit Gauß’scher Fehlerfortpflanzung ergibt sich

(Subscript[Δκ, oben])=((4(Subscript[ω, oben,1]) (Subscript[ω, oben,2]))/(((((Subscript[ω, oben,2])^2)+((Subscript[ω, oben,1])^2)))^2))(Sqrt[((((Subscript[ω, oben,1])(Subscript[Δω, oben,2])))^2)+((((Subscript[ω, oben,2])(Subscript[Δω, oben,1])))^2)])

Auch hier ist der relative Fehler sehr groß. Wir können mit diesem Ergebnis lediglich die Größenordnung von κ einschätzen.

Mittelstarke Kopplung (Aufhängung in der Mitte)

Hinweis: Alle Rechnungen gleichen denen unter »Schwache Kopplung«, daher wurde auf redundante Kommentierung verzichtet.

Die Aufhängung der Feder befand sich hier bei

(Subscript[l, mitte])=Quantity[15.5,"Centimeters"]

(Subscript[Δl, mitte])=Quantity[0.1,"Centimeters"]

Wir importieren zunächst wieder die Rohdaten:

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-mitte-antisymmetrisch.txt","Table"]];

(Subscript[gekoppelt, mitte,asym,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, mitte,asym,2])=Transpose[{time,p2}];

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-mitte-symmetrisch.txt","Table"]];

(Subscript[gekoppelt, mitte,sym,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, mitte,sym,2])=Transpose[{time,p2}];

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-mitte-schwebung.txt","Table"]];

(Subscript[gekoppelt, mitte,schweb,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, mitte,schweb,2])=Transpose[{time,p2}];

ListPlot[{ (Subscript[gekoppelt, mitte,sym,1]),(Subscript[gekoppelt, mitte,sym,2])},Joined->True,ImageSize->Full]

Wir nutzen die ersten 60 Sekunden, um den störenden Ausreißer (ein Fehler des Meßgeräts) auf einfache Weise loszuwerden:

(Subscript[gekoppelt, mitte,sym,1])=Select[(Subscript[gekoppelt, mitte,sym,1]),#[[1]]≤60&];

(Subscript[gekoppelt, mitte,sym,2])=Select[(Subscript[gekoppelt, mitte,sym,2]),#[[1]]≤60&];

Wir bestimmen (Subscript[ω, mitte,1]).

(max_(mitte,sym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,sym,1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(mitte,sym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,sym,1]),3,1],minQ[#]&]],#[[2]]<0&]

(max_(mitte,sym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,sym,2]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(mitte,sym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,sym,2]),3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, mitte,1])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(mitte,sym,1)),(min_(mitte,sym,1)),(max_(mitte,sym,2)),(min_(mitte,sym,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, mitte,1])=Mean[(Subscript[periods, mitte,1])];(Subscript[ΔT, mitte,1])=StandardDeviation[(Subscript[periods, mitte,1])];

(Subscript[ω, mitte,1])=((2π)/(Subscript[T, mitte,1]))//N

(Subscript[Δω, mitte,1])=((2π (Subscript[ΔT, mitte,1]))/((Subscript[T, mitte,1])^2))//N

Antisymmetrische Schwingung

ListPlot[{ (Subscript[gekoppelt, mitte,asym,1]),(Subscript[gekoppelt, mitte,asym,2])},Joined->True,ImageSize->Full]

Wir nutzen wieder die ersten 60 Sekunden, um nicht durch Dämpfungseffekte ein zur symmetrischen Messung widersprüchliches Ergebnis zu erhalten.

(Subscript[gekoppelt, mitte,asym,1])=Select[(Subscript[gekoppelt, mitte,asym,1]),#[[1]]≤60&];

(Subscript[gekoppelt, mitte,asym,2])=Select[(Subscript[gekoppelt, mitte,asym,2]),#[[1]]≤60&];

Nun bestimmen wir die Frequenz (Subscript[ω, mitte,2]) anhand der Daten von beiden Pendeln.

(max_(mitte,asym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,asym,1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(mitte,asym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,asym,1]),3,1],minQ[#]&]],#[[2]]<0&]

(max_(mitte,asym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,asym,2]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(mitte,asym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, mitte,asym,2]),3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, mitte,2])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(mitte,asym,1)),(min_(mitte,asym,1)),(max_(mitte,asym,2)),(min_(mitte,asym,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, mitte,2])=Mean[(Subscript[periods, mitte,2])];(Subscript[ΔT, mitte,2])=StandardDeviation[(Subscript[periods, mitte,2])];

(Subscript[ω, mitte,2])=((2π)/(Subscript[T, mitte,2]))//N

(Subscript[Δω, mitte,2])=((2π (Subscript[ΔT, mitte,2]))/((Subscript[T, mitte,2])^2))//N

Schwebung

ListPlot[ (Subscript[gekoppelt, mitte,schweb,1]),Joined->True,ImageSize->Full]

ListPlot[ (Subscript[gekoppelt, mitte,schweb,2]),Joined->True,ImageSize->Full,PlotStyle->Red]

Da die Schwebung das Vorzeichen der Schwingung umkehrt, ist es am besten, zur Bestimmung von (Subscript[ω, mitte,Ι]) nur einen Schwebungsblock zu nutzen. Wir wählen vom ersten Pendeln die ersten 15 Sekunden und vom zweiten Pendel die Sekunden 10 bis 25. Zur Bestimmung der Schwebungsfrequenz (Subscript[ω, mitte,ΙΙ]) wählen wir manuell (mithilfe der graphischen Funktion »Get Coordinates«) Schwebungspeaks aus und ermitteln deren Differenzen, und erhalten wieder das Doppelte der Frequenz wegen der Orientierung der Einhüllenden.

Zunächst ermitteln wir (Subscript[ω, mitte,ΙΙ]):

(Subscript[peaks, mitte,schweb,1])={{8.869,2.119},{29.25,1.799},{50.35,1.448},{70.97,1.189},{91.71,0.9527}}

(Subscript[peaks, mitte,schweb,2])={{18.76,1.988},{39.98,1.644},{60.84,1.323},{81.58,1.076},{101.8,0.8447}}

(Subscript[periods, mitte,II])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(Subscript[peaks, mitte,schweb,1]),(Subscript[peaks, mitte,schweb,2])})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, mitte,II])=Mean[(Subscript[periods, mitte,II])];(Subscript[ΔT, mitte,II])=StandardDeviation[(Subscript[periods, mitte,II])];

(Subscript[ω, mitte,II])=(π/(Subscript[T, mitte,II]))//N

(Subscript[Δω, mitte,II])=((π (Subscript[ΔT, mitte,II]))/((Subscript[T, mitte,II])^2))//N

Nun bestimmen wir (Subscript[ω, mitte,Ι]):

(max_(mitte,schweb,1))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, mitte,schweb,1]),#[[1]]≤15&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(mitte,schweb,1))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, mitte,schweb,1]),#[[1]]≤15&],3,1],minQ[#]&]],#[[2]]<0&]

(max_(mitte,schweb,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, mitte,schweb,2]),10≤#[[1]]&&#[[1]]≤25&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(mitte,schweb,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, mitte,schweb,2]),10≤#[[1]]&&#[[1]]≤25&],3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, mitte,I])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(mitte,schweb,1)),(min_(mitte,schweb,1)),(max_(mitte,schweb,2)),(min_(mitte,schweb,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, mitte,I])=Mean[(Subscript[periods, mitte,I])];(Subscript[ΔT, mitte,I])=StandardDeviation[(Subscript[periods, mitte,I])];

(Subscript[ω, mitte,I])=((2π)/(Subscript[T, mitte,I]))//N

(Subscript[Δω, mitte,I])=((2π (Subscript[ΔT, mitte,I]))/((Subscript[T, mitte,I])^2))//N

Vergleich der Frequenzen

(Subscript[ω, mitte,I,theor])=(1/2)((Subscript[ω, mitte,1])+(Subscript[ω, mitte,2]))

(Subscript[Δω, mitte,I,theor])=(1/2)((Subscript[Δω, mitte,1])+(Subscript[Δω, mitte,2]))

(Subscript[ω, mitte,II,theor])=(1/2)((Subscript[ω, mitte,2])-(Subscript[ω, mitte,1]))

(Subscript[Δω, mitte,II,theor])=(1/2)((Subscript[Δω, mitte,2])+(Subscript[Δω, mitte,1]))

Grid[{{Null,Text["Theoretischer Wert"],Text["Gemessener Wert"]},{Text["(Subscript[ω, mitte, Ι])"],NumberForm[(Subscript[ω, mitte,I,theor]),3]±NumberForm[(Subscript[Δω, mitte,I,theor]),1],NumberForm[(Subscript[ω, mitte,I]),3]±NumberForm[(Subscript[Δω, mitte,I]),1]},{Text["(Subscript[ω, mitte, ΙΙ])"],NumberForm[(Subscript[ω, mitte,II,theor]),2]±NumberForm[(Subscript[Δω, mitte,II,theor]),1],NumberForm[(Subscript[ω, mitte,II]),3]±NumberForm[(Subscript[Δω, mitte,II]),1]}},Frame->All]

Kopplungsgrad

(Subscript[κ, mitte])=((((Subscript[ω, mitte,2])^2)-((Subscript[ω, mitte,1])^2))/(((Subscript[ω, mitte,2])^2)+((Subscript[ω, mitte,1])^2)))

(Subscript[Δκ, mitte])=((4(Subscript[ω, mitte,1]) (Subscript[ω, mitte,2]))/(((((Subscript[ω, mitte,2])^2)+((Subscript[ω, mitte,1])^2)))^2))(Sqrt[((((Subscript[ω, mitte,1])(Subscript[Δω, mitte,2])))^2)+((((Subscript[ω, mitte,2])(Subscript[Δω, mitte,1])))^2)])

Starke Kopplung (Aufhängung unten)

Die Aufhängung der Feder befand sich hier bei

(Subscript[l, unten])=Quantity[30.5,"Centimeters"]

(Subscript[Δl, unten])=Quantity[0.1,"Centimeters"]

Wir importieren zunächst wieder die Rohdaten:

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-unten-antisymmetrisch.txt","Table"]];

(Subscript[gekoppelt, unten,asym,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, unten,asym,2])=Transpose[{time,p2}];

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-unten-symmetrisch.txt","Table"]];

(Subscript[gekoppelt, unten,sym,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, unten,sym,2])=Transpose[{time,p2}];

{time,p1,p2}=Transpose[Import["/Users/jannis/Dropbox/uniself/AP2/221 gekoppelte Pendel/gekoppelt-unten-schwebung.txt","Table"]];

(Subscript[gekoppelt, unten,schweb,1])=Transpose[{time,p1}];

(Subscript[gekoppelt, unten,schweb,2])=Transpose[{time,p2}];

ListPlot[{ (Subscript[gekoppelt, unten,sym,1]),(Subscript[gekoppelt, unten,sym,2])},Joined->True,ImageSize->Full]

Da hier gerade am Anfang einige störende Ausreißer aufgetreten sind, nutzen wir die Sekunden 25 bis 80.

(Subscript[gekoppelt, unten,sym,1])=Select[(Subscript[gekoppelt, unten,sym,1]),25≤#[[1]]&&#[[1]]≤80&];

(Subscript[gekoppelt, unten,sym,2])=Select[(Subscript[gekoppelt, unten,sym,2]),25≤#[[1]]&&#[[1]]≤80&];

Wir bestimmen (Subscript[ω, unten,1]).

(max_(unten,sym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,sym,1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,sym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,sym,1]),3,1],minQ[#]&]],#[[2]]<0&]

(max_(unten,sym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,sym,2]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,sym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,sym,2]),3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, unten,1])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(unten,sym,1)),(min_(unten,sym,1)),(max_(unten,sym,2)),(min_(unten,sym,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, unten,1])=Mean[(Subscript[periods, unten,1])];(Subscript[ΔT, unten,1])=StandardDeviation[(Subscript[periods, unten,1])];

(Subscript[ω, unten,1])=((2π)/(Subscript[T, unten,1]))//N

(Subscript[Δω, unten,1])=((2π (Subscript[ΔT, unten,1]))/((Subscript[T, unten,1])^2))//N

Antisymmetrische Schwingung

ListPlot[{ (Subscript[gekoppelt, unten,asym,1]),(Subscript[gekoppelt, unten,asym,2])},Joined->True,ImageSize->Full]

Wir nutzen die ersten 75 Sekunden.

(Subscript[gekoppelt, unten,asym,1])=Select[(Subscript[gekoppelt, unten,asym,1]),#[[1]]≤75&];

(Subscript[gekoppelt, unten,asym,2])=Select[(Subscript[gekoppelt, unten,asym,2]),#[[1]]≤75&];

Nun bestimmen wir die Frequenz (Subscript[ω, unten,2]) anhand der Daten von beiden Pendeln.

(max_(unten,asym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,asym,1]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,asym,1))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,asym,1]),3,1],minQ[#]&]],#[[2]]<0&]

(max_(unten,asym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,asym,2]),3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,asym,2))=Select[Map[#[[2]]&,Select[Partition[(Subscript[gekoppelt, unten,asym,2]),3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, unten,2])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(unten,asym,1)),(min_(unten,asym,1)),(max_(unten,asym,2)),(min_(unten,asym,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, unten,2])=Mean[(Subscript[periods, unten,2])];(Subscript[ΔT, unten,2])=StandardDeviation[(Subscript[periods, unten,2])];

(Subscript[ω, unten,2])=((2π)/(Subscript[T, unten,2]))//N

(Subscript[Δω, unten,2])=((2π (Subscript[ΔT, unten,2]))/((Subscript[T, unten,2])^2))//N

Schwebung

ListPlot[ (Subscript[gekoppelt, unten,schweb,1]),Joined->True,ImageSize->Full]

ListPlot[ (Subscript[gekoppelt, unten,schweb,2]),Joined->True,ImageSize->Full,PlotStyle->Red]

Zunächst ermitteln wir (Subscript[ω, unten,ΙΙ]):

(Subscript[peaks, unten,schweb,1])={{3.522,2.642},{11.92,2.548},{20.52,2.396},{28.61,2.266},{37.62,2.125},{45.71,2.007},{53.9,1.878},{61.88,1.725},{70.89,1.596},{78.98,1.502},{87.99,1.361}}

(Subscript[peaks, unten,schweb,2])={{7.925,-2.756},{16.42,2.268},{24.61,2.151},{32.8,2.022},{41.92,-2.182},{50.01,-2.03},{58.61,-1.925},{66.9,1.565},{74.99,1.413},{83.18,1.26}}

(Subscript[periods, unten,II])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(Subscript[peaks, unten,schweb,1]),(Subscript[peaks, unten,schweb,2])})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, unten,II])=Mean[(Subscript[periods, unten,II])];(Subscript[ΔT, unten,II])=StandardDeviation[(Subscript[periods, unten,II])];

(Subscript[ω, unten,II])=(π/(Subscript[T, unten,II]))//N

(Subscript[Δω, unten,II])=((π (Subscript[ΔT, unten,II]))/((Subscript[T, unten,II])^2))//N

Nun bestimmen wir (Subscript[ω, unten,Ι]). Dazu nutzen wir die ersten zwei Blöcke des ersten Pendels (0-5 s und 10-15 s) und den ersten Block des zweiten Pendels (5-10 s):

(max_(unten,schweb,1,1))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, unten,schweb,1]),#[[1]]≤5&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,schweb,1,1))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, unten,schweb,1]),#[[1]]≤5&],3,1],minQ[#]&]],#[[2]]<0&]

(max_(unten,schweb,1,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, unten,schweb,1]),10≤#[[1]]≤15&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,schweb,1,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, unten,schweb,1]),10≤#[[1]]≤15&],3,1],minQ[#]&]],#[[2]]<0&]

(max_(unten,schweb,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, unten,schweb,2]),5≤#[[1]]&&#[[1]]≤10&],3,1],maxQ[#]&]],#[[2]]>0&]

(min_(unten,schweb,2))=Select[Map[#[[2]]&,Select[Partition[Select[(Subscript[gekoppelt, unten,schweb,2]),5≤#[[1]]&&#[[1]]≤10&],3,1],minQ[#]&]],#[[2]]<0&]

(Subscript[periods, unten,I])=Select[Flatten[Differences/@(Part[#,All,1]&/@{(max_(unten,schweb,1,1)),(min_(unten,schweb,1,1)),(max_(unten,schweb,1,2)),(min_(unten,schweb,1,2)),(max_(unten,schweb,2)),(min_(unten,schweb,2))})],#>1&]//Quantity[#,"Seconds"]&

(Subscript[T, unten,I])=Mean[(Subscript[periods, unten,I])];(Subscript[ΔT, unten,I])=StandardDeviation[(Subscript[periods, unten,I])];

(Subscript[ω, unten,I])=((2π)/(Subscript[T, unten,I]))//N

(Subscript[Δω, unten,I])=((2π (Subscript[ΔT, unten,I]))/((Subscript[T, unten,I])^2))//N

Vergleich der Frequenzen

(Subscript[ω, unten,I,theor])=(1/2)((Subscript[ω, unten,1])+(Subscript[ω, unten,2]))

(Subscript[Δω, unten,I,theor])=(1/2)((Subscript[Δω, unten,1])+(Subscript[Δω, unten,2]))

(Subscript[ω, unten,II,theor])=(1/2)((Subscript[ω, unten,2])-(Subscript[ω, unten,1]))

(Subscript[Δω, unten,II,theor])=(1/2)((Subscript[Δω, unten,2])+(Subscript[Δω, unten,1]))

Grid[{{Null,Text["Theoretischer Wert"],Text["Gemessener Wert"]},{Text["(Subscript[ω, unten, Ι])"],NumberForm[(Subscript[ω, unten,I,theor]),3]±NumberForm[(Subscript[Δω, unten,I,theor]),1],NumberForm[(Subscript[ω, unten,I]),2]±NumberForm[(Subscript[Δω, unten,I]),1]},{Text["(Subscript[ω, unten, ΙΙ])"],NumberForm[(Subscript[ω, unten,II,theor]),2]±NumberForm[(Subscript[Δω, unten,II,theor]),1],NumberForm[(Subscript[ω, unten,II]),2]±NumberForm[(Subscript[Δω, unten,II]),1]}},Frame->All]

Kopplungsgrad

(Subscript[κ, unten])=((((Subscript[ω, unten,2])^2)-((Subscript[ω, unten,1])^2))/(((Subscript[ω, unten,2])^2)+((Subscript[ω, unten,1])^2)))

(Subscript[Δκ, unten])=((4(Subscript[ω, unten,1]) (Subscript[ω, unten,2]))/(((((Subscript[ω, unten,2])^2)+((Subscript[ω, unten,1])^2)))^2))(Sqrt[((((Subscript[ω, unten,1])(Subscript[Δω, unten,2])))^2)+((((Subscript[ω, unten,2])(Subscript[Δω, unten,1])))^2)])

Verhältnisse der Kopplungsgrade

Die angegebene Näherung für die Kopplungsquadrate impliziert, daß sich die Verhältnisse der Kopplungsgrade wie die Verhältnisse der Längenquadrate verhalten.

Oben–Mitte

(Subscript[V, oben,mitte])=((Subscript[κ, oben])/(Subscript[κ, mitte]))

(Subscript[ΔV, oben,mitte])=(Sqrt[(((((Subscript[Δκ, oben])/(Subscript[κ, mitte]))))^2)+((((((Subscript[κ, oben])(Subscript[Δκ, mitte]))/((Subscript[κ, mitte])^2))))^2)])

(Subscript[V, oben,mitte,approx])=(((Subscript[l, oben])^2)/((Subscript[l, mitte])^2))

(Subscript[ΔV, oben,mitte,approx])=(Sqrt[(((((2(Subscript[l, oben])(Subscript[Δl, oben]))/((Subscript[l, mitte])^2))))^2)+(((((2((Subscript[l, oben])^2)(Subscript[Δl, mitte]))/((Subscript[l, mitte])^3))))^2)])

Grid[{{Text["Verhältnis"],Text["aus Frequenzmessung"],Text["aus Längenmessung"]},{Text["((Subscript[κ, oben])/(Subscript[κ, mitte]))"],NumberForm[(Subscript[V, oben,mitte]),1]±NumberForm[(Subscript[ΔV, oben,mitte]),1],NumberForm[(Subscript[V, oben,mitte,approx]),3]±NumberForm[(Subscript[ΔV, oben,mitte,approx]),1]}},Frame->All]

Hier läßt sich tatsächlich nicht viel sagen, da der Fehler auf das Verhältnis dank großer Frequenzmeßfehler so groß ist wie das Verhältnis selbst.

Oben–Unten

(Subscript[V, oben,unten])=((Subscript[κ, oben])/(Subscript[κ, unten]))

(Subscript[ΔV, oben,unten])=(Sqrt[(((((Subscript[Δκ, oben])/(Subscript[κ, unten]))))^2)+((((((Subscript[κ, oben])(Subscript[Δκ, unten]))/((Subscript[κ, unten])^2))))^2)])

(Subscript[V, oben,unten,approx])=(((Subscript[l, oben])^2)/((Subscript[l, unten])^2))

(Subscript[ΔV, oben,unten,approx])=(Sqrt[(((((2(Subscript[l, oben])(Subscript[Δl, oben]))/((Subscript[l, unten])^2))))^2)+(((((2((Subscript[l, oben])^2)(Subscript[Δl, unten]))/((Subscript[l, unten])^3))))^2)])

Grid[{{Text["Verhältnis"],Text["aus Frequenzmessung"],Text["aus Längenmessung"]},{Text["((Subscript[κ, oben])/(Subscript[κ, unten]))"],NumberForm[(Subscript[V, oben,unten]),1]±NumberForm[(Subscript[ΔV, oben,unten]),1],NumberForm[(Subscript[V, oben,unten,approx]),2]±NumberForm[(Subscript[ΔV, oben,unten,approx]),1]}},Frame->All]

Auch hier haben wir einen sehr großen Fehler bei dem Wert, der sich aus der Frequenzmessung ergibt, und können daher kaum etwas über die Qualität der Approximation aussagen.

Mitte–Unten

(Subscript[V, mitte,unten])=((Subscript[κ, mitte])/(Subscript[κ, unten]))

(Subscript[ΔV, mitte,unten])=(Sqrt[(((((Subscript[Δκ, mitte])/(Subscript[κ, unten]))))^2)+((((((Subscript[κ, mitte])(Subscript[Δκ, unten]))/((Subscript[κ, unten])^2))))^2)])

(Subscript[V, mitte,unten,approx])=(((Subscript[l, mitte])^2)/((Subscript[l, unten])^2))

(Subscript[ΔV, mitte,unten,approx])=(Sqrt[(((((2(Subscript[l, mitte])(Subscript[Δl, mitte]))/((Subscript[l, unten])^2))))^2)+(((((2((Subscript[l, mitte])^2)(Subscript[Δl, unten]))/((Subscript[l, unten])^3))))^2)])

Grid[{{Text["Verhältnis"],Text["aus Frequenzmessung"],Text["aus Längenmessung"]},{Text["((Subscript[κ, mitte])/(Subscript[κ, unten]))"],NumberForm[(Subscript[V, mitte,unten]),1]±NumberForm[(Subscript[ΔV, mitte,unten]),1],NumberForm[(Subscript[V, mitte,unten,approx]),3]±NumberForm[(Subscript[ΔV, mitte,unten,approx]),1]}},Frame->All]

Hier haben wir Werte, die zumindest im 1σ-Bereich zur Deckung kommen. Sehr aufschlußreich ist diese Aussage indes auch nicht.