Sujet Précédent Sujet Suivant

Problème d'apprentissage d'une classe de réseau de neurone

Résolu
Flocreate Messages postés 300 Date d'inscription lundi 17 juillet 2006 Statut Membre Dernière intervention 27 mai 2012 - 7 sept. 2010 à 20:09
Flocreate Messages postés 300 Date d'inscription lundi 17 juillet 2006 Statut Membre Dernière intervention 27 mai 2012 - 8 sept. 2010 à 09:23
Bonjour,
Je suis en trein de finir d'implémenter une classe permettant de créer un réseau de neurones.
J'ai l'impression d'avoir suivi pas à pas la doc donnée à cette adresse
http://www.hacking.free.fr/paris8/Backpropagation.htm

cependant, mon réseau est incapable d'apprendre la moindre table booleènne...
je fais mes tests sur le réseau suivant :
1 couche d'entrée (2 neurones), 1 couche cachée (2neurones) et une couche de sortie (1 neurone)

ce que je remarque c'est que mon réseau est capable d'apprendre chacun des cas séparément.
-1 -1 -> -1
-1 1 -> -1
1 -1 -> -1
1 1 -> 1
en revenche, si je demande l'apprentissage de tous les cas "en même temps" et bien là le réseau n'arrive pas à apprendre

Je met le code de la classe dans le post suivant pour faire propre

Si une personne pouvait m'expliquer ce qui ne va pas dans le réseau ou dans la méthode d'apprentissage, je lui en serrais reconnaissant

3 réponses

Réponse 1 / 3
Flocreate Messages postés 300 Date d'inscription lundi 17 juillet 2006 Statut Membre Dernière intervention 27 mai 2012 3
7 sept. 2010 à 20:12 
Option Explicit
' classe de réseau de neurone de type : perceptron multicouche complètement connectées
'
'   implémentation de Flocreate
'
'   doccumentation claire : http://www.hacking.free.fr/paris8/Backpropagation.htm
'
' on utilise pour les couches cachées la fonction de tranfert ThanH(x)
'    la fonction tangeante hyperbolique a l'avantage d'avoir pour dérivée 1-TanH(x)²
'    ceci implique que si on a calculé précédement le TanH(x) on a juste a faire 1-X*X --> gain de temps de calcul

'on utilise une version On-Line (Séquencielle) il faut tirer les cas au hazard
Private Const Bias_Value As Long = 1
'###################################################################################
'###################################################################################
    Private nb_c As Long            ' contient le nombre de couches
        Private Cs() As Long        ' contient le nombre de neurone par couche

    Private Ws As Variant           'contient la table des poids Ws(couche)((n-1)*Cs(c)+n1)
    
    Private Xs As Variant           'contient la table des sorties des neurones
    Private Bs As Variant           'contient la table des Biais des neurones
'###################################################################################
'###################################################################################


'###################################################################################
'###################################################################################
Public Function Construire(ParamArray Chs() As Variant) As Boolean
    ' accepte les syntaxes
    '   Call Construire(nb_n_e, nb_n_c1, nb_n_cn, nb_n_s)
    '   Call Construire(Array(nb_n_e, nb_n_c1, nb_n_cn, nb_n_s))
    '   Call Construire(T) 'avec T un tableau de !VARIANT! T={nb_n_e, nb_n_c1, nb_n_cn, nb_n_s}

    If (UBound(Chs) >= 2) Then
        'les données sont dans chs
    Else
        'les données sont potentiellement dans chs(0)
        If (UBound(Chs) = -1) Then GoTo erreur  'aucune donnée en entrée -> chs(0) n'existe pas
        Dim tmpChs As Variant
        On Error GoTo erreur    'type incompatible
            tmpChs = Chs(0)
            Chs = tmpChs
        On Error GoTo 0
        'maintenant les données sont dans chs
    End If

On Error GoTo erreur
    'obtenir le nombre de couche
    nb_c = UBound(Chs) - LBound(Chs) + 1
    'redimensionner le tableau
    ReDim Cs(1 To nb_c)
            
    'retenir le tableau de couche
    Dim c As Long, n As Long
    For c = 1 To nb_c
        Cs(c) = Chs(LBound(Chs) + c - 1)
    Next c

    'construire les tableaux à partir de la structure Cs()
    Call Init_Arrays
    
    Construire = True
Exit Function
erreur:
    Construire = False
End Function
'###################################################################################
'construire les tableaux à partir de la structure Cs()
Private Sub Init_Arrays()
    Dim Tv() As Variant, Td() As Double
    Dim c As Long, n As Long

    ReDim Tv(1 To nb_c)
            Xs = Tv     'Xs devient un tableau de variants
    ReDim Tv(2 To nb_c) 'pas de biais pour la premiere couche qui est une fausse couche
            Bs = Tv     'Bs devient un tableau de variants
    ReDim Tv(1 To nb_c - 1)
            Ws = Tv
            
    For c = 1 To nb_c
        ReDim Td(1 To Cs(c))
            Xs(c) = Td  ' Xs(c) devient un tableau de doubles
        If c > 1 Then
            Bs(c) = Td  ' Bs(c) devient un tableau de doubles
        End If
        If (c > 1) Then
            ReDim Tv(1 To Cs(c - 1))
            ReDim Td(1 To Cs(c))
            For n = 1 To Cs(c - 1)
                Tv(n) = Td
            Next n
            
            Ws(c - 1) = Tv
        End If
    Next c
End Sub
'###################################################################################
'###################################################################################



'###################################################################################
'###################################################################################
'calculer les sorties pour un vecteur d'entree donné
Public Function Propager(ParamArray Entrees() As Variant) As Boolean
On Error GoTo erreur
    'fonction de calcul des sorties par propagation des entrées

    If ((UBound(Entrees) - LBound(Entrees) + 1) = Cs(1)) Then
        'les données sont dans Entrees
    Else
        'les données sont potentiellement dans Entrees(0)
        If (UBound(Entrees) = -1) Then GoTo erreur  'aucune donnée en entrée -> Entrees(0) n'existe pas
        Dim tmpEntrees As Variant
        On Error GoTo erreur    'type incompatible
            tmpEntrees = Entrees(0)
            Entrees = tmpEntrees
        On Error GoTo 0
        'maintenant les données sont dans Entrees
    End If
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim c As Long, n As Long, n1 As Long
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '1) placer les entrées sur la fausse couche dite d'entrée
    For n = 1 To Cs(1)
        Xs(1)(n) = Entrees(LBound(Entrees) + n - 1)
    Next n
    
    '2) pour chaque couche en partant de la premiere vers la derniere,
    '   calculer la valeur de chaque neurone
    '   la fonction d'activation des couches est y=Tanh(x) sauf pour la couche cachée qui est y=x
    For c = 2 To nb_c   'pour toutes les couches
        For n = 1 To Cs(c - 1)  'pour tous les neurones de la couche précédente
            For n1 = 1 To Cs(c) 'pour tous les neurones de la couche courrante
                If (n = 1) Then
                    'init avec la valeur du bias
                    Xs(c)(n1) = Bias_Value * Bs(c)(n1)
                End If
                
                'somme pondérée
                Xs(c)(n1) = Xs(c)(n1) + Xs(c - 1)(n) * Ws(c - 1)(n)(n1)
            Next
            
        Next n
        
        'appliquer la fonction de transfert
        If (c < nb_c) Then
            For n1 = 1 To Cs(c) 'pour tous les neurones de la couche courrante
                Xs(c)(n1) = Tanh(Xs(c)(n1))
            Next
        'Else
        '    For n1 = 1 To Cs(c) 'pour tous les neurones de la couche courrante
        '        Xs(c)(n1) = Xs(c)(n1)
        '    Next
        End If
    Next c
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Propager = True
Exit Function
erreur:
    Propager = False
End Function
'###################################################################################
'###################################################################################

'###################################################################################
'###################################################################################
'Lr = Learning Rate
Public Function Apprendre(Entrees As Variant, Sorties As Variant, Optional Lr As Double 0.1, Optional ErrMax As Double 0.1, Optional NbCycleMax As Long = 5000, Optional ByRef ARRET As Boolean = False) As Long
    'Etrees et Sorties sont des tableaux de tableaux de variants
    Dim nb_cas As Long: nb_cas = UBound(Entrees) - LBound(Entrees) + 1
    If (nb_cas <> UBound(Sorties) - LBound(Sorties) + 1) Then GoTo erreur

    'init le random
    Randomize Time

On Error GoTo erreur
    '1) initialiser tous les poids à de petites valeurs
    Call Init_Poids

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim c As Long, n As Long, n1 As Long
    Dim Cas As Collection, crt_cas As Long, tmp_cas As Long
    Dim OK As Boolean, crt_cycle As Long
    Dim CrtErr As Double
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    'jusqu'a ce qu'on ai atteint le seuil d'erreur acceptable ou le nombre de cycle max
    While (crt_cycle < NbCycleMax) 'And Not OK
        'passer au nouveau cycle
        crt_cycle = crt_cycle + 1
        
        DoEvents    ' permet la modification de la valeur arret
        If ARRET = True Then GoTo erreur    ' arret prématuré demandé
        
        OK = True 'par défaut est vrai, un seul cas faux passe à faux
        CrtErr = 0
        
        'init de la liste de cas
        Set Cas = New Collection
        For crt_cas = 1 To nb_cas
            Cas.add crt_cas
        Next crt_cas

        'traiter une fois tous les cas mais dans un ordre aléatoire
        While (Cas.Count > 0)
            ' choisir le cas alléatoire dans ceux qui restent à passer pour le cycle
            tmp_cas = 1 + CLng(Rnd * (Cas.Count - 1))
            crt_cas = Cas(tmp_cas)
            Cas.Remove tmp_cas
            '-----------------------------------------------------------------------

            '2) présenter le cas et propager pour avoir les valeurs
            If Not Propager(Entrees(crt_cas)) Then GoTo erreur
            
            '3) corriger un peu les poids pour minimiser l'erreur
            Call Corriger(Sorties(LBound(Sorties) + crt_cas - 1), Lr)
            '-------------------------------------
            
            Debug.Print vbTab & Xs(nb_c)(1) & " / " & Sorties(crt_cas)(1)
            DoEvents

            CrtErr = CrtErr + (Calcul_Err(Sorties(LBound(Sorties) + crt_cas - 1)) / nb_cas)
        Wend

        OK = CBool(CrtErr < ErrMax)
    Wend
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    If OK Then
        Apprendre = crt_cycle
    Else
        Apprendre = -2
    End If
Exit Function
erreur:
    Apprendre = -1
End Function
'###################################################################################

Private Function Calcul_Err(Sortie As Variant) As Double
    Dim n As Long
    For n = 1 To Cs(nb_c)
        Calcul_Err = Calcul_Err + _
            (Abs(Sortie(LBound(Sortie) + n - 1) - Xs(nb_c)(n)) / Cs(nb_c))
    Next n
End Function

Private Sub Corriger(Sortie As Variant, Lr As Double)
    Dim c As Long, n As Long, n1 As Long
    Dim ERs As Variant: ERs = Xs    'copie pour avoir la meme structure
    
        'pour la couche de sortie
        c = nb_c
            'calculer les erreurs
            For n = 1 To Cs(nb_c)
                'Err = obtenue - voulue
                ERs(c)(n) = Xs(c)(n) - Sortie(LBound(Sortie) + n - 1)
            Next n
            'corriger les poids qui arrivent sur la couche courrante
            For n = 1 To Cs(c - 1)
                For n1 = 1 To Cs(c)
                    Ws(c - 1)(n)(n1) = Ws(c - 1)(n)(n1) * _
                        (1 - ERs(c)(n1) * Xs(c - 1)(n) * Lr)
                Next n1
            Next n
            'corriger les poids des biais de la couche courrante
            For n1 = 1 To Cs(c)
                Bs(c)(n1) = Bs(c)(n1) * _
                    (1 - ERs(c)(n1) * Bias_Value * Lr)
            Next n1
            
        'pour toutes les autres couches en partant de la fin
        For c = nb_c - 1 To 2 Step -1
            'calculer les erreurs de la couche courrante
            For n = 1 To Cs(c)
                ERs(c)(n) = 0
                For n1 = 1 To Cs(c + 1)
                    ERs(c)(n) = ERs(c)(n) + ERs(c + 1)(n1) * Ws(c)(n)(n1)
                Next n1
            Next n
            
            'corriger les poids qui arrivent sur la couche courrante
            For n = 1 To Cs(c - 1)
                For n1 = 1 To Cs(c)
                    Ws(c - 1)(n)(n1) = Ws(c - 1)(n)(n1) * _
                        (1 - ERs(c)(n1) * dTanh(Xs(c - 1)(n)) * Lr)
                Next n1
            Next n
            'corriger les poids des biais de la couche courrante
            For n1 = 1 To Cs(c)
                Bs(c)(n1) = Bs(c)(n1) * _
                    (1 - ERs(c)(n1) * Bias_Value * Lr)
            Next n1
        Next c
        
        Set ERs = Nothing
End Sub
'###################################################################################
'###################################################################################


'###################################################################################
'###################################################################################
Public Sub Init_Poids()
    Dim c As Long, n As Long, n1 As Long

    'initialiser tous les poids entre -0.5 et 0.5
    For c = 1 To nb_c - 1
        For n = 1 To Cs(c)
            For n1 = 1 To Cs(c + 1)
                Ws(c)(n)(n1) = Rnd - 0.5
            Next n1
        Next n
    Next c

    'initialiser tous les bias entre -0.5 et 0.5
    For c = 2 To nb_c
        For n = 1 To Cs(c)
            Bs(c)(n) = Rnd - 0.5
        Next n
    Next c
End Sub
'###################################################################################
'###################################################################################


'###################################################################################
'###################################################################################
'charger le réseau depuis un fichier d'extension .NNF (neural network file)
Public Function Charger(add As String) As Boolean
'On Error GoTo erreur
    Dim canal As Byte
        canal = FreeFile 'allouer un canal de flux libre
    Open add For Binary Access Read As #canal  'ouvrire le fichier en mode binaire pour écriture
        
        'lire la constitution du réseau (couches)
        Get #canal, , nb_c
            ReDim Cs(1 To nb_c)
            Get #canal, , Cs
        
        'lire les données
        Get #canal, , Ws
        Get #canal, , Xs
        Get #canal, , Bs
        
    Close #canal    'fermer l'acces au fichier
    Charger = True
Exit Function
erreur:
    Charger = False
    If (canal <> 0) Then Close #canal       'fermer l'acces au fichier si cela n'a pas encore été fait
End Function
'###################################################################################
'###################################################################################
'sauver le réseau dans un fichier d'extension .NNF (neural network file)
Public Function Sauver(add As String) As Boolean
'On Error GoTo erreur
    Dim canal As Byte
        canal = FreeFile 'allouer un canal de flux libre
    Open add For Binary Access Write As #canal  'ouvrire le fichier en mode binaire pour écriture
        
        'sauvegarde de la structure du réseau
        Put #canal, , nb_c
        Put #canal, , Cs

        'sauvegarde des données
        Put #canal, , Ws
        Put #canal, , Xs
        Put #canal, , Bs

    Close #canal    'fermer l'acces au fichier
    Sauver = True
Exit Function
erreur:
    Sauver = False
    If (canal <> 0) Then Close #canal       'fermer l'acces au fichier si cela n'a pas encore été fait
End Function
'###################################################################################
'###################################################################################


'###################################################################################
'###################################################################################
Public Property Get nb_couche() As Long
    nb_couche = nb_c
End Property
Public Property Get nb_neurone(id_couche As Long) As Long
    nb_neurone = Cs(id_couche)
End Property
'###################################################################################
'###################################################################################
Public Property Get Couche(id_couche As Long) As Variant
    Couche = Xs(id_couche)
End Property
'###################################################################################
'###################################################################################


'###################################################################################
'###################################################################################
'pour les couches cachées
Private Function Tanh(x As Variant) As Double
On Error GoTo erreur
    Tanh = (Exp(x) - Exp(-x)) / (Exp(x) + Exp(-x))
Exit Function
erreur:
    If (x > 0) Then
        Tanh = 1
    Else
        Tanh = -1
    End If
End Function
Private Function dTanh(tanh_x As Variant) As Double
    dTanh = 1 - (tanh_x * tanh_x)
End Function
'###################################################################################
'###################################################################################
1
Réponse 2 / 3
Flocreate Messages postés 300 Date d'inscription lundi 17 juillet 2006 Statut Membre Dernière intervention 27 mai 2012 3
8 sept. 2010 à 09:23
Bon ben problème résolu.
Le problème provenait de la fonction de correction.
La formule de calcul des erreurs était fausse
La formule de correction des poids etait fausse de fait...

Je poste mon programme maintenant qu'il marche parfaitement.
1
Réponse 3 / 3
Flocreate Messages postés 300 Date d'inscription lundi 17 juillet 2006 Statut Membre Dernière intervention 27 mai 2012 3
7 sept. 2010 à 20:17
pour ceux qui voudraient tester voici le code de la form de test : 
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Neural Network"
   ClientHeight    =   4050
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9975
   LinkTopic       =   "Form1"
   ScaleHeight     =   4050
   ScaleWidth      =   9975
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox L 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3660
      Left            =   4680
      TabIndex        =   5
      Top             =   240
      Width           =   5175
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Apprendre"
      Height          =   615
      Left            =   120
      TabIndex        =   4
      Top             =   3360
      Width           =   4455
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Propager"
      Height          =   615
      Left            =   120
      TabIndex        =   3
      Top             =   2640
      Width           =   4455
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Charger"
      Height          =   615
      Left            =   120
      TabIndex        =   2
      Top             =   1560
      Width           =   4455
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Sauver"
      Height          =   615
      Left            =   120
      TabIndex        =   1
      Top             =   840
      Width           =   4455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Construire"
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private NN As NEURAL_NETWORK
Private ARRET As Boolean

