Code-Beispiel
Kurvendiskussion für die Kommandozeile
Dieses Programm berechnet Nullstellen, Extremwerte und Wendepunkte eines Polynoms in einem angegebenen Intervall und zeigt diese -nach x - Werten geordnet- an, zusammen mit einer graphischen Darstellung des Polynoms und -optional- der 1. bis 3. Ableitung.
Um das Programm compilieren zu können, sind die Dateien calculate.bi aus dem 
Mathetrainer von nemored und plotter_mod.bi erforderlich, die im selben Verzeichnis wie dieser Quellcode abgelegt sein müssen.
Das compilierte Programm kann von der Kommandozeile oder aus einer Batch-Datei gestartet werden.
kudi.bas:
#Include "plotter_mod.bi"
Type nst
x As Double
f As Double
f1a As Double
f2a As Double
f3a As Double
End Type
Dim n As nst
Type pt
art As String
x As Double
y As Double
End Type
ReDim As pt punkt(1)
ReDim As Double ko(1), ko1a(1), ko2a(1), ko3a(1)
Dim As Double x, schritt, fortsetzungsabstand, bis, xvor, bereich, wertebereich
Dim As Integer i, j, breite, hoehe, groesse, zeilen, gflag
Dim As FB.Image Ptr puffer
Declare Function horner(x As Double, ko() As Double) As Double
Declare Sub ableitung(ko() As Double, ko1a() As Double)
Declare Function nuexwe(von As Double, bis As Double, schritt As Double, ko() As Double) As nst
Declare Function polynomFormat(k() As Double, modus As Integer) As String
Declare Sub hilfe
Declare Sub info
Declare Sub info2
Declare Sub fehler
x = -10
bis = 10
schritt = .00001
fortsetzungsabstand = .0000001
groesse = 800
wertebereich = 0
'kommandozeilenparameter auswerten
i = 1
j = 1
ReDim ko(j)
Do While Len(Command(i))
Select Case Left(Command(i),1)
Case "/"
Select Case LCase(Mid(Command(i),2))
Case "i" 'intervall
i += 1
If Command(i) = "" Then fehler 'fehlender wert
x = Val(Left(Command(i),InStr(Command(i),",")-1)) 'untergrenze
bis = Val(Mid(Command(i),InStr(Command(i),",")+1)) 'obergrenze
Case "s" 'schrittweite
i += 1
If Command(i) = "" Then fehler 'fehlender wert
schritt = Val(Command(i))
Case "f" 'fortsetzungsschritt
i += 1
If Command(i) = "" Then fehler 'fehlender wert
fortsetzungsabstand = Val(Command(i))
Case "g" 'größe des koordinatensystems
i += 1
If Command(i) = "" Then fehler 'fehlender wert
groesse = Val(Command(i))
Case "w" 'wertebereich
i += 1
If Command(i) = "" Then fehler 'fehlender wert
wertebereich = Val(Command(i))
Case "n"
gflag = BitSet(gflag,0) 'keine grafik
Case "1"
gflag = BitSet(gflag,1) '1. ableitung
Case "2"
gflag = BitSet(gflag,2) '2. ableitung
Case "3"
gflag = BitSet(gflag,3) '3. ableitung
Case "?" 'hilfe
hilfe
End
Case Else
fehler
End Select
Case Else 'koeffizient
ReDim Preserve ko(i) 'koeffizientenliste erweitern
ko(j) = Val(Command(i)) 'koeffizienten in liste schreiben
j += 1 'nächster koeffizient
End Select
i += 1 'nächster parameter
Loop
If i = 1 Then fehler 'keine parameter
'nullstellen, extremwerte und wendepunkte berechnen
xvor = horner(x - schritt,ko())
i = 1
ReDim punkt(0)
Do
n = nuexwe(x, bis, schritt, ko()) 'ersten punkt im intervall suchen
If n.x > bis Then 'kein (weiterer) punkt
Exit Do 'suche beenden
EndIf
ReDim Preserve punkt(i)
'auswertung
If n.f = 0 Then
punkt(i).art = " Nullstelle "
EndIf
If n.f1a = 0 Then
If Sgn(n.f2a) = -1 Then
punkt(i).art += " Maximum "
ElseIf Sgn(n.f2a) = 1 Then
punkt(i).art += " Minimum "
EndIf
EndIf
If (n.f2a = 0) And (n.f3a <> 0) Then
If (n.f1a = 0) Then
punkt(i).art += " Sattelpunkt "
Else
punkt(i).art += " Wendepunkt "
EndIf
EndIf
punkt(i).x += n.x
If n.f <> 0 Then
punkt(i).y = n.f
EndIf
i += 1
x = n.x + fortsetzungsabstand
Loop
zeilen = 4 + UBound(punkt) 'größe des fensters berechnen
If Bit(gflag,0) = 0 Then
ScreenRes groesse,zeilen * 8 + groesse,24 'grafikfenster öffnen
EndIf
Print
Print " Polynom ";polynomFormat(ko(),1) 'polynom auf bildschirm ausgeben
Print
'gefundene punkte auf bildschirm ausgeben und wertebereich für grafische darstellung berechnen
bereich = 0
For i = 1 To UBound(punkt)
Print punkt(i).art;" ";punkt(i).x;
If punkt(i).y <> 0 Then
Print " (y =";punkt(i).y;")";
EndIf
If Abs(punkt(i).x) > bereich Then
bereich = Abs(punkt(i).x)
EndIf
If Abs(punkt(i).y) > bereich Then
bereich = Abs(punkt(i).y)
EndIf
Print
Next
bereich = Int(bereich * 1.1) + 2
If wertebereich Then
bereich = wertebereich
EndIf
'Print
If Bit(gflag,0) = 0 Then 'grafik eingeschaltet
ableitung(ko(),ko1a())
ableitung(ko1a(),ko2a())
ableitung(ko2a(),ko3a())
Do
' graph auf bildschirm ausgeben __________________ _______________ _______________
' | term | |wertebereich x | |wertebereich y |
puffer = plotFunction(polynomFormat(ko(),2), -bereich, bereich, -bereich, bereich, _
groesse, groesse, 1, 1 )
'Koordinatensystem breite____| | | |__Skala y
'Koordinatensystem höhe_______________| |_____Skala x
If Bit(gflag,1) Then '1. ableitung grafisch darstellen
plotFunction(puffer, polynomFormat(ko1a(),2), -bereich, bereich, -bereich, bereich, _
1, 1, RGB(255,255,0), 1)
EndIf ' | |___kein koordinatenkreuz
' |__________graph in gelb
If Bit(gflag,2) Then '2. ableitung grafisch darstellen
plotFunction(puffer, polynomFormat(ko2a(),2), -bereich, bereich, -bereich, bereich, _
1, 1, RGB(255,0,0), 1) 'rot
EndIf
If Bit(gflag,3) Then '3. ableitung grafisch darstellen
plotFunction(puffer, polynomFormat(ko3a(),2), -bereich, bereich, -bereich, bereich, _
1, 1, RGB(0,255,0), 1) 'grün
EndIf
Put (0,zeilen * 8), puffer 'grafik auf bildschirm
'legende
If gflag And &b0001110 Then
Locate zeilen - 10 + groesse / 8, 1
Color RGB(255,255,255) 'weiss
Print " _____ f(x)"
EndIf
If Bit(gflag,1) Then
Color RGB(255,255,0) 'gelb
Print
Print " _____ ";
Color RGB(255,255,255)
Print "f'(x)"
EndIf
If Bit(gflag,2) Then
Color RGB(255,0,0) 'rot
Print
Print " _____ ";
Color RGB(255,255,255)
Print "f''(x)"
EndIf
If Bit(gflag,3) Then
Color RGB(0,255,0) 'grün
Print
Print " _____ ";
Color RGB(255,255,255)
Print "f'''(x)"
EndIf
Locate zeilen - 1 + groesse / 8, 2
Print "zum Beenden beliebige Taste drcken";
Do
Select Case InKey 'tastaturabfrage
Case ""
'nichts tun, weiter auf eingabe warten
Case "+" 'wertebereich vergrößern
bereich += 1
ImageInfo puffer,breite,hoehe
Line puffer,(0,0)-(breite,hoehe),RGB(0,0,0),BF 'pufferinhalt löschen
Put (0,zeilen * 8), puffer,PSet 'puffer auf bildschirm übertragen
ImageDestroy puffer 'speicher freigeben
puffer = 0 'pointer löschen
Exit Do '--> grafik neu zeichnen
Case "-" 'wertebereich verkleinern
If bereich > 1 Then bereich -= 1
ImageInfo puffer,breite,hoehe
Line puffer,(0,0)-(breite,hoehe),RGB(0,0,0),BF
Put (0,zeilen * 8), puffer,PSet
ImageDestroy puffer
puffer = 0
Exit Do
Case Else 'andere taste --> programm beenden
ImageDestroy puffer
End
End Select
Sleep 1 'pause zur ressourcenschonung
Loop
Loop
EndIf
End
Function horner(x As Double, k() As Double) As Double
Dim As Double f
Dim As Integer i
'funktionswert mithilfe des horner - schemas berechnen
f = k(1)
For i = 2 To UBound(k)
f = f * x + k(i)
Next
Return f
End Function
Function nuexwe(von As Double, bis As Double, schritt As Double, k() As Double) As nst
Dim As Double x, xvor, f, fvor, k1a(1), k2a(1), k3a(1), f1a, f1avor, f2avor, xm, f2a, schrittvor
Dim As Integer flag
Dim As nst n
Static As Double merken
xvor = von
fvor = horner(xvor,k())
ableitung(k(),k1a()) '1. ableitung
f1avor = horner(xvor,k1a())
ableitung(k1a(),k2a()) '2. ableitung
f2avor = horner(xvor,k2a())
ableitung(k2a(),k3a()) '3. ableitung
n.x = von
Do
n.f = horner(n.x,k())
n.f1a = horner(n.x,k1a())
n.f2a = horner(n.x,k2a())
If n.f = 0 Then 'nullstelle
Return n
ElseIf (Sgn(n.f) <> Sgn(fvor)) Or (Sgn(n.f1a) <> Sgn(f1avor)) Then 'nullstelle
Do
schritt = (n.x - xvor) / 2 'halbes intervall
xm = xvor + schritt
If Str(xm) = Str(xvor) Then 'genauigkeitsgrenze erreicht --> berechnung beenden
n.x = xm
Select Case flag
Case 1 'nullstelle
n.f = 0
Case 2 'extremwert
n.f1a = 0
End Select
Return n
EndIf
n.f = horner(xm,k()) 'f(xm)
n.f1a = horner(xm,k1a()) 'f'(xm)
n.f2a = horner(xm,k2a()) 'f''(xm)
If n.f = 0 Then 'nullstelle gefunden --> berechnung beenden
n.x = xm
Select Case flag
Case 1 'nullstelle
n.f = 0
Case 2 'extremwert
n.f1a = 0
End Select
Return n
ElseIf n.f = fvor Then 'genauigkeitsgrenze erreicht --> berechnung beenden
n.x = xm
Select Case flag
Case 1 'nullstelle
n.f = 0
Case 2 'extremwert
n.f1a = 0
End Select
Return n
ElseIf (Sgn(n.f) <> Sgn(fvor)) Or (Sgn(n.f1a) <> Sgn(f1avor)) Then 'punkt liegt in 1. intervallhälfte
If Sgn(n.f) <> Sgn(fvor) Then
flag = 1 'nullstelle
Else
flag = 2 'extremwert
EndIf
n.x = xm
Else 'punkt liegt in 2. intervallhälfte
xvor = xm
fvor = n.f
f1avor = n.f1a
EndIf
Loop
ElseIf (Sgn(n.f2a) <> Sgn(f2avor)) Then 'wendepunkt
Do
schritt = (n.x - xvor) / 2 'halbes intervall
xm = xvor + schritt
If Str(schritt) = Str(schrittvor) Then 'genauigkeitsgrenze erreicht
n.x = xm
n.f2a = 0
Return n
EndIf
n.f = horner(xm,k()) 'f(xm)
n.f1a = horner(xm,k1a()) 'f'(xm)
n.f2a = horner(xm,k2a()) 'f''(xm)
n.f3a = horner(xm,k3a()) 'f'''(xm)
If (Sgn(n.f2a) <> Sgn(f2avor)) Then 'wendepunkt liegt in 1. intervallhälfte
n.x = xm
Else 'wendepunkt liegt in 2. intervallhälfte
xvor = xm
fvor = n.f
f1avor = n.f1a
f2avor = n.f2a
EndIf
schrittvor = schritt
Loop
EndIf
xvor = n.x
fvor = n.f
f1avor = n.f1a
n.x += schritt
Loop Until n.x > bis 'intervallgrenze erreicht
Return n
End Function
Sub ableitung(k() As Double, k1a() As Double)
Dim As Integer grad = UBound(k), i
If UBound(k) = 1 Then
ReDim k1a(1)
k1a(1) = 0
Return
EndIf
ReDim k1a(grad - 1) 'koeffizientenarray für ableitung anlegen
For i = 1 To grad - 1 'ableitung bilden
k1a(i) = k(i) * (grad - i)
Next
End Sub
Function polynomFormat(k() As Double, modus As Integer) As String
Dim As Integer i
Dim As String rueck
Select Case modus
Case 0 'koeffizienten
For i = 1 To UBound(k)
rueck += Str(k(i)) + " "
Next
Case 1 'bildschirm
For i = 1 To UBound(k) - 1
rueck += " "
If (k(i) >= 0) And (i <> 1) Then
rueck += "+"
ElseIf (k(i) < 0) Then
rueck += "-"
EndIf
If k(i) = 1 Then
rueck += "x"
Else
rueck += Str(Abs(k(i))) + "x"
EndIf
If (UBound(k) - i) <> 1 Then
rueck += "^" + Str(UBound(k) - i)
EndIf
Next
rueck += " "
If k(UBound(k)) >= 0 Then
rueck += "+"
EndIf
rueck += Str(k(UBound(k)))
Case 2 'plotter
For i = 1 To UBound(k) - 1
If (k(i) >= 0) And (i <> 1) Then
rueck += "+"
EndIf
rueck += Str(k(i)) + "*x^" + Str(UBound(k) - i)
Next
If k(UBound(k)) >= 0 Then
rueck += "+"
EndIf
rueck += Str(k(UBound(k)))
End Select
Return rueck
End Function
Sub fehler
info
info2
'Sleep
End
End Sub
Sub info
Dim As String prgname = Mid(Command(0),InStrRev(Command(0),Any "/\") + 1)
Print
Print String(50,"-")
Print "Kurvendiskussion Version 1.1 Mai 2015"
Print String(50,"-")
Print
Print "Anwendung: ";prgname;" <Koeffizientenliste> [optionen]"
Print
End Sub
Sub info2
Dim As String prgname = Mid(Command(0),InStrRev(Command(0),Any "/\") + 1)
Print " mehr Information mit ";prgname;" /?"
Print
End Sub
Sub hilfe
Dim As String prgname = Mid(Command(0),InStrRev(Command(0),Any "/\") + 1)
info
Print
Print "--- Sofern nicht anders beschrieben, sind alle Zahlenwerte vom Typ double ---"
Print
Print
Print "Koeffizientenliste:"
Print
Print " Die Koeffizienten werden in absteigender Reihenfolge, jeweils durch ein"
Print " Leerzeichen getrennt, eingegeben:"
Print
Print " k[x^n] k[x^(n-1)] k[x^(n-2)] ... k[x^(n-n)]"
Print
Print " Beispiel: Der Aufruf fr das Polynom -x^3 +3*x^2 -3,5 lautet:"
Print " ";prgname;" -1 3 0 -3.5"
Print
Print "Optionen:"
Print
Print " Folgt auf eine Option ein Wert, wird dieser vom Optionszeichen durch ein"
Print " Leerzeichen getrennt. Jeder Zahlenwert, dem kein Optionszeichen vorangeht,"
Print " wird als Koeffizient gewertet."
Print
Print " /i <untere Intervallgrenze>,<obere Intervallgrenze>"
Print " Intervall, in dem nach Nullstellen, Extremwerten und Wendepunkten"
Print " gesucht wird."
Print " Default: -10,10"
Print
Print " /s <Schrittweite>"
Print " Schrittweite fr die Suche. Der Wert ist ein Kompromiss zwischen"
Print " Sicherheit (wenn in einem Abschnitt zwei oder mehr Werte"
Print " auftreten, ist die Berechnung mit hoher Wahrscheinlichkeit nicht"
Print " korrekt) und Rechengeschwindigkeit."
Print " Default: 0.00001"
Print
Print " /f <Fortsetzungsabstand>"
Print " Legt fest, in welchem Abstand von einem gefundenen Punkt das"
Print " Programm die Suche fortsetzt. Ist der Wert zu groá, besteht die"
Print " Gefahr, dass der n„chste Punkt nicht gefunden wird, ist er zu"
Print " klein, wird der soeben gefundene Punkt m”glicherweise ein"
Print " zweites Mal angezeigt."
Print " Default: 0.0000001"
Print
Print " /w <Wertebereich>"
Print " Wenn die graphische Darstellung mit dem vom Programm berechneten"
Print " Wertebereich nicht zufriedenstellend ist, kann der gewnschte"
Print " Wertebereich hier explizit angegeben werden."
Print " Alternativ kann der Wertebereich w„hrend der Anzeige durch drcken"
Print " der Tasten ""+"" und ""-"" ge„ndert werden."
Print " Default: automatisch"
Print
Print " /g <GrӇe des Koordinatenkreuzes> (in Pixeln)"
Print " Der Wert gilt sowohl fr die H”he als auch fr die Breite. Das"
Print " Koordinatensystem ist immer quadratisch."
Print " Default: 800"
Print
Print " /n Keine Grafik. Mit dieser Option wird die grafische Darstellung"
Print " abgeschaltet. Es werden lediglich die berechneten Punkte im"
Print " Konsolenfenster ausgegeben."
Print
Print " /1 Zus„tzliche grafische Darstellung der 1. Ableitung"
Print
Print " /2 Zus„tzliche grafische Darstellung der 2. Ableitung"
Print
Print " /3 Zus„tzliche grafische Darstellung der 3. Ableitung"
Print
Print " /? Hilfe"
End Sub
| Zusätzliche Informationen und Funktionen |
|---|
- Das Code-Beispiel wurde am 29.04.2015 von
 grindstone angelegt.
- Die aktuellste Version wurde am 01.05.2015 von grindstone gespeichert.
|
|
Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!
01.05.2015
Bearbeiten
Versionen