Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Mathematik

Kurvendiskussion für die Kommandozeile

Lizenz:Erster Autor:Letzte Bearbeitung:
MIT-LizenzMitgliedgrindstone 01.05.2015

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 Externer Link!Mathetrainer von Externer Link!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 drcken";
        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 fr 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 fr 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 gewnschte"
    Print "             Wertebereich hier explizit angegeben werden."
    Print "             Alternativ kann der Wertebereich w„hrend der Anzeige durch drcken"
    Print "             der Tasten ""+"" und ""-"" ge„ndert werden."
    Print "             Default: automatisch"
    Print
    Print "          /g <Gr”áe des Koordinatenkreuzes>   (in Pixeln)"
    Print "             Der Wert gilt sowohl fr die H”he als auch fr 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 Mitgliedgrindstone angelegt.
  • Die aktuellste Version wurde am 01.05.2015 von Mitgliedgrindstone gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen