Besoin d'aide programmation méthode numérique bissection VB

Version imprimable

1 pièce(s) jointe(s)

Bonjour,
j'essaie de programmer la méthode bissection pour trouver les racines d'un fonction non linéaire f(x) sur un intervalle entre 0 et 1.
Pouvez m'aider? voilà ce que j'ai fais mais ca me retourne 0 comme valeur. Je crois que le problème se situe à la façon d'écrire les fonctions dans la boucle?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Option Explicit On 
 
Option Strict On 
 
Option Infer On 
 
Option Compare Binary 
 
 
Module Module2 
 
    Dim xm As Double 
 
    Dim fx1 As Double 
 
    Dim fx2 As Double 
 
    Dim fxm As Double 
 
    Dim compteur As Double 
 
 
    Public r As Double  ' Le résultat  ( la valeur de x pour f(x)=0 ) 
 
 
    Dim e As Double  ' L'erreur relative 
 
 
 
    Sub Methode_bisection(ByVal x1 As Double, ByVal x2 As Double, ByVal n As Double) 
 
 
 
        e = ((x2 - x1) / (2 ^ n)) 
 
 
        compteur = 0 
 
 
 
        Do While (Math.Abs(x2 - x1)) / (2 * (Math.Abs(xm))) < e 
 
 
            fx1 = 0.15 * (3.7 * (x1 ^ -0.5) / (2)) - (3.4) - (1.2 * (x1 ^ 3)) 
 
            fx2 = 0.15 * (3.7 * (x2 ^ -0.5) / (2)) - (3.4) - (1.2 * (x2 ^ 3)) 
 
            fxm = 0.15 * (3.7 * xm ^ -0.5) / (2) - (3.4) - (1.2 * (xm ^ 3)) 
 
 
            xm = (x1 + x2) / 2 
 
 
            If fx1 * fx2 < 0 Then 
 
                x2 = xm 
 
            Else 
 
                If fxm * fx2 < 0 Then 
 
                    x1 = xm 
 
 
                    End 
 
 
                End If 
 
 
                compteur = compteur + 1 
 
 
                If compteur > n Then 
 
                    MsgBox("Divergence") 
 
 
 
                    Exit Sub 
 
 
 
                End If 
 
 
            End If 
 
 
        Loop 
 
        r = xm    ' r; le résultat devrait être proche de  x= 0,2909815 
 
 End Sub 
End Module

Pièce jointe 189002

28/09/2015, 20h21
clementmarcotte

Bonjour,

