Legközelebb

Csikja Rudolf fog beszélni paraméterbecslési feladatokról a legegyszerűbbtől a legbonyolultabbig. Dolgozzanak a nagy házin, írjanak, ha megakadnak. A házik részletes megoldásán túl lejjebb megtalálják a két egyenes illesztésének megoldását is.

Teljesen fakultatív házik (de azért vissza fogunk térni rájuk)

7. A súgó alábbi példáját tanulmányozva

nds=NDSolve[{x''[t] + x[t]==0,x'[0]==π,x[0]==0, WhenEvent[{x[t]==2,x[t]==-3},x'[t]->-x'[t]]},x,{t,0,20}];
Plot[{x[t]/.nds,2,-3},{t,0,20}]

modellezzük egy szoba fűtűsét: amikor a hőmérséklet eléri a 22 fokot, a fűtés kikapcsol, és a levegő a Newton-féle lehűlési törvény szerint hűl. Amint eléri a 18 fokot, bekapcsolunk egy 40 fokos kályhát. Rajzoljunk le 4  periódust.

Oláh Judit

8. Szoba fűtése

nds=NDSolve[{x''[t] + x[t]==0,x'[0]==π,x[0]==0, WhenEvent[{x[t]==2,x[t]==-3},x'[t]->-x'[t]]},x,{t,0,20}];
Plot[{x[t]/.nds,2,-3},{t,0,20}]

Newton lehűlési törvénye
dT/dt = -k*(T-T0)

ww[t_]=DSolveValue[{x'[t]==-40*(x[t]-18), x[0]==22},x[t],t]

D[ww[t],{t,2}]

ww1[t_]=D[ww[t],t]

ww1[0]

ff[t_]=DSolveValue[{x'[t]==0.04*(-x[t]+40), x[0]==18},x[t],t]

D[ff[t],{t,2}]

ff1[t_]=D[ff[t],t]

nds1=NDSolve[{x''[t] ==1600x[t]-28800,x'[0]==-160,x[0]==22, WhenEvent[{x[t]==18, x[t]==22},{x'[t]->-0.04*x[t]+1.6, x'[t]->-40x[t]+720}]},x,{t,0,20}];
Plot[{x[t]/.nds1,18,22},{t,0,2}, Method->{"EquationSimplification"->"Residual"},PlotLabel->"A szoba hőmérséklete", AxesLabel->{"Idő", "Hőmérséklet C"}]

nds2=NDSolve[{x'[t] ==-40x[t]+720,x[0]==22, WhenEvent[{x[t]==18, x[t]==22},{x'[t]->-0.4x[t]+16, x'[t]->-40x[t]+720}]},x,{t,0,20}];
Plot[{x[t]/.nds2,18,22},{t,0,5}, Method->{"EquationSimplification"->"Residual"},PlotLabel->"A szoba hőmérséklete", AxesLabel->{"Idő", "Hőmérséklet C"}]

Hibajelzést ad.
Azt írja, nem állítható x’[t] a Whenevent paranccsal, mert elsőrendűnél nincs magasabb derivált.

nds3=ParametricNDSolve[{x'[t] ==-b*(x[t]-a),x[0]==18, WhenEvent[{x[t]==22,x[t]==18},{{a->40, b->-400},{a->10, b->400}}]},x,{t,0,10}, {a, b},MaxSteps->∞];
Plot[{x[t]/.nds3,18,22},{t,0,10},PlotLabel->"A szoba hőmérséklete", AxesLabel->{"Idő", "Hőmérséklet C"}]

8. Az α és β mátrix ismeretében írjuk föl egy reakció kinetikai differenciálegyenletét tömeghatás típusú kinetikával. Megadom a koordinátás alakot, de szeretnék koordinátamentes megoldást is a haladó vegyészektől.

(Subscript[(OverDot[c]), m])=(∑_(r=1)^R)(β(m,r)-α(m,r))(Subscript[k, r])(∏_(p=1)^M)(Subscript[c, p]^(α(p,r)))

9. Keressenek a hálón Mathematica egysorosokat (oneliner), és próbálják megérteni a működésüket.

A házi feladatok megoldása

Mindenkinek

0. Egy kicsit nézzenek utána annak, amit differenciálegyenletekről tanultak. Először csak közönségesekkel fogunk foglalkozni, és a Laplace-transzformáció is csak később jön majd.

1. A házi feladatok megoldását nem notebook, hanem Slide  Show formájában szeretném megkapni. Minden feladat egy külön fólián szerepeljen.

2. Rajzoljunk Rubik-kockát!

Az alábbiak Csaplár Marianna megoldása láttán jutottak eszembe, de később kiderül, hogy ezeket az ötletek mások megvalósították. (Nem szégyen az se, ha a hálón sikerült találni egy szép megoldást.)

{Sequence[a,b],Sequence[b,c]}

ClearAll[fv];fv[col_,a_,b_,c_,d_]:=Sequence[col,Polygon[{{a,a,b},{a,c,b},{d,c,b},{d,a,b}}]]

fv[Orange,-2.8,-3.001,-1,-1.1]

Graphics3D[{%}]

És találjunk összefüggéseket. Másik módszer: Használjuk a GraphicsComplexet.

Csaplár Marianna

Graphics3D[{
Orange,Polygon[{{-2.8,-2.8,-3.001},{-2.8,-1,-3.001},{-1.1,-1,-3.001},{-1.1,-2.8,-3.001}}],
Orange,Polygon[{{-2.8,-0.8,-3.001},{-2.8,0.9,-3.001},{-1.1,0.9,-3.001},{-1.1,-0.8,-3.001}}],
Orange,Polygon[{{-2.8,1.1,-3.001},{-2.8,2.8,-3.001},{-1.1,2.8,-3.001},{-1.1,1.1,-3.001}}],
Orange,Polygon[{{-0.9,-2.8,-3.001},{-0.9,-1,-3.001},{0.8,-1,-3.001},{0.8,-2.8,-3.001}}],
Orange,Polygon[{{-0.9,-0.8,-3.001},{-0.9,0.9,-3.001},{0.8,0.9,-3.001},{0.8,-0.8,-3.001}}],
Orange,Polygon[{{-0.9,1.1,-3.001},{-0.9,2.8,-3.001},{0.8,2.8,-3.001},{0.8,1.1,-3.001}}],
Orange,Polygon[{{1,-2.8,-3.001},{1,-1,-3.001},{2.8,-1,-3.001},{2.8,-2.8,-3.001}}],
Orange,Polygon[{{1,-0.8,-3.001},{1,0.9,-3.001},{2.8,0.9,-3.001},{2.8,-0.8,-3.001}}],
Orange,Polygon[{{1,1.1,-3.001},{1,2.8,-3.001},{2.8,2.8,-3.001},{2.8,1.1,-3.001}}],
Red,Polygon[{{-2.8,-2.8,3.001},{-2.8,-1,3.001},{-1.1,-1,3.001},{-1.1,-2.8,3.001}}],
Red,Polygon[{{-2.8,-0.8,3.001},{-2.8,0.9,3.001},{-1.1,0.9,3.001},{-1.1,-0.8,3.001}}],
Red,Polygon[{{-2.8,1.1,3.001},{-2.8,2.8,3.001},{-1.1,2.8,3.001},{-1.1,1.1,3.001}}],
Red,Polygon[{{-0.9,-2.8,3.001},{-0.9,-1,3.001},{0.8,-1,3.001},{0.8,-2.8,3.001}}],
Red,Polygon[{{-0.9,-0.8,3.001},{-0.9,0.9,3.001},{0.8,0.9,3.001},{0.8,-0.8,3.001}}],
Red,Polygon[{{-0.9,1.1,3.001},{-0.9,2.8,3.001},{0.8,2.8,3.001},{0.8,1.1,3.001}}],
Red,Polygon[{{1,-2.8,3.001},{1,-1,3.001},{2.8,-1,3.001},{2.8,-2.8,3.001}}],
Red,Polygon[{{1,-0.8,3.001},{1,0.9,3.001},{2.8,0.9,3.001},{2.8,-0.8,3.001}}],
Red,Polygon[{{1,1.1,3.001},{1,2.8,3.001},{2.8,2.8,3.001},{2.8,1.1,3.001}}],
Green,Polygon[{{-3.001,-2.8,-2.8},{-3.001,-1,-2.8},{-3.001,-1,-1.1},{-3.001,-2.8,-1.1}}],
Green,Polygon[{{-3.001,-0.8,-2.8},{-3.001,0.9,-2.8},{-3.001,0.9,-1.1},{-3.001,-0.8,-1.1}}],
Green,Polygon[{{-3.001,1.1,-2.8},{-3.001,2.8,-2.8},{-3.001,2.8,-1.1},{-3.001,1.1,-1.1}}],
Green,Polygon[{{-3.001,-2.8,-0.9},{-3.001,-1,-0.9},{-3.001,-1,0.9},{-3.001,-2.8,0.9}}],
Green,Polygon[{{-3.001,-0.8,-0.9},{-3.001,0.9,-0.9},{-3.001,0.9,0.9},{-3.001,-0.8,0.9}}],
Green,Polygon[{{-3.001,1.1,-0.9},{-3.001,2.8,-0.9},{-3.001,2.8,0.9},{-3.001,1.1,0.9}}],
Green,Polygon[{{-3.001,-2.8,1.1},{-3.001,-2.8,2.8},{-3.001,-1,2.8},{-3.001,-1,1.1}}],
Green,Polygon[{{-3.001,-0.8,1.1},{-3.001,0.9,1.1},{-3.001,0.9,2.8},{-3.001,-0.8,2.8}}],
Green,Polygon[{{-3.001,1.1,1.1},{-3.001,2.8,1.1},{-3.001,2.8,2.8},{-3.001,1.1,2.8}}],
Blue,Polygon[{{3.001,-2.8,-2.8},{3.001,-1,-2.8},{3.001,-1,-1.1},{3.001,-2.8,-1.1}}],
Blue,Polygon[{{3.001,-0.8,-2.8},{3.001,0.9,-2.8},{3.001,0.9,-1.1},{3.001,-0.8,-1.1}}],
Blue,Polygon[{{3.001,1.1,-2.8},{3.001,2.8,-2.8},{3.001,2.8,-1.1},{3.001,1.1,-1.1}}],
Blue,Polygon[{{3.001,-2.8,-0.9},{3.001,-1,-0.9},{3.001,-1,0.9},{3.001,-2.8,0.9}}],
Blue,Polygon[{{3.001,-0.8,-0.9},{3.001,0.9,-0.9},{3.001,0.9,0.9},{3.001,-0.8,0.9}}],
Blue,Polygon[{{3.001,1.1,-0.9},{3.001,2.8,-0.9},{3.001,2.8,0.9},{3.001,1.1,0.9}}],
Blue,Polygon[{{3.001,-2.8,1.1},{3.001,-2.8,2.8},{3.001,-1,2.8},{3.001,-1,1.1}}],
Blue,Polygon[{{3.001,-0.8,1.1},{3.001,0.9,1.1},{3.001,0.9,2.8},{3.001,-0.8,2.8}}],
Blue,Polygon[{{3.001,1.1,1.1},{3.001,2.8,1.1},{3.001,2.8,2.8},{3.001,1.1,2.8}}],
Yellow,Polygon[{{-2.8,-3.001,2.8},{-2.8,-3.001,1.1},{-1.1,-3.001,1.1},{-1.1,-3.001,2.8}}],
Yellow,Polygon[{{-2.8,-3.001,0.9},{-2.8,-3.001,-0.9},{-1.1,-3.001,-0.9},{-1.1,-3.001,0.9}}],
Yellow,Polygon[{{-2.8,-3.001,-1.1},{-2.8,-3.001,-2.8},{-1.1,-3.001,-2.8},{-1.1,-3.001,-1.1}}],
Yellow,Polygon[{{-0.9,-3.001,2.8},{-0.9,-3.001,1.1},{0.8,-3.001,1.1},{0.8,-3.001,2.8}}],
Yellow,Polygon[{{-0.9,-3.001,0.9},{-0.9,-3.001,-0.9},{0.8,-3.001,-0.9},{0.8,-3.001,0.9}}],
Yellow,Polygon[{{-0.9,-3.001,-1.1},{-0.9,-3.001,-2.8},{0.8,-3.001,-2.8},{0.8,-3.001,-1.1}}],
Yellow,Polygon[{{1,-3.001,2.8},{1,-3.001,1.1},{2.8,-3.001,1.1},{2.8,-3.001,2.8}}],
Yellow,Polygon[{{1,-3.001,0.9},{1,-3.001,-0.9},{2.8,-3.001,-0.9},{2.8,-3.001,0.9}}],
Yellow,Polygon[{{1,-3.001,-1.1},{1,-3.001,-2.8},{2.8,-3.001,-2.8},{2.8,-3.001,-1.1}}],
White,Polygon[{{-2.8,3.001,2.8},{-2.8,3.001,1.1},{-1.1,3.001,1.1},{-1.1,3.001,2.8}}],
White,Polygon[{{-2.8,3.001,0.9},{-2.8,3.001,-0.9},{-1.1,3.001,-0.9},{-1.1,3.001,0.9}}],
White,Polygon[{{-2.8,3.001,-1.1},{-2.8,3.001,-2.8},{-1.1,3.001,-2.8},{-1.1,3.001,-1.1}}],
White,Polygon[{{-0.9,3.001,2.8},{-0.9,3.001,1.1},{0.8,3.001,1.1},{0.8,3.001,2.8}}],
White,Polygon[{{-0.9,3.001,0.9},{-0.9,3.001,-0.9},{0.8,3.001,-0.9},{0.8,3.001,0.9}}],
White,Polygon[{{-0.9,3.001,-1.1},{-0.9,3.001,-2.8},{0.8,3.001,-2.8},{0.8,3.001,-1.1}}],
White,Polygon[{{1,3.001,2.8},{1,3.001,1.1},{2.8,3.001,1.1},{2.8,3.001,2.8}}],
White,Polygon[{{1,3.001,0.9},{1,3.001,-0.9},{2.8,3.001,-0.9},{2.8,3.001,0.9}}],
White,Polygon[{{1,3.001,-1.1},{1,3.001,-2.8},{2.8,3.001,-2.8},{2.8,3.001,-1.1}}],
Black,Cuboid[{{-3,-3,-3},{3,3,3}}]},Boxed->False,Lighting->"Neutral"]

Knipl Christian

ClearAll[s,d,v,q,i,j,k]
s0={0,0,0};
sX={1,0,0};
sY={0,1,0};
sZ={0,0,1};
qXY={s0,sX,2 sX,3 sX,sY,sY+sX,sY+2 sX,sY+3 sX,2 sY,2 sY+sX,2 sY+2 sX,2 sY+3 sX,3 sY,3 sY+sX,3 sY+2 sX,3 sY+3 sX};
qXZ={s0,sX,2 sX,3 sX,sZ,sZ+sX,sZ+2 sX,sZ+3 sX,2 sZ,2 sZ+sX,2 sZ+2 sX,2 sZ+3 sX,3 sZ,3 sZ+sX,3 sZ+2 sX,3 sZ+3 sX};
qYZ={s0,sY,2 sY,3 sY,sZ,sZ+sY,sZ+2 sY,sZ+3 sY,2 sZ,2 sZ+sY,2 sZ+2 sY,2 sZ+3 sY,3 sZ,3 sZ+sY,3 sZ+2 sY,3 sZ+3 sY};
u[i_,j_,k_]={{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k},{i,j,k}};
QXY=u[0,0,3]+qXY;
QXZ=u[0,3,0]+qXZ;
QYZ=u[3,0,0]+qYZ;

ConstantArray[{i,j,k},4]

o=p=1;
Graphics3D[{Opacity[o],Yellow,GraphicsComplex[qXY,Polygon[{{1,2,6,5},{2,3,7,6},{3,4,8,7},{5,6,10,9},{6,7,11,10},{7,8,12,11},{9,10,14,13},{10,11,15,14},{11,12,16,15}}]],Opacity[p],White,GraphicsComplex[QXY,Polygon[{{1,2,6,5},{2,3,7,6},{3,4,8,7},{5,6,10,9},{6,7,11,10},{7,8,12,11},{9,10,14,13},{10,11,15,14},{11,12,16,15}}]],Opacity[o],Orange,GraphicsComplex[qXZ,Polygon[{{1,2,6,5},{2,3,7,6},{3,4,8,7},{5,6,10,9},{6,7,11,10},{7,8,12,11},{9,10,14,13},{10,11,15,14},{11,12,16,15}}]],Opacity[p],Red,GraphicsComplex[QXZ,Polygon[{{1,2,6,5},{2,3,7,6},{3,4,8,7},{5,6,10,9},{6,7,11,10},{7,8,12,11},{9,10,14,13},{10,11,15,14},{11,12,16,15}}]],Opacity[o],Green,GraphicsComplex[qYZ,Polygon[{{1,2,6,5},{2,3,7,6},{3,4,8,7},{5,6,10,9},{6,7,11,10},{7,8,12,11},{9,10,14,13},{10,11,15,14},{11,12,16,15}}]],Opacity[p],Blue,GraphicsComplex[QYZ,Polygon[{{1,2,6,5},{2,3,7,6},{3,4,8,7},{5,6,10,9},{6,7,11,10},{7,8,12,11},{9,10,14,13},{10,11,15,14},{11,12,16,15}}]]},Boxed->False,ViewPoint→{-5,10,5},Lighting->"Neutral"]

Mester Dávid

Sajnos magamtól nem tudtam kiszínezni, de az interneten találtam egyet :

Graphics3D[Table[Cuboid[{i,j,k}],{i,0,2.0,1.0},{j,0,2.0,1.0},{k,0,2.0,1.0}]]

Graphics3D[Table[Cuboid[{i, j, k}], {i, 0, 2.2, 1.1},
  	{j, 0, 2.2, 1.1}, {k, 0, 2.2, 1.1}], Boxed -> False]

Az alábbiakat meg kellene érteni. Lehet, hogy az ismeretlen függvények korábban definiálva voltak?

NormalDirection[v_] := 
 Normalize[Cross[v[[2]] - v[[1]], v[[-1]] - v[[1]]]]

g = With[{h = 1.1}, 
  Graphics3D[Orient[Table[CuboidPolygons[{i, j, k}], {i, 0, 2 h, h},
      	{j, 0, 2 h, h}, {k, 0, 2 h, h}], (h + 1/2) {1, 1, 1}] /. 
    Polygon[x_] :> {If[
       Union[x[[All, 
          Position[Abs[NormalDirection[x]], 1.][[1, 
           1]]]]] != {0} != {2 h + 1}, {},
       Glow[Switch[NormalDirection[x],
         {-1., 0., 0.}, Yellow,
         {1., 0., 0.}, Red,
         {0., 1., 0.}, White,
         {0., -1., 0.}, Orange,
         {0., 0., -1.}, Green,
         {0., 0., 1.}, Blue
         ]]], Polygon[x]}, Boxed -> False, Lighting -> None]
  ]

Kipróbálás nélkül ne küldjenek semmit!

Oláh Judit

Graphics3D[{Red,Polygon[{{0,1.5,0},{0,1.5,1.5},{0,0,1.5},{0,0,0}}],Blue,Polygon[{{1.5,0,0},{1.5,1.5,0},{0,1.5,0},{0,0,0}}],Orange,Polygon[{{1.5,0,1.5},{1.5,1.5,1.5},{0,1.5,1.5},{0,0,1.5}}], Green,Polygon[{{1.5,0,0},{1.5,0,1.5},{1.5,1.5,1.5},{1.5,1.5,0}}],White,Polygon[{{0,0,0},{1.5,0,0},{1.5,0,1.5},{0,0,1.5}}],Yellow,Polygon[{{0,1.5,0},{1.5,1.5,0},{1.5,1.5,1.5},{0,1.5,1.5}}]},FaceGrids->All,FaceGridsStyle->Directive[Black,Thick],Boxed->False,ViewPoint->{1.3`,-2.4`,2.`}]

Elforgatható! Nem Patyomkin-féle :)

Orosz Dávid

Graphics3D[{EdgeForm[{Thickness[0.01],Black}],White,Table[Table[Polygon[{{i,j,3},{i,j+1,3},{i+1,j+1,3},{i+1,j,3}}],{i,0,2}],{j,0,2}],EdgeForm[{Thickness[0.01],Black}],Yellow,Table[Table[Polygon[{{i,j,0},{i,j+1,0},{i+1,j+1,0},{i+1,j,0}}],{i,0,2}],{j,0,2}],EdgeForm[{Thickness[0.01],Black}],Blue,Table[Table[Polygon[{{3,i,j},{3,i+1,j},{3,i+1,j+1},{3,i,j+1}}],{i,0,2}],{j,0,2}],EdgeForm[{Thickness[0.01],Black}],Darker[Green],Table[Table[Polygon[{{0,i,j},{0,i+1,j},{0,i+1,j+1},{0,i,j+1}}],{i,0,2}],{j,0,2}],EdgeForm[{Thickness[0.01],Black}],Red,Table[Table[Polygon[{{i,0,j},{i,0,j+1},{i+1,0,j+1},{i+1,0,j}}],{i,0,2}],{j,0,2}],EdgeForm[{Thickness[0.01],Black}],Orange,Table[Table[Polygon[{{i,3,j},{i,3,j+1},{i+1,3,j+1},{i+1,3,j}}],{i,0,2}],{j,0,2}]},Axes->True,ViewPoint->{3, -2, 2}]

Oláh Judit

Graphics3D[Table[With[{p={i,j,k}},{RGBColor[p], Cuboid[p,p+1]}],{i,3},{j,3},{k,3}], Boxed-> False]

Ez annyira szép megoldás, hogy nem álltam meg, hogy ne szépítsek még rajta :)

Graphics3D[Table[{RGBColor[p], Cuboid[p,p+1]},{p,Tuples[Range[3],3]}]]

Kezdőknek

3. Másodfokú (haladóknak tetszőleges) p polinom esetére vázoljuk az (OverDot[x])(t)=p(x(t)) egyenlet megoldását, trajektóriáit , stacionárius pontjait és jobb oldalát egy ábrán, ahogyan a logisztikus egyenlettel tettük.

pp=ParametricPlot[{-x(1-x),x},{x,-1.5,2.3}]

pnds=ParametricNDSolve[{D[x[t],t]==x[t](1-x[t]),x[0]==p},x,{t,0,4},p]

pl=Plot[Evaluate[{x[-0.5][t],x[0.2][t],x[3][t],1}/.pnds],{t,0,2}]

Show[pp,pl]

Mester Dávid

ClearAll[p,pp,pnds,pl];
pp=ParametricPlot[{-x^2+2 x+5,x},{x,-3,5}]
pnds=ParametricNDSolve[{D[x[t],t]==x[t]^2-2 x[t]-5,x[0]==p},x,{t,0,4},p]
pl=Plot[Evaluate[{x[-0.5][t],x[0.2][t],x[3][t],1}/.pnds],{t,0,2}]

Show[pp,pl]

Oláh Judit

m1[x_]=(x^2)-x-6

Solve[ (x^2)-x-6==0,x]

pndsm=ParametricNDSolve[{D[x[t],t]==x[t]*x[t]- x[t]-6,x[0]==p},x,{t,0,2},p]

m=Plot[Evaluate[Table[x[i][t]/.pndsm, {i,-10,10,2}]],{t,0,2}]

Plot[Evaluate[x[-4][t]/.pndsm],{t,0,2},PlotRange->{{0,2},{-10, 10}}]

Plot[Evaluate[x[-2][t]/.pndsm],{t,0,2},PlotRange->{{0,2},{-10, 10}}]

Plot[Evaluate[x[2][t]/.pndsm],{t,0,2}, PlotRange->{{0,2},{-10, 10}}]

Plot[Evaluate[x[3][t]/.pndsm],{t,0,2}, PlotRange->{{0,2},{-10, 10}}]

Plot[Evaluate[x[4][t]/.pndsm],{t,0,2}, PlotRange->{{0,2},{-10, 10}}]

pe[param_]:=Plot[Evaluate[x[param][t]/.pndsm],{t,0,2}, PlotRange->{{0,2},{-10, 10}}]

GraphicsRow[pe/@{-4,-2,2,3,4}]

GraphicsRow[pe/@{-4,-2,2,3,4},ImageSize->800]

GraphicsRow[Partition[pe/@{-4,-2,0,2,3,4},3],ImageSize->800]

3

mm=Plot[Evaluate[{x[-4][t],x[-2][t],x[3][t],x[4][t],x[2][t],x[3][t]}/.pndsm],{t,0,2}, PlotRange->{{-10,2},{-10, 10}}]

mm1=ParametricPlot[{-6-x-(x^2),x},{x,-10,10}]

l=List[{0,-2}, {0,3}]

ll=ListPlot[{{0,-2}, {0,3}}]

mm3=Plot[Evaluate[{x[-4][t],x[-2][t],x[3][t],x[4][t],x[2][t],x[3][t]}/.pndsm],{t,0,2}, PlotRange->{{0,2},{-5, 10}}]

ndsm=DSolveValue[{D[x[t],t]==x[t]*x[t]- x[t]-6,x[0]==1},x[t],t]

Plot[ndsm,{t,0,2}]

aa=Graphics[{Red,Arrow[{{0,-5},{0,-2.2}}],Arrow[{{0,0},{0,-1.8}}],Arrow[{{0,5},{0,3.3}}]}];

Show[mm, mm1, ll,aa]

A megoldás függ a választott másodfokú polinomtól és a kezdeti feltételektől.

m2[x_]=3(x^2)+2x+1

Solve[ 3(x^2)+2x+1==0,x]

pndsm2=ParametricNDSolve[{D[x[t],t]==3x[t]*x[t]+2 x[t]+1,x[0]==p},x,{t,0,2},p]

m2=Plot[Evaluate[Table[x[i][t]/.pndsm2, {i,-10,10,2}]],{t,0,2}]

ndsm=DSolveValue[{D[x[t],t]==3x[t]*x[t]+2 x[t]+1,x[0]==1},x[t],t]

Plot[ndsm,{t,-13.861794767054104`,13.861794767054104`}]

Knipl Christian

pp=ParametricPlot[{-(x^3)+(x^2)+x,x},{x,-1,1.7}]

sol=Solve[(x^3)-(x^2)-x==0,x]

N[x/.sol]

nsol=NSolve[(x^3)-(x^2)-x==0,x]

ClearAll[x,t,p];
pnds=ParametricNDSolve[{D[x[t],t]==((x[t])^3)-((x[t])^2)-x[t],x[0]==p},x,{t,0,4},p]

x/.sol

Evaluate[{x[1.635][t],x[1.6][t],x[-0.5][t],x[-0.69]}/.pnds]

x/.sol

Plot[Join[Evaluate[{x[1.635][t],x[1.6][t],x[-0.5][t],x[-0.69][t]}/.pnds],x/.sol],{t,0,1.03}]

pl=Plot[Evaluate[Join[{x[1.635][t],x[1.6][t],x[-0.5][t],x[-0.69][t]}/.pnds,x/.sol]],{t,0,1.03}]

Show[pl,pp]

Show[pp,pl]

ar=Graphics[{Thick,Red,Arrow[{{0,1.55},{0,0.05}}],Arrow[{{0,-0.6},{0,-0.05}}],Arrow[{{0,1.65},{0,2.1}}],Arrow[{{0,-0.65},{0,-1.15}}],Green,Disk[{0,0},0.04],Disk[{0,1.62},0.04],Disk[{0,-0.62},0.04]}];

Show[pp,pl,ar]

ClearAll[csodamodul1];
csodamodul1[polyval_,tfin_]:=Module[{},{nsol=x/.Sort@NSolve[polyval==0,x],pp=ParametricPlot[{-polyval,x},{x,nsol[[1]]-0.1,nsol[[3]]+0.1}],pnds=ParametricNDSolve[{D[x[t],t]==(polyval/.x->x[t]),x[0]==p,WhenEvent[x[t]==10,T=t]},x,{t,0,tfin},p],Evaluate[T]}]
csodamodul1[(x^3)-(x^2)-x,1.03]

T

Module[{x},x]

Module[{x},x]

ClearAll[csodamodul];csodamodul[polyval_,tfin_]:=Module[{pp,pl},{nsol=x/.Sort@NSolve[polyval==0,x],pp=ParametricPlot[{-polyval,x},{x,nsol[[1]]-0.1,nsol[[3]]+0.1}],
pnds=ParametricNDSolve[{D[x[t],t]==(polyval/.x->x[t]),x[0]==p,WhenEvent[x[t]==10,T=t]},x,{t,0,tfin},p],pl=Plot[Evaluate[Join[{x[nsol[[3]]+0.1][t],x[nsol[[3]]-0.1][t],x[nsol[[1]]+0.1][t],x[nsol[[1]]-0.1][t]}/.pnds,nsol]],{t,0,T}],Show[pp,pl]}]
csodamodul[(x^3)-(x^2)-x,4]

4. Oldjuk meg a logisztikus egyenletet numerikusan, közben írjuk ki azt az időpontot, ahol a megoldásnak inflexiós pontja van. (A második deriváltja nulla. Használjuk a WhenEvent függvényt.)

Mester Dávid

A WhenEvent függvényt nem sikerült használni, a második deriválttal problémája volt.

sol=DSolve[D[x[t],t]==x[t] (1-x[t]),x,t]
d=D[E^t/(E^t+E^C[1]),t,t]
Solve[d==0,t,Reals]

Oláh Judit

pp=ParametricPlot[{-x(1-x),x},{x,-1.5,2.3}]

pnds=ParametricNDSolve[{D[x[t],t]==x[t](1-x[t]),x[0]==p},x,{t,0,4},p]

pl=Plot[Evaluate[{x[-0.5][t],x[0.2][t],x[3][t],1}/.pnds],{t,0,2}]

Show[pp,pl]

soll=NDSolve[{x'[t]==x[t](1-x[t]),x[0]==0.2},x,{t,0,10}]

Plot[Evaluate[x[t]/.soll], {t,0,10}]

g[t_]=x[t]/.soll

Plot[g[t],{t,0,10}]

h[t_]=D[g[t],{t,2}]

Plot[h[t],{t,0,10}]

FindRoot[h[t], {t,1}]

{t->1.3862840630292657`}

q[t_]=D[g[t],{t}]

Plot[q[t],{t,0,10}]

Plot[{g[t],q[t],h[t]},{t,0,10}, PlotLegends->{"megoldás","első derivált" ,"második derivált"}]

Megjegyzések 1.

Ötletek, javaslatok

param={K->1,x0->0.2};

ClearAll[x,nds,t];nds=NDSolve[{x'[t]==x[t](K-x[t]),x[0]==x0}/.param,x,{t,0,8}]

X[t_]:=x[t]/.nds[[1]]

Plot[X[t],{t,0,8}]

NDSolveValue

ParametricNDSolveValue

Manipulate needs explicit parameters.

sp=StreamPlot[{1,x(1-x)},{t,0,4},{x,-1,2}]

vp=VectorPlot[{1,x(1-x)},{t,0,4},{x,-1,2}]

VectorPlot3D also exists.

pp=ParametricPlot[{-x(1-x),x},{x,-1.5,2.3},PlotStyle->Dashed]

pnds=ParametricNDSolve[{D[x[t],t]==x[t](1-x[t]),x[0]==p},x,{t,0,4},p]

pl=Plot[Evaluate[{x[-0.5][t],x[0.2][t],x[3][t],1}/.pnds],{t,0,2}]

Show[pp,pl]

pl=Plot[Evaluate[{x[-0.5][t],x[0.2][t],x[3][t],1}/.pnds],{t,0,2},PlotRange->{{-1,2},{-2,4}}, Epilog->First@pp]

Epilog, Prolog

Hogyan bánjunk el a második deriválttal: javuló megoldások

NDSolve[{D[x[t],t]==x[t] (1-x[t]),x[0]==0.4,WhenEvent[x''[t]==0,Print[t]]},x,{t,0,4}]

NDSolve[{D[x[t],t]==x[t] (1-x[t]),x[0]==0.1,WhenEvent[Abs[x'[t+0.01]-x'[t]]==0.01,Print[t]]},x,{t,0,4}]

NDSolve[{D[x[t],t]==x[t] (1-x[t]),y[t]==x'[t],x[0]==0.4,y[0]==x'[0],WhenEvent[y'[t]==0,Print[t]]},x,{t,0,4}]

NDSolve[{D[D[x[t],t]==x[t] (1-x[t]),t],x[0]==0.4,x'[0]==x[0] (1-x[0]),WhenEvent[x''[t]==0,Print[t]]},x,{t,0,4}]

Megjegyzések 2: Perióduskettőző bifurkáció a diszkrét idejű logisztikus modellben

Logistic[r_:0.5,K_:3]:=Function[Ν,r Ν(1-(Ν/K))]

Orbit[map_,Ν0_,n_]:=NestList[map,Ν0,n];

Orbit[ff,N0,3]

A közölt kész megoldás a MapThread függvényt tartalmazza; tanulmányozzuk ezt előre.

MapThread[f,{{a,b,c},{x,y,z}}]

MapThread[f,{{{a,b},{c,d}},{{u,v},{s,t}}},2]

MapThread[Line[{{#1,#1},{#1,#2},{#2,#2}}]&,{{a,b,c,d},{b,c,d,e}}]

Javasolok egy másik megoldást a pókháló diagram megszerkesztésére. A pókháló diagram úgy készül, hogy a szögfelezőről a jobb oldalt definiáló függvény grafikonjára megyünk, majd megint a szögfelezőre, s. í. t. Ez lesz a fő eszközünk:

Riffle[{aa,bb,cc,dd},{ee,ff,gg,hh}]

Ez pedig a felhasználandó anyag. (Anyagok és módszerek...)

palya={x0,fx0,ffx0,fffx0};

t1=Transpose[{palya,palya}]

Drop[palya,-1]

Drop[palya,1]

t2=Transpose[{Drop[palya,-1],Drop[palya,1]}]

Riffle[Most[t1],t2]

A pályát persze az Orbit fv. fogja előállítani, ami tkp. nem más, mint a NestList.

Orbit[ff,x0,4]

Most nézzük meg a kész megoldást, azután csináljunk egyet a Riffle felhasználásával.

IterativeProcess[map_,Ν0_,{min_,max_},opts___]:=Module[{fr,orb},
orb=Orbit[map,Ν0,50];
fr=MapThread[Line[{{#1,#1},{#1,#2},{#2,#2}}]&,{Drop[orb,-1],Drop[orb,1]}];Show[Plot[{map[Ν],Ν},{Ν,min,max},opts],Graphics[{fr}]]]

IterativeProcess[Logistic[3.2,1],0.6,{0,1}]

GraphicsRow[{ListPlot[Orbit[Logistic[3.2,1],0.1,100],AxesLabel->{"Number of \n iterations","Stat. point"}],IterativeProcess[Logistic[3.2,1],0.1,{0,1},PlotLabel->"Cobweb diagram\nof the iteration"]},ImageSize->500]

GraphicsRow[{ListPlot[Orbit[Logistic[3.9,1],0.1,100],AxesLabel->{"Number of \n iterations","Stat. point"}],IterativeProcess[Logistic[3.9,1],0.1,{0,1},PlotLabel->"Cobweb diagram\nof the iteration"]},ImageSize->500]

Bifurcation[map_,{p_,pi_,pf_,np_},n_,opts___]:=Module[{pp},ListPlot[Flatten[Table[({pp,#})&/@Drop[Orbit[map/.p->pp,0.5,n+50],50],{pp,pi,pf,((pf-pi)/np)}],1],Axes->False,Frame->True,PlotStyle->{PointSize[0.003]},opts]]

Bifurcation[Logistic[r,1],{r,0,4,100},2000,FrameLabel->{"Value of parameter r","Stat. point, or\nperiodic orbit"},PlotLabel-> "Stationary states as\n functions of the parameter r"]

GraphicsRow[{Bifurcation[Logistic[r,1],{r,-2,4,250},200,FrameLabel->{"Value of parameter r","Stat. point, or\nperiodic orbit"},ImageSize->300],Bifurcation[Logistic[r,1],{r,0,4,100},200,FrameLabel->{"Value of parameter r","Stat. point, or\nperiodic orbit"},ImageSize->300]},PlotLabel-> "Stationary states as\n functions of the parameter r"]

abrapar[r_]:=GraphicsRow[{ListPlot[Orbit[Logistic[r,1],0.1,100],AxesLabel->{"r","(SuperStar[N])"},PlotLabel->"r = "<>ToString[r]],IterativeProcess[Logistic[r,1],0.1,{0,2},PlotRange->{{0,1.2},{-.5,1.}},AxesLabel->{TraditionalForm["N"],TraditionalForm["N(1+r-((rΝ)/K))"]},PlotLabel->"r = "<>ToString[r]]},ImageSize->700]

abrapar[2.0]

abrapar[2.8]

abrapar[3.0]

abrapar[3.3]

abrapar[3.53]

abrapar[3.8]

abrapar[3.9]

abrapar[4]

abrapar[5]

What if r>4? Note that period three solutions are obtained with the initial parameter value.

Manipulate[abrapar[r],{{r,3.84},1,4.2,0.01},SaveDefinitions->True]

May cikke

Hyperlink["Ez egy nagyon jó bevezető cikk a káoszról, több benne a biológia, mint a matek","http://isites.harvard.edu/fs/docs/icb.topic1313269.files/Lecture22/May_Simple%20mathematical%20models%20with%20very_76.pdf"]

Magyarul : Nagyon bonyolult dinamikájú egyszerű matematikai modellek, Alkalmazott Matematikai Lapok 8 (1982), 427-446.

5. A GraphicsComplex alkalmazásául vegyünk fel 11 pontot a síkon, majd kössük össze minden másodikat, tehát az elsőt a harmadikkal, stb. végül a kilencediket a tizenegyedikkel, a tizenegyediket a másodikkal, azt a negyedikkel stb. Használjunk opciókat is az ábra díszítésére.

Csaplár Marianna

Graphics[GraphicsComplex[{{0,0},{1,1},{-1,1},{1,-1},{0.5,0.5},{0.5,-0.5},{-0.5,0.5},{-0.5,-0.5},{2,2},{-2,2},{2,-2}},{Green, Thick,Line[{{1,3},{3,5},{5,7},{7,9},{9,11},{11,2},{2,4},{4,6},{6,8},{8,10}}],Green,PointSize[0.03],Point[{1,2,3,4,5,6,7,8,9,10,11}]}]]

Knipl Christian

ClearAll[v];v={{0,0},{1,0},{1,1},{1,2},{1,3},{0,3},{-1,3},{-2,2},{-1,2},{0,1},{0,0.5}};
Graphics[GraphicsComplex[v,{PointSize[Large],Point[{1,2,4,5,3}],Blue,Polygon[{1,3,5,7,9,11,2,4,6,8,10,1}],VertexColors->{Red,Green,Blue}}]]

Nekem nem színes a csücske.

ClearAll[v];v={{0,0},{1,0},{1,1},{1,2},{1,3},{0,3},{-1,3},{-2,2},{-1,2},{0,1},{0,0.5}};
Graphics[GraphicsComplex[v,{PointSize[Large],Point[{1,2,4,5,3}],Blue,Polygon[{1,3,5,7,9,11,2,4,6,8,10,1}]},VertexColors→{Red,Green,Blue}]]

Mester Dávid

v={{1,1},{3,1},{3,3},{3,2},{4,5},{6,0},{5,6},{4,7},{7,2},{8,4},{3,7}};
Graphics[{Thick,Blue,GraphicsComplex[v,Line[{1,3,5,7,9,11,2,4,6,8,10}]]}]

Ez nem túl szép :DD

Oláh Judit

Üres sorok, üres cellák ne maradjanak (de nem ez a lényeg :) )

v=Table[{RandomReal[],RandomReal[]}, {i,1,11}]

v[[1]]

l=ListPlot[v]

gg1=Graphics[GraphicsComplex[v, Table[Line[{i,i+2}], {i,1,9,2}]]];

gg2=Graphics[GraphicsComplex[v, Table[Line[{i,i+2}], {i,2,8,2}]]];

gg3=Graphics[GraphicsComplex[v, Line[{11,2}]]];

Show[ListPlot[v, PlotStyle->Green],Graphics[GraphicsComplex[v, Table[Arrow[{i,i+2}], {i,1,9,2}]]],Graphics[GraphicsComplex[v, Table[Arrow[{i,i+2}], {i,2,8,2}]]],Graphics[GraphicsComplex[v, Arrow[{11,2}]]],Graphics[GraphicsComplex[v, Arrow[{10,1}]]],PlotLabel->Style[Framed["Útvonal"],24,Red,Thick,Background->LightBlue], AxesLabel->{x,y}]

Orosz Dávid

points={{0,0},{4,2},{1,1},{6,0},{0,2},{4,-2},{-2,0},{3,-1},{0,-2},{4,0},{2,0}};
Graphics[{Thickness[0.007],Dashed,Darker[Red],GraphicsComplex[points,Line[{1,3,5,7,9,11}]],Thickness[0.007],Dashed,Darker[Blue],GraphicsComplex[points,Line[{11,2,4,6,8,10}]]},Axes->True,AxesStyle->Directive[Gray, 8]]

points3D={{0,0,0},{4,2,2},{1,1,0},{6,0,3},{0,2,1},{4,-2,3},{-2,0,1},{3,-1,4},{0,-2,2},{4,0,4},{2,0,2}};
Graphics3D[{Thickness[0.007],Dashed,Darker[Red],GraphicsComplex[points3D,Line[{1,3,5,7,9,11}]],Thickness[0.007],Dashed,Darker[Blue],GraphicsComplex[points3D,Line[{11,2,4,6,8,10}]]},ViewPoint->Top]

Haladóknak

6A. A deriváló függvény tudásbázisának bővítése

Knipl Christian

ClearAll[a,x]
u[x_]:=a x^2+3 x-2+Exp[8 x]+3 Log[-4 x]+7 Sin[x]+3.9 Cos[99 x]+3 Tan[q*x]

u[x]

ClearAll[d];
d[fval_+gval_]:=d[fval]+d[gval];
d[u[x]]

d[λ_ fval_/;FreeQ[λ,x]]:=λ d[fval];
d[((x_)^(n_))/;FreeQ[x,E]]:=n (x^(n-1))/;n>0;
d[u[x]]

d[r_?NumericQ]:=0;
d[u[x]]

d[Exp[k_ x_]]:=k Exp[k x];
d[x]:=1;
d[u[x]]

d[Log[x_]]:=1/x (* /;x≠0*);
d[u[x]]

d[Cos[x_]]:=-Sin[x];
d[u[x]]

d[Sin[x_]]:=Cos[x];
d[u[x]]

d[Tan[x_]]:=1/((Cos[x])^2);
d[u[x]]

u[x]

D[u[x],x]

D[3 Log[-4 x],x]

D[ Log[-4 x],x]

Oláh Judit

p[x_]:=a (x^2)+3x-2

d[fval_+gval_]:=d[fval]+d[gval];{d[p[x]],D[p[x],x]}

d[λ_ fval_/;FreeQ[λ,x]]:=λ d[fval];{d[p[x]],D[p[x],x]}

d[((x_)^(n_))]:=n (x^(n-1));{d[p[x]],D[p[x],x]}

FullForm[n_.]

d[((x_)^(n_.))]:=n (x^(n-1));{d[p[x]],D[p[x],x]}

d[((x_)^(n_))]:=n (x^(n-1))/;n>0;{d[p[x]],D[p[x],x]}

d[r_?NumericQ]:=0;{d[p[x]],D[p[x],x]}

d[fval_*gval_]:=d[fval]*gval+d[gval]*fval;{d[p[x]],D[p[x],x]}

d[Sin[val_]]:=Cos[val];
d[Cos[val_]]:=-Sin[val];
pp[x_]:=a (x^2)+Sin[3x];{d[pp[x]],D[pp[x],x]}

Ellenőrző fv.

ClearAll[ell];ell[polyval_]:=If[d[polyval]≡D[polyval,x],"Tovább",Evaluate[{d[polyval],D[polyval,x]}]]

ell[pp[x]]

Reduce[2 a x+Cos[3 x]==2 a x+3 Cos[3 x]]

SolveAlways[2 a x+Cos[3 x]==2 a x+3 Cos[3 x],a]

d[fval_-gval_]:=d[fval]-d[gval];{d[p[x]],D[p[x],x]}

d[fval_/gval_]:=(d[fval]*gval-d[gval]*fval)/(gval*gval)

ppp[x_]:=Sin[x]*(x^2)/(x+3);{d[ppp[x]],D[ppp[x],x]}//Together

d[(E^(x_))]:=(E^x)

p3[x_]:=x+(E^x);{d[p3[x]],D[p3[x],x]}

p33[x_]:=x+(E^(3x));{d[p33[x]],D[p33[x],x]}

d[((a_)^(x_))]:=(a^x)*Log[a]

p4[x_]:=(3^x);{d[p4[x]],D[p4[x],x]}

D[(x+(E^x)),x]

d[Log[x_]]:=1/(x)

p5[x_]:=Log[x];{d[p5[x]],D[p5[x],x]}

d[f[g[val_]]]=d[g[val]]*d[f[g[val]]]

p6[x_]:=Sin[(x^2)];{d[p6[x]],D[p6[x],x]}

Ezt nem tudtam megoldani.

FullForm[Sin[(x^2)]]

6. Készítsünk integráló függvényt, amely minél több függvény esetére meghatározzák a határozatlan integrált. (Kezdők is hozzáfoghatnak!) Alkalmazzuk a függvényt legalább 5 feladat megoldására.

Oláh Judit

7. Integráló függvény

p21:=4(x^3) +3 (x^2)+25+Sin[x]

int[((x_)^(n_.))]:= (x^(n+1))/(n+1)

int[p21]

int[fval_+gval_]:=int[fval]+int[gval]

int[p21]

int[fval_-gval_]:=int[fval]-int[gval]

int[λ_ fval_/;FreeQ[λ,x]]:=λ int[fval]

int[p21]

int[r_?NumericQ]:=r*x

int[p21]

int[Sin[val_]]:=-Cos[val]

int[p21]

int[Cos[val_]]:=Sin[val]

Integrate[p21, x]

Egy kérdésre

Az adatokra szemmel láthatóan két egyenest érdemes ileszteni.

adatok={{0.00021956621054484353`,21.95662105448435`},{0.0004239703002857456`,21.198515014287278`},{0.0009658396655619292`,19.316793311238584`},{0.0017063427051567529`,17.06342705156753`},{0.002857288517837623`,14.286442589188114`},{0.005307693401925082`,10.615386803850164`},{0.008239375867619761`,8.23937586761976`},{0.01234704028174462`,6.17352014087231`},{0.018938797207737283`,3.7877594415474563`}}

abrazolva=ListPlot[adatok, PlotStyle->{Red}]

eleje=Take[adatok,5]

vege=Take[adatok,-4]

elmf=LinearModelFit[eleje,x,x]

s1=Show[ListPlot[eleje],Plot[elmf[x],{x,0,0.003}],Frame->True]

vlmf=LinearModelFit[vege,x,x]

s2=Show[ListPlot[vege],Plot[vlmf[x],{x,0.003,0.020}],Frame->True]

s2=Show[ListPlot[adatok],Plot[vlmf[x],{x,0.003,0.020}],Plot[elmf[x],{x,0,0.003}],Frame->True]

Most azt szeretnénk, ha a két egyenesszakasz értelmezési tartományának határát az adatok alapján a program határozná meg.

ClearAll[f];
f[a_,b_,c_,d_,e_,x_]:=Piecewise[{{a x+b,0≤x≤c},{d x+e,c≤x≤0.02}}]

NonlinearModelFit[adatok,f[a,b,c,d,e,x],{a,b,c,d,e},x]

Ezt nem szeretjük, nyilván belefutott egy másik lokális optimumba. Adjunk nem túl rossz kezdeti paraméterértékeket a becsléshez. Ehhez a korábbi számolások is használhatók, és egy alkalmas Manipuláte-ből tologatással is kaphatunk egy jó kezdeti becslést.

nlm=NonlinearModelFit[adatok,f[a,b,c,d,e,x],{{a,-3000},{b,20},{c,0.004},{d,-500},{e,13}},x]

nlm[x]

Show[ListPlot[adatok],Plot[nlm[x],{x,0,0.020}],Frame->True]

Kicsit gyanúsan szépen megtalálja ugyanazokat a paramétereket, mint az előbb, ha adunk neki jó kezdeti feltételeket. De hát lehet, hogy tényleg így kell leírni az adatokat.

Az újabb feladat az, hogy nem diszkrét pontjaink vannak, hanem egy képlettel megadott függvényünk, amit két egyenesszakasszal szeretnénk közelíteni. Legyen mondjuk a függvény a következő:

φ[x_]:=-Log[(E^(-0.1x))-(E^(-3x))]

Plot[φ[x],{x,0.1,5},AxesOrigin->{0,0},PlotLabel->"ez két szakaszból áll"]

Először mintát veszünk, és az előző feladatot oldjuk  meg ennek a függvénynek diszkrét pontjaira.

adat=Transpose[{ido={.2,.3,.5,.7,1,2,3,4,4.5,5},φ/@ido}]

eleje=Take[adat,4]

elmf=LinearModelFit[eleje,x,x]

vege=Take[adat,-6]

vlmf=LinearModelFit[vege,x,x]

Plot[{φ[x],elmf[x]Boole[x<0.9],vlmf[x]Boole[x>0.9]},{x,0.1,5}]

Most megpróbáljuk a folytonos feladatot megoldani. Elvileg így kellene, de így nem megy.

ClearAll[f];
f[a_,b_,c_,d_,e_,x_]:=Piecewise[{{a x+b,0≤x≤c},{d x+e,c≤x≤5}}]

nm=NMinimize[NIntegrate[(((φ[x]-f[a,b,c,d,e,x]))^2),{x,0,5}]{{a,-1.2},{b,1},{c,0.9},{d,0.1},{e,0.05}},x]

Azért nem megy, mert az integrált numerikusan nem tudja kiszámolni a paraméterek ismerete nélkül. Ha NIntegrate helyett az Intagrate fv-t használnéánk, akkor nagyon sokáig (?) számolja szimbolikusan az integrált. Segítsünk neki.

Számoljuk úgy a minimumot, hogy tegyük egyenlővé a minimalizálandó fv. paraméterek szerinti deriváltjait nullával. (Ezek a normál egyenletek.)

n10=D[Integrate[(((φ[x]-a x-b))^2),{x,0.1,0.7}],a]

n20=D[Integrate[(((φ[x]-a x-b))^2),{x,0.1,0.7}],b]

sol0=Solve[{n10==0,n20==0},{a,b}]

n15=D[Integrate[(((φ[x]-a x-b))^2),{x,1,5}],a]

n25=D[Integrate[(((φ[x]-a x-b))^2),{x,1,5}],b]

sol5=Solve[{n15==0,n25==0},{a,b}]

Plot[{φ[x],((a x+b)/.sol0)Boole[x<0.7],((a x+b)/.sol5)Boole[x>0.9]},{x,0.1,5},PlotLabel->"Nem is olyan rossz :)\n- a vége.",PlotRange->{0.1,1.4}]

Az eljáráshoz az kellett, hogy az illesztendő függvény a paraméterekben lineáris legyen. A határ automatikus meghatározása egyelőre bonyolultabbank  tűnik.