Applications

Accueil

Racines réelles et complexes d'un polynôme

4 Code allégé VB5

1 Algorithme>

2 Programme

3 Applications

4 Code allégé VB5


  Version allégée de "Racines", comportant seulement les sous programmes indispensables, utilisable :
- soit par un copier-coller dans le code d'un nouveau programme VB5, sauvé dans un nouveau dossier
- soit en l'incorporant ( à l'exception de Private Sub Form_Activate() ) dans un programme VB5 nécessitant la recherche des racines réelles et complexes d'un polynôme dont les coefficients seraient contenus dans Pol(0,I) et les racines calculées dans Rac(I, 4).

  La description de la méthode et les commentaires ci-dessous devraient faciliter la traduction dans un autre langage


Dim Deg_Init As Integer             ' Degré du polynôme à traiter
Dim Deg_Cour As Integer         ' Degré du polynôme courant après détermination d'une racines réelle ou complexe 
Dim XR As Double                    ' Approximations successives de la partie réelle d'une racine
Dim XI As Double                     ' Approximations successives de la partie imaginaire d'une racine
Dim YR As Double                    ' Partie réelle de la fonction ou d'une des dérivées d'une fonction complexe
Dim YI As Double                     ' Sa partie imaginaire . Voir : Sub POL_Z
Dim Nbr_Rac_Reel As Integer   ' Décompte des racine réelles
Dim NR As Integer                     ' Numéro de la racine réelle courante
Dim XR0 As Double                   ' Approximation initiale de la partie réeele
Dim XI0 As Double                    ' Approximation initiale de la partie imaginaire
Dim Test_Err As Integer             ' Test_Err = 0 ou 1 dans l'éventualité d'une division par zéro
Dim PI As Double                      ' 3.14159....
Dim Pol(1, 101) As Double        ' Pol(0, 101) pour les coef du polynôme courant et Pol(1, 101)pour sa dérivée
Dim Pol_Ini(101) As Double       'Polynôme initial
Dim Rel(101) As Double             ' Relais temporaire
Dim Rac(101, 4) As Double        ' Racines du polynôme. Dans l'ordre : parties réelles, imaginaire, module et argument

Private Sub Form_Activate()

'*** SIMULE LE PROGRAMME APPELANT ***

'TEST : enregistrement des données de la démonstration N°9
Deg_Init = 16                             ' Degré du polynôme à traiter
For I = 0 To Deg_Init                 ' Coefficients par ordre décroissant des puissance de X
    Pol(0, I) = 0
Next I
Pol(0, 0) = 318644812890625#
Pol(0, 4) = 859966898684#
Pol(0, 8) = 816625158
Pol(0, 12) = 1532
Pol(0, 16) = 1

EXECUTION

'Vérification des résultats depuis Rac(I,J) vers " Fichier_Sortie.txt "
Open CurDir$ & "\Fichier_Sortie.txt" For Output As #1
For I = 1 To Deg_Init
   Write #1, Format(I, " 00 ") & Format(Rac(I, 1), " 00.000 000 000 000 ") & Format(Rac(I, 2), " 00.000 000 000 000") & Format(Rac(I, 3), " 00.000 000 000 000 ") & Format(Rac(I, 4), " 00.000 000 000 000")
Next I
Close #1

End Sub

Public Sub EXECUTION()
Erase Rel, Rac
Test_Err = 0
Cls
PI = 4 * Atn(1)
XR0 = PI / 3                              'Approximation initiale complexe
XI0 = PI / 4                               'XI<>XR si non, certaines equations(X^8+1=0)insolubles
'Pour limiter le risque d'une division par zéro la constante est légèrement rehaussée
'Sinon, ce serait le cas avec x^ 3 + x^ 2 + x + 1 = 0

Pol(0, 0) = Pol(0, 0) + 0.000000000000001
Deg_Cour = Deg_Init
'Simplifie l'équation à résoudre en abaissant à 1 le coefficient du terme de degré le plus élevé
If Pol(0, Deg_Init) <> 1 Then
    Diviseur = Pol(0, Deg_Init)
    For I = 0 To Deg_Init
        Pol(0, I) = Pol(0, I) / Diviseur
    Next I
End If
For I = 0 To Deg_Init
    Pol(0, I) = Pol(0, I)