J'ai comme l'impression que tu devrais regarder du côté de la récursivité. (Une procédure qui s'appelle elle-même.) L'idée de base étant que chaque fois qu'elle teste deux nouvelles bornes, ta procédure s'appelle elle-même avec les deux nouvelles bornes en paramètres.

Mais, pour les détails, mes cours de mathématiques sont trop loin.
28/09/2015, 23h50
Pom55

Merci pour votre réponse,

je ne me souviens pas comment on peut déclarer une fonction par exemple

Dim f() as ?? = a*(x^2) +b*x+c

et ensuite l'appeler et insérer entre les parenthèses la variable qui prendra la valeur de x

par exemple

f(x1)
f(x2)
f(xm)

Bonjour,

Non, je parle d'une procédure Function de VB. Le rôle d'une Function c'est de retourner une valeur, que l'on peut ensuite affecter à une variable.

Par exemple :
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub Calcul() dim total as double = 0 total = AuCarré(9) messagebox.show(total.tostring) end sub Function AuCarré(Nombre as Double) Dim Réponse as Double =0 Réponse = Nombre * Nombre return Réponse End Function

bonjour
La 1ere des choses est de consolider serieusement tes connaissances en vb.net...car des questions comme :

Citation:

je ne me souviens pas comment on peut déclarer une fonction par exemple

N'auront aucune reponse car les membres du forum ne sont pas là ,pour combler tes souvenirs...
Les tutoriaux du forum sont là pour ca et tu dois faire l'effort de les lires....!!!

Ensuite tu as mal compris la methode de Bissection ou Dichotomie (ou lu à la vite comme ton cours de vb.net)...car :
Pour un intervalle initial(x1,x2) choisi

1/ si f(x1) * f(x2) < 0 ( la Fonction coupe l'axe des -X dans cet intervalle) ,la convergence est assuree ....
2/ si f(x1) * f(x2) > 0 (la Fonction peut ou non couper l'axe des X dans cet intervalle),la converge n'est pas assuree...
En general c'est le cas d'un intervalle de calcul tres grand...Aussi faut-il un nbre d'iterations N eleve ou reduire l'intervalle....

Ton code comporte des erreurs de logique grossieres:
-epsilon n'est calculee en valeur absolue mais il est compare à une valeur absolue...
Des erreurs de syntaxe grossiere (le cours vb.net !!!)
- If ...Else ...Endif mal fagotes...
- Do .......Loop Until inconnu dans ton quartier ...
- Function idem...

bref voici ce qu'aurait du etre ton code (pour l'affichage des iteres j'utilise un StringBuilder et un textbox):

code .vb du module Dichotomie:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 
Imports System.Text
Module Dichotomie
    'Public members
 
    'un StringBuilder helper pour afficher les iterations
    Public sb As New StringBuilder
    Public r As Double  ' Le résultat  ( la valeur de x pour f(x)=0 ) 
 
    'Privates members
    Private xm As Double
    Private fx1 As Double
    Private fx2 As Double
    Private fxm As Double
    Private compteur As Integer
    Private e As Double  ' L'erreur relative 
 
    Public Sub Bissection(ByVal x1 As Double, ByVal x2 As Double, ByVal N As Double)
        e = Math.Abs(x2 - x1) / (2 ^ N)  'VALEUR ABSOLUE
 
        compteur = 0
        sb.Clear()
        sb.AppendLine("00x100000  |" + "00x200000  |" + "00xm00000  |" + "N Iter")
 
        Do
            xm = (x1 + x2) / 2
 
            sb.AppendLine(x1.ToString("00.00000") + " | " +
                         x2.ToString("00.00000") + " | " +
                         xm.ToString("00.00000") + " | " +
                        compteur.ToString("000"))
 
 
            If FN(x1) * FN(xm) < 0 Then
                x2 = xm
            ElseIf FN(xm) * FN(x2) < 0 Then
                x1 = xm
            End If
            compteur += 1
 
            If compteur > N Then
                MsgBox(" limite des iterations atteinte !!!")
                Exit Do
            End If
 
        Loop Until (Math.Abs(x2 - x1) / (2.0 * Math.Abs(xm))) < e
 
        r = xm    ' r; le résultat devrait être proche de  x= 0,2909815 
 
 
    End Sub
    'Public Function 
    Public Function FN(ByVal x As Double) As Double
        Const f As Double = 0.15
        Const a As Double = 3.7
        Const b As Double = 1.2
        Const c As Double = 3.4
        Dim fx As Double = f * (a * (x ^ -0.5 / 2) - c - (b * x ^ 3))
        Return fx
    End Function
 
 
End Module

code .vb du form de test :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
 
Public Class frmBissection
    Private fa, fb As Double
    Private xa, xb As Double
    Private Niter As Integer
    Public Sub New()
 
        ' Cet appel est requis par le concepteur.
        InitializeComponent()
 
        ' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
 
        Me.Size = New Size(600, 500)
 
        Button1.Location = New Point(25, 50)
 
        lblFa.Location = New Point(150, 50)
        lblFb.Location = New Point(250, 50)
        lblResult.Location = New Point(350, 50)
 
        TextBoxIterations.Location = New Point(25, 100)
        TextBoxIterations.Size = New Size(500, 300)
        TextBoxIterations.Multiline = True
        TextBoxIterations.ScrollBars = ScrollBars.Both
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        xa = -0 : xb = 1.0 : Niter = 100
        fa = Dichotomie.FN(xa)
        fb = Dichotomie.FN(xb)
        lblFa.Text = fa.ToString
        lblFb.Text = fb.ToString
        If fa * fb > 0 Then  ' C'EST ICI QUE L'ALGO DICHOTOMIE PEUT DIVERGER
            MsgBox("possibilite de divergence ...diminuer l'intervalle x1,x2 ...!!!")
        Else
            MsgBox("Converge assuree dans l'intervalle x1,x2 ...!!!")
            Dichotomie.Bissection(xa, xb, Niter)
            lblResult.Text = Dichotomie.r.ToString
            TextBoxIterations.Text = Dichotomie.sb.ToString
        End If
    End Sub
 
 
End Class

bon code...