Laplace-transzformáció

Alapvető tulajdonságok, szimbolikusan

LaplaceTransform[x'[t],t,p]

LaplaceTransform[x'[t],t,p]/.{LaplaceTransform[x[t],t,p]->X[p]}

LaplaceTransform[x''[t],t,p]/.{LaplaceTransform[x[t],t,p]->X[p]}

LaplaceTransform[α x[t]+β y[t] ,t,p]/.{LaplaceTransform[x[t],t,p]->X[p],LaplaceTransform[y[t],t,p]->Y[p]}

1. HF.: Nem lehetne egszerűen nagybetűsíteni? ToUpperCase

LaplaceTransform[x''[t],t,p]/.{LaplaceTransform[x[t],t,p]->X[p]}

LaplaceTransform[(∫_0^t)f[s]g[t-s]\[DifferentialD]s,t,p](*konvolúció*)

LaplaceTransform[(∫_0^t)x[s]\[DifferentialD]s,t,p]/.{LaplaceTransform[x[t],t,p]->X[p]}

LaplaceTransform[x[t-1],t,p]/.{LaplaceTransform[x[t],t,p]->X[p]}

%/.{x[t]->φ[t]}

Többváltozós:

LaplaceTransform[(((x y))^2) (E^(-x +y)),{x ,y},{p,s}]

Tallán ez is alkalmazható PDE megoldására.

Alkalmazásai

Lineáris egyenletek

egy = y'[x] == 2 x - y[x];kezd=y[0]==1;

lt=LaplaceTransform[egy,x,p]/.{LaplaceTransform[y[x],x,p]->Y[p]}

Solve[lt,Y[p]]/.{y[0]->1}

InverseLaplaceTransform[%,p,x][[1,1,2]]

Solve[lt, Y[p]] /. Rule@@kezd

InverseLaplaceTransform[%,p,x][[1,1,2]]

2. HF.: Mit is csináljunk, ha a kezdeti feltétel nem a nullában van megadva? Mutassunk erre példát!

kezd1 = y[3] == -3; kezd2 = y[2] == -3;

Lineáris rendszerek

lte=LaplaceTransform[{x'[t]==-x[t]+8y[t],y'[t]==x[t]+y[t]},t,p]/.{LaplaceTransform[x[t],t,p]->X[p],LaplaceTransform[y[t],t,p]->Y[p]}

sol=Solve[lte,{X[p],Y[p]}]

InverseLaplaceTransform[sol,p,t]

InverseLaplaceTransform[sol,p,t]/.{InverseLaplaceTransform[X[p],p,t]->x[t],InverseLaplaceTransform[Y[p],p,t]->y[t]}

kif=%/.{x[0]->1,y[0]->-2}

3. HF.: Hogyan lehetne ch és sh segítségével fölírni?

Konvolúciós egyenletek

kon=LaplaceTransform[t==Integrate[(E^(t-s))x[s],{s,0,t}],t,p]/.LaplaceTransform[x[t],t,p]->X[p]

skon=Solve[kon,X[p]][[1]]

InverseLaplaceTransform[skon,p,t]/.InverseLaplaceTransform[X[p],p,t]->x[t]

Ellenőrzés:

Integrate[(E^(t-s))x[s],{s,0,t}]/.(%/.t->s)

5. HF.: Oldjuk meg ezeket is. Az eredmény behelyettesítéssel ellenőrzendő.

x[t]==Sin[t]+(∫_0^t)Cos[t-s]x[s]ds

(∫_0^t)x[t-s]x[s]ds==(∫_0^t)x'[t-s]x'[s]ds     x[0]==1

6. HF.: Csináljuk programot, amely automatikusan megold egy egyenletet Laplace-transzfomációval.

Késleltetett egyenletek

Manipulate[Module[{sol,y,t},sol=First[y/.NDSolve[{y'[t]==λ y[t]+μ y[t-1],y[t/;t≤0]==1-t},y,{t,0,10}]];If[pp,ParametricPlot[{sol[t],sol[t-1]},{t,1,10},PlotRange-> {{-3,3},{-3,3}}],Plot[sol[t],{t,0,10},PlotRange->{{0,10},{-3,3}}]]],{{pp,False,"Plot in the phase plane"},{True,False}},{{λ,-1},-5,5},{{μ,1},-5,5},FrameLabel->ToString[y'[t]==λ y[t]+μ y[t-1],TraditionalForm]]

eq=y'[t]==λ y[t]+μ y[t-1];

si=Simplify[LaplaceTransform[eq,t,p]/.{LaplaceTransform[y[t],t,p]->Y[p]},Assumptions->If[t≤0,y[t]->1-t]]

lapeq=si/.{y[t]->1-t}/.y[0]->1

lapsol=Solve[lapeq,Y[p]][[1]]

ap=Apart[lapsol][[1,2]]

ap[[1]]

InverseLaplaceTransform[ap[[1]],p,t]

ilt2=InverseLaplaceTransform[lapsol,p,t]

InverseLaplaceTransform[lapsol/.{λ->0},p,t]

InverseLaplaceTransform[lapsol/.{μ->0},p,t]

InverseLaplaceTransform[ap/.{(E^p)->1},p,t]

InverseLaplaceTransform[ap/.{(E^p)->1+p},p,t]

InverseLaplaceTransform[ap/.{(E^p)->1+p+(p^2)/2},p,t]

Normal[Series[ap,{p,0,3}]]

7. Keressünk vagy gyártsunk szimbolikusna megoldható késleltetett egyenletet. Mire használhatók ezek az egyenletek?

Parciális differenciálegyenletek

pde=LaplaceTransform[D[u[t,x],t]==D[u[t,x],{x,2}],t,p]/.{LaplaceTransform[u[t,x],t,p]->U[p,x],LaplaceTransform[Derivative[0,xn_][u][t,x],t,p]->D[U[p,x],{x,xn}]}

-u[0,x]+p U[p,x]==Derivative[0,2][U][p,x]

ds=DSolve[{pde/.{u[0,x]->3Sin[2π x]},U[p,0]==0,U[p,1]==0},U[p,x],x][[1]]

InverseLaplaceTransform[ds,p,t]

ilt=InverseLaplaceTransform[ds,p,t]/.InverseLaplaceTransform[U[p,x],p,t]->u[t,x]

p3d=Plot3D[u[t,x]/.ilt,{t,0,0.1},{x,-1,1},PlotRange->All,AxesLabel->(Style[#,Bold,18]&/@{"t","x","u"})]

text=Style["Texture",128];

Plot3D[u[t,x]/.ilt,{t,0,0.1},{x,-1,1},PlotRange->All,AxesLabel->(Style[#,Bold,18]&/@{"t","x","u"}),PlotStyle->Texture[text],Lighting->"Neutral"]

Texture

im=;

Plot3D[u[t,x]/.ilt,{t,0,0.1},{x,-1,1},PlotRange->All,AxesLabel->(Style[#,Bold,18]&/@{"t","x","u"}),PlotStyle->Texture[im],Lighting->"Neutral"]

Plot3D[u[t,x]/.ilt,{t,0,0.1},{x,-1,1},PlotRange->All,AxesLabel->(Style[#,Bold,18]&/@{"t","x","u"}),PlotStyle->Texture[ExampleData[{"TestImage","Lena"}]],TextureCoordinateFunction->({#1,#2}&),Lighting->"Neutral",Mesh->None]

vtc={{0,0},{1,0},{1,1},{0,1}};
coords={{{0,0,0},{0,1,0},{1,1,0},{1,0,0}},{{0,0,0},{1,0,0},{1,0,1},{0,0,1}},{{1,0,0},{1,1,0},{1,1,1},{1,0,1}},{{1,1,0},{0,1,0},{0,1,1},{1,1,1}},{{0,1,0},{0,0,0},{0,0,1},{0,1,1}},{{0,0,1},{1,0,1},{1,1,1},{0,1,1}}};
DynamicModule[{},Graphics3D[{Dynamic[Texture[clock],UpdateInterval->1],Polygon[coords,VertexTextureCoordinates->Table[vtc,{6}]]},Lighting->"Neutral",Boxed->False],Initialization:>(clock:=Module[{hour,min,sec,ht,mt,st},{hour,min,sec}=Take[DateList[],-3];ht=Pi/2-2 π hour/12-(2 π) min/720;mt=Pi/2-2 π min/60;st=Pi/2-2 π Floor[sec]/60;Graphics[{Thick,Arrowheads[Large],Arrow[{{0,0},0.6{Cos[ht],Sin[ht]}}],Arrow[{{0,0},0.9{Cos[mt],Sin[mt]}}],PointSize[Large],Table[Point[0.9{Cos[i],Sin[i]}],{i,0,2Pi,π/6}],Point[{0,0}],Circle[],Red,Line[{{0,0},0.85{Cos[st],Sin[st]}}]}]])]

Manipulate[Plot3D[u[t,x]/.ilt,{t,0,0.1},{x,-1,1},PlotRange->All,AxesLabel->(Style[#,Bold,18]&/@{"t","x","u"}),ViewPoint->{0,0,vp}],{vp,1,13,0.1}]

Ugrásfüggvény

ClearAll[lte];
lte=LaplaceTransform[y'[x]+4y[x]==UnitStep[x],x,s]/.{LaplaceTransform[y[x],x,s]->Y[s]}

ClearAll[sol];
sol=Solve[lte,Y[s]][[1,1,2]]

ap=Apart[sol/.y[0]->2]

InverseLaplaceTransform[ap,s,x]

DSolve[{y'[x]+4y[x]==UnitStep[x],y[0]==2},y[x],x]//Simplify//Expand

Simplify[DSolve[{y'[x]+4y[x]==UnitStep[x],y[0]==2},y[x],x],Assumptions->x>0]

A Laplace-transzformáció előnyei, hátrányai

Egyszerű esetekben: csak a kezdetiérték-feladatot oldja meg, és nem az általános megoldásból választja ki az egyetlent, ami érdekel bennünket. Bonyolultabb esetekben: az ilyen feladtokat esetleg másképp nem is lehetne megoldani, illetve nagyon sokkal nehezebben menne csak a megoldásuk.

Átviteli függvény és környéke

TransferFunctionModel

Hyperlink["szab","paclet:guide/ControlSystems"]

lt=LaplaceTransform[x''[t]+3x'[t]-2x[t]==u'[t]-2u[t],t,p]/.{LaplaceTransform[x[t],t,p]->X[p],LaplaceTransform[u[t],t,p]->U[p]}/.{x[0]->0,x'[0]->0,u[0]->0}

fac=Factor[lt]

sol=Solve[fac,U[p]][[1]]

(U[p]/.sol)/X[p]

Most akkor átviteli függvény is lesz, és késleltetés is, Gábor kívánságára. Az egyenlet:

egy=A i[t-(Subscript[T, h])]==τ u'[t]+u[t]

lt1=LaplaceTransform[egy,t,s]

Az eltolt Laplace-transzformáltját mintha csak konkrét számok esetén tudná kiszámolni, ezért segtítünk neki.

lt2=lt1/.LaplaceTransform[i[t-(Subscript[T, h])],t,s]-> (E^(-π s)) (∫_(-(Subscript[T, h]))^0)(E^(-s t)) i[t]\[DifferentialD]t+(E^(-(Subscript[T, h]) s)) LaplaceTransform[i[t],t,s]

lt3=lt2/.{LaplaceTransform[i[t],t,s]->Ι[s],LaplaceTransform[u[t],t,s]->U[s],u[0]->0}

lt4=lt3/.{i[t]->0}

sol=Solve[lt4,U[s]][[1]]

((U[s])/(Ι[s]))/.sol

Ha ((U[s])/(Ι[s])) mérhető néhány s értékre, akkor ebből NonlinearModelFit segítségével becslhetők a paraméterek.

Másik megközelítés: mérjük i és u értékét néhány időpontban, és a differenciálegyenlet megoldásával becsüljük a paramétereket. Lásd pl. a FindFit függvény leírásánál.

LaplaceTransform[i[t-π],t,s]

Integrate[i[t-T](E^(-s t)),{t,-T,0}]+Integrate[i[t-T](E^(-s t)),{t,0,+∞}]

TransferFunctionModel[(StateSpaceModel[(Subscript[a, 11]), (Subscript[a, 12]), (Subscript[b, 11]), (Subscript[a, 21]), (Subscript[a, 22]), (Subscript[b, 21]), (Subscript[c, 11]), (Subscript[c, 12]), 0, ]),s]

StateSpaceModel[(TransferFunctionModel[(StateSpaceModel[(Subscript[a, 11]), (Subscript[a, 12]), (Subscript[b, 11]), (Subscript[a, 21]), (Subscript[a, 22]), (Subscript[b, 21]), (Subscript[c, 11]), (Subscript[c, 12]), 0, ]),s])]

A second-order single-input, single-output system:

StateSpaceModel[{{{(Subscript[a, 1]),(Subscript[a, 2])},{(Subscript[a, 3]),(Subscript[a, 4])}},{{(Subscript[b, 1])},{(Subscript[b, 2])}},{{(Subscript[c, 1]),(Subscript[c, 2])}}}]

StateSpaceModel[{m (Subscript[ϕ, 1])''[t]-m (Ω^2)(Subscript[ϕ, 1])[t]+((Subscript[ϕ, 1])[t]-(Subscript[ϕ, 2])[t])k/2==0,m (Subscript[ϕ, 2])''[t]-m (Ω^2)(Subscript[ϕ, 2])[t]-((Subscript[ϕ, 1])[t]-(Subscript[ϕ, 2])[t])k/2==u[t]},{{(Subscript[ϕ, 1])'[t],0},{(Subscript[ϕ, 1])[t],0},{(Subscript[ϕ, 2])[t],0},{(Subscript[ϕ, 2])'[t],0}},{{u[t],0}},{(Subscript[ϕ, 2])[t]},t]

Reaktor: ref/StateSpaceModel

Házik megoldása

Bemásolom őket, teszek néhány megjegyzést.

Holló Gábor

1. HF.: Változtassuk ImagePadding értékét, hogy rájöjjünk, mit csinál. Persze, a RandomGraph-fal nem fog menni, de a Graph-fal talán igen.

Manipulate[Graph[{1\[UndirectedEdge]2,2\[UndirectedEdge]3,3\[UndirectedEdge]1},VertexLabels->{1->,2->,3->},ImagePadding->u],{u,0,100}]

2. HF.: Definálják más módon is ezt a függvényt (Which, Switch, UnitStep, Boole, If, Condition stb.), majd ábrázolják is.

ClearAll[modellunitstep]
modellunitstep[x_]:=-31.25 x UnitStep[64-x]+10000 UnitStep[64-x]-2633 x UnitStep[-(x-64) (x-67)]+176533 UnitStep[-(x-64) (x-67)]-0.167x  UnitStep[x-67]+111.24 UnitStep[x-67]
Plot[modellunitstep[x],{x,-10,1200}]

ClearAll[modellboole]
modellboole[x_]:=-31.25 x Boole[0<=x<=64]+10000 Boole[0<=x<=64]-2633 x Boole[64<=x<=67]+176533 Boole[64<=x<=67]-0.167x  Boole[67<=x≤100]+111.24 Boole[67<=x≤100]
Plot[modellboole[x],{x,-20,130}]

ClearAll[modellwhich]
modellwhich[x_]:=Which[0<=x<=64,-31.25x+10000,64<=x<=67,-2633x+176533,67<=x≤100,-0.167x+111.24]
Plot[modellwhich[x],{x,-20,120}]

modellwhich[-20]

ClearAll[modellif]
modellif[x_]:=If[0<=x<=64,-31.25x+10000,If[64<=x<=67,-2633x+176533,-0.167x+111.24]]
Plot[modellif[x],{x,0,100}]

Az a definíció jó, amelyik a megadott intervallumon kívül nem értelmezi a függvényt. Egyes feladatoknál azonban az is megfelelő lehet, ha a függvény értéke kívül nulla.

3. HF.: Bonyolítsuk értelmes módon a rendszert (miután a modellbe általam belerakott hibákat sikerült kijavítani), és tanulmányozzuk a viselkedését. Például a fenti példában kicsi volt a melegedés, örültünk, ez volt a cél. De ha épp fűteni akarunk? És mi történik, ha az áram tekercsen vagy kondenzátoron folyik át? Kapcsolgassunk össze ilyeneket stb.

modell2[x_]:=Piecewise[{{-31.25 x+10000,0≤x≤64},{-2633 x+176533,64≤x≤67},{-0.167 x+111.24,67≤x≤100}}]

(* Ha melegszik a rendszer, akkor magas hőmérsékleten fontos lehet a hőmérsékleti sugárzás is. Tegyük bele! *)

m = 10^(-3); (* Kg *)
c=700; (* J/(Kg K) *) (* http://www.azom.com/properties.aspx?ArticleID=1114 *)
s = 5.670373 10^(−8);(* J/(s m^2 K^4 *)
n = 50; (* 1/s *)
U0 = (Sqrt[2])230; (* V *)
T0 = 273.15; (* K *)
A=100^(-2); (* m^2 *)
eps = 0.9; (* - *)
Tk = 20; (* °C *)
alfa = 1500;  (* J/(m^2 K) *)

(* Megjegyzés: alfa, a hőátadási tényező azért lett ilyen nagy, hogy meg tudjuk oldani az egyenletet. A hőmérséklet így még nem értei el a kritikus hőmérsékletet (64 °C), ahol leesik az ellenállás. Ha olyan paramétereket adok meg, hogy a hőmérséklet e fölé növekedjen, akkor nem képes megoldani az egyenletet, így viszont (64 °C alatt) még csak egy egyszerű lineáris hőmérsékletfüggéssel számolunk. *)

nds=NDSolve[{T'[t]==-alfa A/(c m)(T[t]-Tk)-eps s A  (T0+T[t])^4/(c m)+((((U0 Cos[n 2π t]))^2)/(modell2[T[t]]  c m)),T[0]==20},T,{t,0,100},MaxSteps->500000]

Plot[T[t]/.nds,{t,0,100}]

Ezek valóságosabb adatok, mint amilyeneket én adtam meg, és még a mértékegységek is stimmelnek.

4. HF.: Figyeljék meg a kétdimenziós csúszkát (Slider2D), és a súgó alapjáűn mutassanak egy-két másféle szép alkalmazást.

Hyperlink["Lissajou görbék","http://en.wikipedia.org/wiki/Lissajou"]

Manipulate[ParametricPlot[{Sin[t+d[[1]]],Sin[n t+d[[2]]]},{t,0,20Pi},PerformanceGoal->"Quality"],{d,{0,0},{Pi,Pi}},{n,1,10,0.1}]

Tóth Krisztián

1. Házi feladat

A= TableView[{{a,b},{c,d}}];

1. HF. : Változtassuk ImagePadding értékét, hogy rájöjjünk, mit csinál. Persze, a RandomGraph - fal nem fog menni, de a Graph - fal talán igen.

TableView[]

f=RandomGraph[{10,20},VertexLabels->"Name",ImagePadding->42];
e=EdgeRules[%]

Graph[e,ImagePadding->{{100,100},{10,10}}]

Graph[e,ImagePadding->2]

2. Házi Feladat

2. HF.: Definálják más módon is ezt a függvényt (Which, Switch, UnitStep, Boole, If, Condition stb.), majd ábrázolják is.

modell3[x_]:=Piecewise[{{-31.25x+10000,0<=x<=64},{-2633x+176533,64<=x<=67},{-0.167x+111.24,67<=x≤100}}]

Nem tudtam rájönni, hogy a függvényt ezekkel a beépített metódusokkal, hogy lehetne finomítani. Esetleg meg lehetne próbálni valami hibajelzés beépítéssel, ha esetleg kilépne 0-100 intervallumból, akkor jelezzen.

modell3[-2]

If[modell3[-2]==0,False, True]

Bár ez nem valami hasznos ebben a formában.

modell4[x_]:=Module[{c=Piecewise[{{-31.25x+10000,0<=x<=64},{-2633x+176533,64<=x<=67},{-0.167x+111.24,67<=x≤100}}]},If[c ==0,False,c]]

modell4[101]

modell4[-1]

modell4[50]

ClearAll[modell5];modell5[x_/;0≤x≤100]:=Piecewise[{{-31.25x+10000,0<=x<=64},{-2633x+176533,64<=x<=67},{-0.167x+111.24,67<=x≤100}}]

modell5[-2]

3. Házi Feladat

4. HF. : Figyeljék meg a kétdimenziós csúszkát (Slider2D), és a súgó alapján mutassanak egy - két másféle szép alkalmazást

Hyperlink["https://reference.wolfram.com/mathematica/tutorial/IntroductionToManipulate.html"]

Manipulate[ParametricPlot[{a[[1]] Sin[n[[1]] (x+p[[1]])],a[[2]] Cos[n[[2]] (x+p[[2]])]},{x,0,20 Pi},PlotRange->1,PerformanceGoal->"Quality"],{n,{1,1},{4,4}},{a,{0,0},{1,1}},{p,{0,0},{2 Pi,2Pi}}]

Manipulate[Graphics[{Line[Table[{{Cos[t],Sin[t]},pt},{t,2. Pi/n,2. Pi,2. Pi/n}]]},PlotRange->1],{{n,30},1,200,1},{pt,{-1,-1},{1,1}}]