Private Sub Command1_Click()
    Set NN = New NEURAL_NETWORK

    Dim result As Boolean
        result = NN.Construire(2, 3, 1)
        
    MsgBox result
End Sub

Private Sub Command2_Click()
    If (NN Is Nothing) Then
        MsgBox "réseau non construit"
        Exit Sub
    End If
    
    Dim result As Boolean
        result = NN.Sauver(App.Path & "\RN.RNF")
        
    MsgBox result
End Sub

Private Sub Command3_Click()
    Set NN = New NEURAL_NETWORK
    
    Dim result As Boolean
        result = NN.Charger(App.Path & "\RN.RNF")
        
    MsgBox result
End Sub

Private Sub Command4_Click()
    NN.Propager 0, 1
End Sub

Private Sub Command5_Click()
    Dim Es As Variant
    Dim Ss As Variant
    Call Load_Datas(App.Path & "\OR.RNT", Es, Ss)

    ARRET = False
    Dim result As Boolean
        result = CBool(NN.Apprendre(Es, Ss, 0.09, 0.1, 10000, ARRET) > 0)
    If (ARRET = True) Then Exit Sub

    'afficher les résultats
    L.Clear
    Dim c As Long
    For c = 1 To UBound(Es)
        Call NN.Propager(Es(c))

        L.AddItem To_Str(Es(c)) & " => " & To_Str(NN.Couche(NN.nb_couche)) & " | " & To_Str(Ss(c))
    Next c

    MsgBox result
End Sub


Private Sub Load_Datas(add As String, ByRef Es As Variant, ByRef Ss As Variant)
    Dim lec As String
    Dim nb_cas As Long, nb_e As Long, nb_s As Long
    Dim c As Long, e As Long, s As Long
    Dim Ts() As String
    Dim Td() As Variant
    Dim canal As Byte: canal = FreeFile
    Open add For Input As #canal
        Input #canal, lec   'passer la ligne de commentaire
            Input #canal, lec
                nb_cas = CLng(lec)
        Input #canal, lec   'passer la ligne de commentaire
            Input #canal, lec
                nb_e = CLng(lec)
        Input #canal, lec   'passer la ligne de commentaire
            Input #canal, lec
                nb_s = CLng(lec)

        ReDim Td(1 To nb_cas)
            Es = Td
            Ss = Td
        
        Input #canal, lec   'passer la ligne de commentaire
        For c = 1 To nb_cas
            ReDim Td(1 To nb_e)
            Es(c) = Td
            
            Input #canal, lec
            Ts = Split(lec, " ")
            
            For e = 1 To nb_e
                Es(c)(e) = CDbl(Replace(Ts(e - 1), ".", ",")) '/!\ paramètres régionaux / séparateur décimal
            Next
        Next c
        
        Input #canal, lec   'passer la ligne de commentaire
        For c = 1 To nb_cas
            ReDim Td(1 To nb_s)
            Ss(c) = Td
            
            Input #canal, lec
            Ts = Split(lec, " ")
            
            For s = 1 To nb_s
                Ss(c)(s) = CDbl(Replace(Ts(s - 1), ".", ","))  '/!\ paramètres régionaux / séparateur décimal
            Next
        Next c
        
    Close #canal
End Sub

Private Function To_Str(A As Variant) As String
On Error GoTo monobound
    Dim n As Integer
    For n = LBound(A) To UBound(A)
        To_Str = To_Str & CStr(A(n)) & " "
    Next n
Exit Function
monobound:
On Error GoTo 0
    To_Str = CStr(A) & " "
End Function

Private Sub Form_Unload(Cancel As Integer)
    ARRET = True
End Sub



et ce que contient le fichier OR.RNT : 
nombre de cas
4
nombre d'entree 
2
nombre de sortie
1
liste des vecteurs d'entree
-1 -1
-1 1
1 -1
1 1
liste des vecteurs de sortie
-1
-1
-1
1


cordialement,
0

Discussions similaires

Lister les ordinateurs du réseau
arnaud2006 -
arnaud2006 -

2 réponses
générer le diagramme des classes à partir du diagramme des cas d'utilisation
dounatt -
12345fatma -

6 réponses
creer un jeu de morpion avec une interface graphic en reseau
dekiss -
Julien39 -

1 réponse
[Clos] Réseau
ss1989 -
CptPingu -

1 réponse
connexion vb6 avec access sur un reseau distant
valeryht -
valeryht -

4 réponses
Rejoignez-nous