Maxima in Messdaten finden < Mathematica < Mathe-Software < Mathe < Vorhilfe
|
| Aufgabe | | Die Aplitudenwerte der Spannungsabfälle an C und R sind sowohl aus der simulierten, als auch aus den reellen Daten in einem halblogarithmischen Plot (lnU - t) als Funktion der Zeit darzustellen. Die Steigung bestimmt die Dämpungskonstante γ. Vergleichen Sie die simulierten und gemessen Daten mit den theoretischen, welche aus (3) berechnet werden können |
Ich habe einige Messdaten eines Oszilloskopes, das mit einem Schwingungssignal gespeist wird (U-t Diagramm). Ich wollte nun fragen, ob es eine schnelle Methode gibt, alle lokalen Maxima (Die Peaks) inklusive ihrer t-koordinate herauszufinden.
Das fitten der Werte mit der zu erwartenden Kurve funktioniert nicht, da die Fit-Kurve sich nicht genug angleicht (zu viele Messpunkte). Ich habe bereits Funktionen in Wolfram Mathematica versucht, aber es wird nur der erste Maximalwert ausgegeben, ohne zugehörigen Zeitwert.
Muss ich jetzt etwa alle Werte einzeln finden? Vielen dank schon mal.
Ich habe diese Frage in keinem Forum auf anderen Internetseiten gestellt.
|
|
| |
|
Hallo,
ich nehme mal den "worst case" an, dass die Daten zeitlich nicht regelmäßig (nicht äquidistant) erhoben wurden und etwas verrauscht sind:
f=Sin[#1]^2 Exp[-(#1/(2 \[Pi]))]&;data=SortBy[Transpose[({#1,f[#1] RandomReal[{.95,1.05},Length[#1]]}&)[RandomReal[{0,8 \[Pi]},1234]]],First];das schauen wir uns mal näher an (der Wert 20 in der Funktion MovingAverage sollte bei weniger bzw. genaueren Messpunkten etwas niedriger gewählt werden):
lp=With[{nmax=10},ListPlot[{data,d2=MovingAverage[data,20]},PlotRange->All,PlotStyle->AbsolutePointSize[1],Joined->{False,True},Axes->None,Frame->True,PlotLabel->Style["verrauschte Messwerte",12,Darker[Blue]],ImageSize->Large]]das Bild ist im ![[a]](/images/paperclip.gif "Dateianhänge") angehängten Notebook zu finden.
Maxima zeichnen sich dadurch aus, dass die benachbarten Messpunkte eine geringete Spannung enthalten. Durch das verrauschte Signal bekommt man viel zu viele Maxima, aber die werden im Schritt darauf reduziert:
| 1: | Length[maxima=Select[Partition[d2,3,1],#[[1,2]]<#[[2,2]]>#[[3,2]]&][[All,2]]]
| | 2: | 18 |
Pi mal Auge enthält der Plot der Messwerte acht Maxima. Lassen wir also Mathematica die "Scheinmaxima" zusammenfassen:
| 1: | clustermax=Mean/@FindClusters[maxima,8,DistanceFunction->(Norm[#1-#2]&),Method->"Agglomerate"]
| | 2: | {{1.59497,0.566079},{4.58668,0.321462},{7.77472,0.176319},{11.0908,0.115498},{14.4754,0.0652534},{17.2942,0.040673},{20.2576,0.0266313},{23.6505,0.0163898}} |
Kurze Plausibilitätsprüfung:
Show[lp,Graphics[{Red,AbsolutePointSize[4],Point@clustermax}],PlotLabel->Style["Messwerte und ungefähre Maxima",Darker@Blue]](Bild wie gehabt im Anhang)
Den halblogarithmischen Plot erhält man wie üblich per:
logmaxplot=ListLogPlot[maxima,Joined->True,InterpolationOrder->3,Epilog->{Red,Point[MapAt[Log,#,2]&/@clustermax]},AxesLabel->{"t",TraditionalForm[Log[Subscript[U, max]]]},PlotStyle->{Thick,GrayLevel@.6}](Bild: Anhang)
Das Maximum an sich fühlt sich wohl, wo die erste Ableitung verschwindet und die zwote kleiner als Null ist:
| 1: | exakt=SortBy[x/. {ToRules[Reduce[(f^\[Prime]\[Prime])[x]<(f^\[Prime])[x]==0<=x<=8 \[Pi],x]]},N];
| | 2: | InputForm[exakt]
| | 3: | N[exakt]
| | 4: | {2*ArcTan[(-1 + Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 5: | 2*Pi + 2*ArcTan[(-1 - Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 6: | 2*Pi + 2*ArcTan[(-1 + Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 7: | 4*Pi + 2*ArcTan[(-1 - Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 8: | 4*Pi + 2*ArcTan[(-1 + Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 9: | 6*Pi + 2*ArcTan[(-1 - Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 10: | 6*Pi + 2*ArcTan[(-1 + Sqrt[1 + 16*Pi^2])/(4*Pi)],
| | 11: | 8*Pi + 2*ArcTan[(-1 - Sqrt[1 + 16*Pi^2])/(4*Pi)]}
| | 12: | {1.49139,4.63298,7.77457,10.9162,14.0578,17.1993,20.3409,23.4825} |
Die Ausgleichgerade durch die exakten Werte dauert ein Weilchen:
| 1: | In[14]:= logmaxgerade[t_] = Collect[InterpolatingPolynomial[
| | 2: | Transpose[{exakt[[1 ;; 2]], Log[f[exakt[[1 ;; 2]]]]}], t], t,
| | 3: | FullSimplify[TrigToExp[#1], t > 0] & ]
| | 4: | Out[14]= -(t/(2*Pi)) + (Pi*ArcCot[4*Pi] - 2*ArcCot[(4*Pi)/(1 + Sqrt[1 + 16*Pi^2])]*
| | 5: | ArcTan[(4*Pi)/(-1 + Sqrt[1 + 16*Pi^2])] +
| | 6: | 2*ArcCot[(4*Pi)/(-1 + Sqrt[1 + 16*Pi^2])]*
| | 7: | ArcTan[(4*Pi)/(1 + Sqrt[1 + 16*Pi^2])])/Pi^2 + Log[1 + 1/(-1 - 16*Pi^2)]
|
da haben wir also [mm]k=-\frac{1}{2 \pi}[/mm] (passt ja zu [mm]f(t)[/mm]).
| 1: | logmaxgerade[t]//N
| | 2: | -0.00631261-0.159155 t |
Die Ausgleichsgerade durch die aus der Messung ermittelten Maxima geht wesentlich schneller:
| 1: | logmessmaxgerade[t_]=Fit[MapAt[Log,#,2]&/@clustermax,{1,t},t]
| | 2: | -0.0215603-0.15908 t |
Ein Fit funktioniert auch bei diesem Beispiel mit über 1000 Messwerten 1a:
| 1: | (nlf=NonlinearModelFit[data,Exp[a t]Sin[b t]^2,{a,b},t])//Normal
| | 2: | E^(-0.159023 t) Sin[0.999928 t]^2 |
und damit lassen sich auch Maxima bestimmen:
| 1: | FindMaximum[nlf[t],{t,#}]&/@clustermax[[All,1]]//Column
| | 2: | {{0.783884,{t->1.49155}}
| | 3: | {0.47563,{t->4.63337}}
| | 4: | {0.288593,{t->7.77519}}
| | 5: | {0.175107,{t->10.917}}
| | 6: | {0.106248,{t->14.0588}}
| | 7: | {0.0644671,{t->17.2006}}
| | 8: | {0.0391161,{t->20.3425}}
| | 9: | {0.0237341,{t->23.4843}}
|
Soweit erst mal.
Gruß,
Peter
Dateianhänge:
Anhang Nr. 1 (Typ: nb) [nicht öffentlich]
|
|
|
|
