() Prgm © Kurvendiskussion ©2013-2014 Peter Engels Local i,diml,f,f1,f2,f3,sf,l,l1,l2,lp,lh,lh2,m,nd,tp,tmp,sgn,oldm,oldm1,oldf,olddeg,oldfld,illegal,getfunc,getlim,getsgn,getzeros,checksgn,newmode,newdig,grshown,errf Define illegal()=Prgm Disp "ungültiger Funktionsterm" Pause ClrIO EndPrgm Define getfunc()=Prgm Lbl again Dialog Title "Funktionsterm f(x)" Request "f(x)",discuss\fstr DropDown "Modus",{"auto","exact","approximate"},md DropDown "Display Digits",{"FIX 0","FIX 1","FIX 2","FIX 3","FIX 4","FIX 5","FIX 6","FIX 7","FIX 8","FIX 9","FIX 10","FIX 11","FIX 12","FLOAT","FLOAT 1","FLOAT 2","FLOAT 3","FLOAT 4","FLOAT 5","FLOAT 6","FLOAT 7","FLOAT 8","FLOAT 9","FLOAT 10","FLOAT 11","FLOAT 12"},dispdg EndDlog If ok=0 and fstr="" Goto again EndPrgm Define getlim()=Prgm Dialog Title "Integrationsgrenzen" Request "a",discuss\astr Request "b",discuss\bstr EndDlog EndPrgm Define getsgn(f,x0)=Func Local ε,x1,x2 1.−5→ε If x0=0 Then −ε→x1 ε→x2 Else x0-ε*abs(x0)→x1 x0+ε*abs(x0)→x2 EndIf If (f|x=x1)<0 and (f|x=x2)>0 Then Return −1 ElseIf (f|x=x1)>0 and (f|x=x2)<0 Then Return 1 Else Return 0 EndIf EndFunc Define getzeros(f)=Prgm Local l,tmp zeros(f,x)→l approx(l)→tmp SortA tmp,l l→gl EndPrgm Define checksgn(f,x0)=Func If (f|x=x0)<0 Then Return "fallend bis" ElseIf (f|x=x0)>0 Then Return "steigend bis" Else Return "konstant" EndIf EndFunc Define newmode(md)=Prgm If md=1 Then setMode("exact/approx","auto") ElseIf md=2 Then setMode("exact/approx","exact") Else setMode("exact/approx","approximate") EndIf EndPrgm Define newdig(dispdg)=Prgm Local dig,mkstr dispdg-1→dispdg If dispdg≤12 Then string(exact(dispdg))→dig setMode("Display Digits","FIX "&dig) ElseIf dispdg=13 Then setMode("Display Digits","FLOAT") Else dispdg-13→dispdg string(exact(dispdg))→dig setMode("Display Digits","FLOAT "&dig) EndIf EndPrgm Define errf()=Prgm Disp "zunächst muss f(x)" Disp "gezeichnet werden." Pause EndPrgm PlotsOff FnOff setFold(discuss)→oldfld getMode("exact/approx")→oldm getMode("display digits")→oldf "NONE"→nd If getType(md)=nd 1→md If getType(dispdg)=nd 3→dispdg newmode(md) newdig(dispdg) setMode("angle","RADIAN")→olddeg NewProb ClrIO Disp "" DelVar x,ξ false→grshown If getType(fstr)=nd getfunc() Try expr(fstr)→f Else illegal() Goto getf EndTry Lbl bar ClrIO Toolbar Title "f(x)",getf Title "Elementares" Item "Achsenschnittp.",asp Item "Symmetrie",sym Item "Monotonie",mono Item "Grenzwerte",limes Item "Asymptote",propf Item "Umkehrfunktion",invf Title "Calculus" Item "Ableitungen",abl Item "Extremwerte",htps Item "Wendepunkte",wps Item "Krümmung",krue Item "Integral",intg Item "Rotationsvolumen",rotvol Item "Mantelfläche",surface Item "Bogenlänge",bogl Title "Graph" Item "f(x)",grphf Item "f'(x)",grphf1 Item "f''(x)",grphf2 Title "Exit",down EndTBar If ok=0 Then Goto bar EndIf Lbl getf getfunc() If ok=0 Then Goto bar ElseIf dim(fstr)=0 Then Goto getf EndIf DelVar f1,f2,f3,sf,l,l1,l2,lp newmode(md) newdig(dispdg) Try expr(fstr)→f Else illegal() Goto getf EndTry false→grshown Goto bar Lbl asp Disp "Achsenschnittpunkte" If getType(l)=nd Then getzeros(f) gl→l EndIf dim(l)→diml newMat(diml+1,2)→m For i,1,diml "x="→m[i,1] l[i]→m[i,2] EndFor "f(0)="→m[diml+1,1] f|x=0→m[diml+1,2] Pause m Goto bar Lbl sym Disp "Symmetrie" If string((f|x=ξ)-(f|x=−ξ))="0" Then Disp "f ist achsensymmetrisch" ElseIf string((f|x=ξ)+(f|x=−ξ))="0" Then Disp "f ist punktsymmetrisch" Else Disp "f hat keine Symmetrie" EndIf Pause Goto bar Lbl mono Disp "Monotonie" If getType(lp)=nd Then getzeros(getDenom(f)) gl→lp EndIf If getType(l1)=nd Then If getType(f1)=nd (f,x)→f1 getzeros(f1) gl→l1 EndIf augment(lp,l1)→lh approx(lh)→tmp SortA tmp,lh dim(lh)→diml If diml>0 Then {lh[1]-5}→lh2 For i,1,diml-1 augment(lh2,{(lh[i]+lh[i+1])/2})→lh2 EndFor augment(lh2,{lh[diml]+5})→lh2 dim(lh2)→diml newMat(diml,2)→m If inString(string(lh2),"@")>0 Then "per."→m[1,1] lh[i]→m[1,2] Else For i,1,diml-1 Try checksgn(f1,lh2[i])→m[i,1] Else "??"→m[i,1] EndTry lh[i]→m[i,2] EndFor Try checksgn(f1,lh2[diml])→m[diml,1] Else "??"→m[diml,1] EndTry ∞→m[diml,2] EndIf Pause m Else Try checksgn(f1,1)→m[i,1] Else Disp "unbekannt" EndTry Pause EndIf Goto bar Lbl propf Disp "Asymptote" Pause propFrac(f) Goto bar Lbl limes Disp "Grenzwerte" If getType(lp)=nd Then getzeros(getDenom(f)) gl→lp EndIf dim(lp)→diml newMat(2*diml+2,2)→m "x→+∞"→m[1,1] Try limit(f,x,∞)→m[1,2] Else "div"→m[1,2] EndTry "x→−∞"→m[2,1] Try limit(f,x,−∞)→m[2,2] Else "div"→m[2,2] EndTry For i,1,diml "x→"&string(lp[i])&"|-"→m[1+2*i,1] Try limit(f,x,lp[i],−1)→m[1+2*i,2] Else "div"→m[1+2*i,2] EndTry "x→"&string(lp[i])&"|+"→m[2+2*i,1] Try limit(f,x,lp[i],1)→m[2+2*i,2] Else "div"→m[2+2*i,2] EndTry EndFor Pause m Goto bar Lbl invf Disp "Umkehrfunktion" Pause solve(y=f,x) Goto bar Lbl abl Disp "Ableitungen" If getType(f1)=nd (f,x)→f1 If getType(f2)=nd (f1,x)→f2 If getType(f3)=nd (f2,x)→f3 If getType(sf)=nd ∫(f,x)→sf newMat(5,2)→m "f="→m[1,1] f→m[1,2] "f'="→m[2,1] f1→m[2,2] "f''="→m[3,1] f2→m[3,2] "f'''="→m[4,1] f3→m[4,2] "∫f="→m[5,1] sf→m[5,2] Pause m Goto bar Lbl htps Disp "Extremwerte" If getType(f1)=nd (f,x)→f1 If getType(f2)=nd (f1,x)→f2 If getType(l1)=nd Then getzeros(f1) gl→l1 EndIf dim(l1)→diml newMat(diml+1,4)→m "Typ"→m[1,1] "x"→m[1,2] "y"→m[1,3] "f''"→m[1,4] For i,1,diml l1[i]→m[i+1,2] f|x=l1[i]→m[i+1,3] f2|x=l1[i]→m[i+1,4] Try getsgn(f1,l1[i])→sgn Else 2→sgn EndTry If sgn=2 Then "??"→tp ElseIf sgn=−1 Then "TP"→tp ElseIf sgn=1 Then "HP"→tp Else "SP"→tp EndIf tp→m[i+1,1] EndFor Pause m Goto bar Lbl wps Disp "Wendepunkte" If getType(f3)=nd (f2,x)→f3 If getType(l2)=nd Then If getType(f1)=nd (f,x)→f1 If getType(f2)=nd (f1,x)→f2 getzeros(f2) gl→l2 EndIf dim(l2)→diml newMat(diml+1,4)→m "Typ"→m[1,1] "x"→m[1,2] "y"→m[1,3] "f'''"→m[1,4] For i,1,diml l2[i]→m[i+1,2] f|x=l2[i]→m[i+1,3] f3|x=l2[i]→m[i+1,4] Try getsgn(f2,l2[i])→sgn Else 0→sgn EndTry If sgn=−1 Then "RL"→tp ElseIf sgn=1 Then "LR"→tp Else "P"→tp EndIf tp→m[i+1,1] EndFor Pause m Goto bar Lbl krue Disp "Krümmung" newMat(3,2)→m If getType(f1)=nd (f,x)→f1 If getType(f2)=nd (f1,x)→f2 "k"→m[1,1] "x"→m[2,1] "y"→m[3,1] (1+f1^2)^(3/2)/f2^2→m[1,2] x-f1*(1+f1^2)/f2→m[2,2] f+(1+f1^2)/f2→m[3,2] Pause m Goto bar Lbl intg Disp "best. Integral" getlim() If dim(astr)*dim(bstr)=0 Then Goto intg EndIf newMat(1,2)→m If getType(sf)=nd ∫(f,x)→sf "∫f="→m[1,1] If inString(string(sf),"∫")>0 Then nInt(f,x,expr(astr),expr(bstr))→m[1,2] Else (sf|x=expr(bstr))-(sf|x=expr(astr))→m[1,2] EndIf Pause m Goto bar Lbl rotvol Disp "Rotationsvolumen" getlim() If dim(astr)*dim(bstr)=0 Then Goto rotvol EndIf newMat(1,2)→m "RotV="→m[1,1] π*∫(f^2,x,expr(astr),expr(bstr))→m[1,2] Pause m Goto bar Lbl surface Disp "Mantelfläche" getlim() If getType(f1)=nd (f,x)→f1 If dim(astr)*dim(bstr)=0 Then Goto surface EndIf newMat(1,2)→m "MF="→m[1,1] 2*π*∫(f*√(1+f1^2),x,expr(astr),expr(bstr))→m[1,2] Pause m Goto bar Lbl bogl Disp "Bogenlänge" getlim() If dim(astr)*dim(bstr)=0 Then Goto bogl EndIf newMat(1,2)→m "BL="→m[1,1] arcLen(expr(fstr),x,expr(astr),expr(bstr))→m[1,2] Pause m Goto bar Lbl grphf FnOff 2,3 If getType(f1)=nd (f,x)→f1 If getType(f2)=nd (f1,x)→f2 If getType(l)=nd Then getzeros(f) gl→l EndIf If getType(l1)=nd Then getzeros(f1) gl→l1 EndIf If getType(l2)=nd Then getzeros(f2) gl→l2 EndIf If getType(lp)=nd Then getzeros(getDenom(f)) gl→lp EndIf setMode("exact/approx","approximate")→oldm1 augment(l,l1)→lh augment(lh,l2)→lh augment(lh,lp)→lh 2→xres expr(fstr&"→y1(x)") If inString(string(lh),"@")>0 Then −5→xmin 5→xmax Else Try min(lh)-1→xmin max(lh)+1→xmax Else −2→xmin 2→xmax EndTry EndIf 10^(iPart(log(xmax-xmin))-1)→xscl If (xmax-xmin)/xscl>30 xscl*10→xscl Try Try ZoomFit Trace (ymax-ymin)/10→yscl Else ClrErr ymin-1→ymin ymax+1→ymax Trace (ymax-ymin)/10→yscl EndTry true→grshown Else false→grshown DispHome ClrIO Disp "Diese Funktion kann" Disp "nicht dargestellt werden" Pause EndTry setMode("exact/approx",oldm1) DispHome Goto bar Lbl grphf1 If grshown Then setMode("exact/approx","approximate")→oldm1 expr(string(f1)&"→y2(x)") FnOff 3 Trace setMode("exact/approx",oldm1) DispHome Else errf() EndIf Goto bar Lbl grphf2 If grshown Then setMode("exact/approx","approximate")→oldm1 expr(string(f1)&"→y2(x)") expr(string(f2)&"→y3(x)") Trace setMode("exact/approx",oldm1) DispHome Else errf() EndIf Goto bar Lbl down setMode("exact/approx",oldm) setMode("Display Digits",oldf) setMode("angle",olddeg) setFold(#oldfld) DelVar gl DispHome EndPrgm