Next I
'Extraction des racines
NR = 0                                      'Nombre de racines
XR = XR0                                 'Approximation initiale réelle
XI = 0                                       'donc partie imaginaire nulle
Do
    'Calcul de la dérivée du polynôme courant
    For J = 0 To Deg_Cour
        Pol(1, J) = Pol(0, J + 1) * (J + 1)
    Next J
    ZERO 0, XR, XI                    'Recherche d'un zéro
    If Test_Err = 1 Then Exit Sub 'Arrêt évitant une division par zéro
    If Nbr_Rac_Reel = 101 Then 'Si les racines réelles sont épuisées :
        XR = XR0                         'Approximation initiale complexe
        XI = XI0                            'XI<>XR si non, certaines équations insolubles
        ZERO 0, XR, XI                'Recherche d'un zéro complexe
        If Test_Err = 1 Then Exit Sub   'Arrêt évitant une division par zéro
    End If
    If Abs(XI) < 0.0000001 Then 'Si la partie imaginaire est < 0.00001 :
            NR = NR + 1                 ' la racine est donc réelle
            Rac(NR, 1) = XR           'Mémorisation de la racine réelle
            Rac(NR, 3) = Abs(XR)  'Mémorisation du module
            If Rac(NR, 1) >= 0 Then Rac(NR, 4) = 0 Else Rac(NR, 4) = PI    'Argument. d'une racine réelle négative
            'Abaissement de 1 degré après extraction d'une racine réelle
            Rel(Deg_Cour) = 0
            Rel(Deg_Cour - 1) = 1
            For K = (Deg_Cour - 2) To 0 Step -1
               Rel(K) = Pol(0, K + 1) + Rel(K + 1) * XR
            Next K
            'Copie du quotient dans Pol()
            For I = 0 To Deg_Cour
                Pol(0, I) = Rel(I)
            Next I
            Deg_Cour = Deg_Cour - 1
        Else                                   'La partie imaginaire est > 0.00001 :
            NR = NR + 1                'Numéro de la racine complexe
            If Abs(XR) < 0.0000001 Then XR = 0
            Ro = Sqr(XR ^ 2 + XI ^ 2)                 'Calcul du module
            If XR <> 0 Then Teta = Abs(Atn(XI / XR)) Else Teta = PI / 2
            If XR < 0 Then Teta = PI / 2 + Abs(Atn(XR / XI))
            Rac(NR, 1) = XR          ' Mémorisation de la partie réelle
            Rac(NR, 2) = -Abs(XI) ' Mémorisation de la partie imaginaire >0
            Rac(NR, 3) = Ro           'Mémorisation du module
            Rac(NR, 4) = -Teta        'Mémorisation de l'angle en radians
            NR = NR + 1                 'Numéro de la racine conjuguée
            Rac(NR, 1) = XR           'Mémorisation de la partie réelle de la racine conjuguée
            Rac(NR, 2) = Abs(XI)    'Mémorisation de la partie imaginaire conjuguée ( <0 )
            Rac(NR, 3) = Ro            'Mémorisation du module de la racine conjuguée
            Rac(NR, 4) = Teta          'Mémorisation de l'angle de la racine conjuguée en radians
            'Abaissement de 2 degrés après extraction d'une paire de racines complexes
            Rel(Deg_Cour) = 0
            Rel(Deg_Cour - 1) = 0
            Rel(Deg_Cour - 2) = 1
            Module = XR ^ 2 + XI ^ 2
            For K = (Deg_Cour - 3) To 0 Step -1
                Rel(K) = Pol(0, K + 2) + 2 * Rel(K + 1) * XR - Rel(K + 2) * Module
            Next K
            'Copie du quotient dans Pol()
            For I = 0 To Deg_Cour
                Pol(0, I) = Rel(I)
            Next I
            Deg_Cour = Deg_Cour - 2
    End If
    If Deg_Cour < 1 Then Exit Do ' Toute les racines sont extraites
Loop
End Sub

Public Sub POL_Z(IDer, XR, XI, YR, YI)
'Calcul de la fonction ou de l'une de ses dérivée
'IDer = Ordre de dérivation : 0 pour la fonction ou 1,2, ...pour Y',Y", ..
'XR et XI Valeurs de la variable complexe (ou réelle si XI=0 )
'YR et YI Valeurs de la fonction complexe :
' Y=X(X(...(X(X+a(n-1))...+a(2))+a(1))+a(0)

YR = Pol(IDer, Deg_Cour) * XR
YI = Pol(IDer, Deg_Cour) * XI
For I = (Deg_Cour - 1) To 1 Step -1
    YR = YR + Pol(IDer, I)
    YR2 = XR * YR - XI * YI
    YI2 = XR * YI + XI * YR
    YR = YR2
    YI = YI2
Next I
YR = YR + Pol(IDer, 0)
End Sub

Public Sub ZERO(I_Der, XR, XI)
'Recherche d'un zéro par la méthode Newton-Raphson : Z=Z-F(z)/F'(z)
For Nbr_Rac_Reel = 1 To 100
    POL_Z I_Der, XR, XI, FR, FI                'XR et XI parties réelle et imaginaire de la variable complexe
    POL_Z I_Der + 1, XR, XI, FPR, FPI     'FR,FI,FPR et FPI parties réelles et imaginaires de la fonction et de sa dérivée
    Module = FPR ^ 2 + FPI ^ 2
    'Pour éviter une division par zéro
    If Module = 0 Then
        Rep = MsgBox("Arrêt prématuré évitant une division par zéro. Recommencez en modifiant très légèrement les coefficients", , " Attention ! ")
        Test_Err = 1 
        Exit Sub
    End If
    DeltaR = (FR * FPR + FI * FPI) / Module
    DeltaI = (FI * FPR - FR * FPI) / Module
    'Z=Z-Delta
    XR = XR - DeltaR
    XI = XI - DeltaI
    If (Abs(DeltaR) < 10 ^ -12) And (Abs(DeltaI) < 10 ^ -12) Then Exit For
Next Nbr_Rac_Reel
End Sub


 

  Muni du sous-programme Private Sub Form_Activate introduisant les coefficients du polynôme décrivant la 7ème démonstration , le fichier de résultats ci-contre affichera, ligne par ligne, les parties réelles et imaginaires ainsi que les modules et les arguments des racines par ordre chronologique de leurs extractions.
  Les triplets pytagoriciens sont parfaitement restituées
(écarts inférieurs à 10-12 ).


Extraire la page pour l'enregistrer ou l'imprimer