VBPerceptron.Net v0.53.*Table des procédures 1 - AssemblyInfo.vb 2 - FrmPerceptron.vb 2.1 - <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent 2.2 - Private Sub Afficher 2.3 - Private Sub CheckReinitialiser_CheckStateChanged 2.4 - Private Sub CmdDemarrer_Click 2.5 - Private Sub CmdPause_Click 2.6 - Private Sub DemarrerRN 2.7 - Private Sub FrmPerceptron_Closing 2.8 - Private Sub FrmPerceptron_Load 2.9 - Private Sub FrmPerceptron_Resize 2.10 - Private Sub ListDemo_SelectedIndexChanged 2.11 - Private Sub MAJGraphique 2.12 - Private Sub MAJListeDemos 2.13 - Private Sub SplitterGH_SplitterMoved 2.14 - Private Sub SplitterV_SplitterMoved 2.15 - Protected Overloads Overrides Sub Dispose 2.16 - Protected Overrides Sub OnActivated 2.17 - Public Sub New 3 - ClsPerceptronMC.vb 3.1 - Private Function bAfficherDegressivement 3.2 - Private Function bCalculerResultat 3.3 - Private Function bLireApprentissage 3.4 - Private Function bLireFichierPoids 3.5 - Private Function bLireNombreReel 3.6 - Private Function ComptabiliserResultat 3.7 - Private Function rCalculerErreurSortie! 3.8 - Private Function rDeriveeFctActivation! 3.9 - Private Function rFctActivation! 3.10 - Private Function rRandomiser! 3.11 - Private Function rSimuler! 3.12 - Private Function sFormater$ 3.13 - Private Function sFormaterResultat$ 3.14 - Private Sub AfficheMsgErreur 3.15 - Private Sub Afficher 3.16 - Private Sub AjusterPoids 3.17 - Private Sub AppliquerSignal 3.18 - Private Sub CalculerResultats 3.19 - Private Sub EcrireFichierPoids 3.20 - Private Sub LireSignalSortie 3.21 - Private Sub Normaliser 3.22 - Private Sub PropagerSignal 3.23 - Private Sub RandomiserPoids 3.24 - Private Sub RestaurerPoids 3.25 - Private Sub RetropropagerErreur 3.26 - Private Sub SauverPoids 3.27 - Private Sub TracerCourbe 3.28 - Public Property bGraphique 3.29 - Public Property bModeRapide 3.30 - Public Property bNormalisationIndep 3.31 - Public Property bPause 3.32 - Public Property bReinitialiserPoids 3.33 - Public Property bStop 3.34 - Public Property bTracerSortieFctEntree 3.35 - Public Property fctActivation 3.36 - Public Property iNbCouches 3.37 - Public Property iNbIterations% 3.38 - Public Property iNbLignesApprentissageMax% 3.39 - Public Property iNbLignesAPredire% 3.40 - Public Property iNbNeuronesCouche 3.41 - Public Property iNbSortiesSignif% 3.42 - Public Property iNbTentativesMax% 3.43 - Public Property iNbTentativesMin% 3.44 - Public Property rCentreFctActivation! 3.45 - Public Property rCoeffAjustPoids! 3.46 - Public Property rCoeffApprentissage! 3.47 - Public Property rFreqAffichagePourcent! 3.48 - Public Property rGainSignal! 3.49 - Public Property rInitPoidsMax! 3.50 - Public Property rInitPoidsMin! 3.51 - Public Property rTauxErreurMax! 3.52 - Public Property rTauxResultatMinPourcent! 3.53 - Public Property rToleranceErr! 3.54 - Public Property sCheminFichier$ 3.55 - Public Property sCheminFichierPoids$ 3.56 - Public Property sFormatSignal$ 3.57 - Public Sub AfficherParametresRN 3.58 - Public Sub Demarrer 3.59 - Public Sub DimensionnerReseau 3.60 - Public Sub EffacerGraphique 3.61 - Public Sub InitialiserPerceptron 3.62 - Public Sub TracerFctActivation 3.63 - Public WriteOnly Property ControleAffichage 3.64 - Public WriteOnly Property ControleAvancement 3.65 - Public WriteOnly Property ControleGraphique 4 - ModPerceptron.vb AssemblyInfo.vb ' Fichier AssemblyInfo.vb ' ----------------------- Imports System.Reflection 'Imports System.Runtime.CompilerServices Imports System.Runtime.InteropServices ' General Information about an assembly is controlled through the following ' set of attributes. Change these attribute values to modify the information ' associated with an assembly <Assembly: AssemblyTitle("VBPerceptron.Net")> <Assembly: AssemblyDescription( _ "IA:RN:VBPerceptron.Net : le code le + simple possible en VB .Net")> <Assembly: AssemblyCompany("ORS Production")> <Assembly: AssemblyProduct("VBPerceptron.Net")> <Assembly: AssemblyCopyright("")> <Assembly: AssemblyTrademark("")> <Assembly: AssemblyCulture("")> ' Version information for an assembly consists of the following four values: ' Major version ' Minor Version ' Revision ' Build Number ' You can specify all the values or you can default the Revision and Build Numbers ' by using the '*' as shown below <Assembly: AssemblyVersion("0.53.*")> FrmPerceptron.vb ' Fichier FrmPerceptron.vb ' ------------------------ ' IA:RN:VBPerceptron.Net : le code le + simple possible en VB .Net ' Par Patrice Dargenton ' patrice.dargenton@free.fr ' http://patrice.dargenton.free.fr/index.html ' http://patrice.dargenton.free.fr/CodesSources/index.html ' http://www.vbfrance.com/listeauteur2.aspx?ID=1124 ' http://patrice.dargenton.free.fr/ia/ialab/perceptron.html ' Documentation : perceptron.html ' Version 0.53 du 04/06/2005 ' D'après les fichiers originaux : ' ********************************************************************* ' * File : mlp.h (+ mlp.cpp) ' * Author: Sylvain BARTHELEMY ' * mailto:sylvain@sylbarth.com ' * http://www.sylbarth.com/mlp.php ' * Date : 2000-08 ' ********************************************************************* ' Conventions de nommage des variables : ' ------------------------------------ ' b pour Boolean (booléen vrai ou faux) ' i pour Integer : % (en VB .Net, l'entier a la capacité du VB6.Long) ' l pour Long : & ' r pour nombre Réel (Single!, Double# ou Decimal : D) ' s pour String : $ ' c pour Char ou Byte ' d pour Date ' a pour Array (tableau) : () ' o pour Object : objet instancié localement ' refX pour reference à un objet X préexistant qui n'est pas sensé être fermé ' m_ pour variable Membre de la classe ou de la feuille (Form) ' (mais pas pour les constantes) ' frm pour Form ' cls pour Classe ' mod pour Module ' ... ' ------------------------------------ Option Strict On Option Explicit On Class FrmPerceptron : Inherits Form #Region "Windows Form Designer generated code " Public Sub New() MyBase.New() 'This call is required by the Windows Form Designer. InitializeComponent() End Sub 'Form overrides dispose to clean up the component list. Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean) If Disposing Then If Not components Is Nothing Then components.Dispose() End If End If MyBase.Dispose(Disposing) End Sub 'Required by the Windows Form Designer Private components As System.ComponentModel.IContainer Public ToolTip1 As System.Windows.Forms.ToolTip Public WithEvents CmdPause As System.Windows.Forms.Button Public WithEvents CmdDemarrer As System.Windows.Forms.Button Public WithEvents LblAvancement As System.Windows.Forms.Label 'NOTE: The following procedure is required by the Windows Form Designer 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Friend WithEvents pnlGlobal As System.Windows.Forms.Panel Friend WithEvents pnlDroite As System.Windows.Forms.Panel Public WithEvents ListDemo As System.Windows.Forms.ListBox Friend WithEvents SplitterV As System.Windows.Forms.Splitter Friend WithEvents pnlGauche As System.Windows.Forms.Panel Public WithEvents ListResultats As System.Windows.Forms.ListBox Public WithEvents PicboxGraphique As System.Windows.Forms.PictureBox Friend WithEvents SplitterGH As System.Windows.Forms.Splitter Friend WithEvents pnlListResultats As System.Windows.Forms.Panel Public WithEvents CheckReinitialiser As System.Windows.Forms.CheckBox <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(FrmPerceptron)) Me.ToolTip1 = New System.Windows.Forms.ToolTip(Me.components) Me.CheckReinitialiser = New System.Windows.Forms.CheckBox Me.CmdPause = New System.Windows.Forms.Button Me.CmdDemarrer = New System.Windows.Forms.Button Me.LblAvancement = New System.Windows.Forms.Label Me.pnlGlobal = New System.Windows.Forms.Panel Me.SplitterV = New System.Windows.Forms.Splitter Me.pnlGauche = New System.Windows.Forms.Panel Me.pnlListResultats = New System.Windows.Forms.Panel Me.ListResultats = New System.Windows.Forms.ListBox Me.SplitterGH = New System.Windows.Forms.Splitter Me.PicboxGraphique = New System.Windows.Forms.PictureBox Me.pnlDroite = New System.Windows.Forms.Panel Me.ListDemo = New System.Windows.Forms.ListBox Me.pnlGlobal.SuspendLayout() Me.pnlGauche.SuspendLayout() Me.pnlListResultats.SuspendLayout() Me.pnlDroite.SuspendLayout() Me.SuspendLayout() ' 'CheckReinitialiser ' Me.CheckReinitialiser.BackColor = System.Drawing.SystemColors.Control Me.CheckReinitialiser.Cursor = System.Windows.Forms.Cursors.Default Me.CheckReinitialiser.ForeColor = System.Drawing.SystemColors.ControlText Me.CheckReinitialiser.Location = New System.Drawing.Point(216, 16) Me.CheckReinitialiser.Name = "CheckReinitialiser" Me.CheckReinitialiser.RightToLeft = System.Windows.Forms.RightToLeft.No Me.CheckReinitialiser.Size = New System.Drawing.Size(40, 24) Me.CheckReinitialiser.TabIndex = 10 Me.CheckReinitialiser.Text = "Init" Me.ToolTip1.SetToolTip(Me.CheckReinitialiser, "Réinitialiser les poids en refaisant un apprentissage") ' 'CmdPause ' Me.CmdPause.BackColor = System.Drawing.SystemColors.Control Me.CmdPause.Cursor = System.Windows.Forms.Cursors.Default Me.CmdPause.Enabled = False Me.CmdPause.ForeColor = System.Drawing.SystemColors.ControlText Me.CmdPause.Location = New System.Drawing.Point(112, 16) Me.CmdPause.Name = "CmdPause" Me.CmdPause.RightToLeft = System.Windows.Forms.RightToLeft.No Me.CmdPause.Size = New System.Drawing.Size(89, 25) Me.CmdPause.TabIndex = 4 Me.CmdPause.Text = "Pause" ' 'CmdDemarrer ' Me.CmdDemarrer.BackColor = System.Drawing.SystemColors.Control Me.CmdDemarrer.Cursor = System.Windows.Forms.Cursors.Default Me.CmdDemarrer.ForeColor = System.Drawing.SystemColors.ControlText Me.CmdDemarrer.Location = New System.Drawing.Point(8, 16) Me.CmdDemarrer.Name = "CmdDemarrer" Me.CmdDemarrer.RightToLeft = System.Windows.Forms.RightToLeft.No Me.CmdDemarrer.Size = New System.Drawing.Size(89, 25) Me.CmdDemarrer.TabIndex = 1 Me.CmdDemarrer.Text = "Démarrer" ' 'LblAvancement ' Me.LblAvancement.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.LblAvancement.BackColor = System.Drawing.SystemColors.Control Me.LblAvancement.Cursor = System.Windows.Forms.Cursors.Default Me.LblAvancement.ForeColor = System.Drawing.SystemColors.ControlText Me.LblAvancement.Location = New System.Drawing.Point(272, 16) Me.LblAvancement.Name = "LblAvancement" Me.LblAvancement.RightToLeft = System.Windows.Forms.RightToLeft.No Me.LblAvancement.Size = New System.Drawing.Size(320, 25) Me.LblAvancement.TabIndex = 3 Me.LblAvancement.Text = "Avancement : 100%" ' 'pnlGlobal ' Me.pnlGlobal.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _ Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) Me.pnlGlobal.Controls.Add(Me.SplitterV) Me.pnlGlobal.Controls.Add(Me.pnlGauche) Me.pnlGlobal.Controls.Add(Me.pnlDroite) Me.pnlGlobal.Location = New System.Drawing.Point(8, 56) Me.pnlGlobal.Name = "pnlGlobal" Me.pnlGlobal.Size = New System.Drawing.Size(592, 360) Me.pnlGlobal.TabIndex = 9 ' 'SplitterV ' Me.SplitterV.Dock = System.Windows.Forms.DockStyle.Right Me.SplitterV.Location = New System.Drawing.Point(496, 0) Me.SplitterV.Name = "SplitterV" Me.SplitterV.Size = New System.Drawing.Size(8, 360) Me.SplitterV.TabIndex = 10 Me.SplitterV.TabStop = False ' 'pnlGauche ' Me.pnlGauche.Controls.Add(Me.pnlListResultats) Me.pnlGauche.Controls.Add(Me.SplitterGH) Me.pnlGauche.Controls.Add(Me.PicboxGraphique) Me.pnlGauche.Dock = System.Windows.Forms.DockStyle.Fill Me.pnlGauche.Location = New System.Drawing.Point(0, 0) Me.pnlGauche.Name = "pnlGauche" Me.pnlGauche.Size = New System.Drawing.Size(504, 360) Me.pnlGauche.TabIndex = 11 ' 'pnlListResultats ' Me.pnlListResultats.Controls.Add(Me.ListResultats) Me.pnlListResultats.Dock = System.Windows.Forms.DockStyle.Fill Me.pnlListResultats.DockPadding.Bottom = 4 Me.pnlListResultats.DockPadding.Right = 8 Me.pnlListResultats.Location = New System.Drawing.Point(0, 0) Me.pnlListResultats.Name = "pnlListResultats" Me.pnlListResultats.Size = New System.Drawing.Size(504, 232) Me.pnlListResultats.TabIndex = 11 ' 'ListResultats ' Me.ListResultats.BackColor = System.Drawing.SystemColors.Window Me.ListResultats.Cursor = System.Windows.Forms.Cursors.Default Me.ListResultats.Dock = System.Windows.Forms.DockStyle.Fill Me.ListResultats.Font = New System.Drawing.Font("Courier New", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) Me.ListResultats.ForeColor = System.Drawing.SystemColors.WindowText Me.ListResultats.ItemHeight = 14 Me.ListResultats.Location = New System.Drawing.Point(0, 0) Me.ListResultats.Name = "ListResultats" Me.ListResultats.RightToLeft = System.Windows.Forms.RightToLeft.No Me.ListResultats.ScrollAlwaysVisible = True Me.ListResultats.Size = New System.Drawing.Size(496, 228) Me.ListResultats.TabIndex = 9 ' 'SplitterGH ' Me.SplitterGH.Dock = System.Windows.Forms.DockStyle.Bottom Me.SplitterGH.Location = New System.Drawing.Point(0, 232) Me.SplitterGH.Name = "SplitterGH" Me.SplitterGH.Size = New System.Drawing.Size(504, 8) Me.SplitterGH.TabIndex = 10 Me.SplitterGH.TabStop = False ' 'PicboxGraphique ' Me.PicboxGraphique.BackColor = System.Drawing.Color.Cyan Me.PicboxGraphique.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D Me.PicboxGraphique.Cursor = System.Windows.Forms.Cursors.Default Me.PicboxGraphique.Dock = System.Windows.Forms.DockStyle.Bottom Me.PicboxGraphique.ForeColor = System.Drawing.SystemColors.ControlText Me.PicboxGraphique.Location = New System.Drawing.Point(0, 240) Me.PicboxGraphique.Name = "PicboxGraphique" Me.PicboxGraphique.RightToLeft = System.Windows.Forms.RightToLeft.No Me.PicboxGraphique.Size = New System.Drawing.Size(504, 120) Me.PicboxGraphique.TabIndex = 8 Me.PicboxGraphique.TabStop = False ' 'pnlDroite ' Me.pnlDroite.Controls.Add(Me.ListDemo) Me.pnlDroite.Dock = System.Windows.Forms.DockStyle.Right Me.pnlDroite.DockPadding.Left = 10 Me.pnlDroite.Location = New System.Drawing.Point(504, 0) Me.pnlDroite.Name = "pnlDroite" Me.pnlDroite.Size = New System.Drawing.Size(88, 360) Me.pnlDroite.TabIndex = 9 ' 'ListDemo ' Me.ListDemo.BackColor = System.Drawing.SystemColors.Window Me.ListDemo.Cursor = System.Windows.Forms.Cursors.Default Me.ListDemo.Dock = System.Windows.Forms.DockStyle.Fill Me.ListDemo.ForeColor = System.Drawing.SystemColors.WindowText Me.ListDemo.Location = New System.Drawing.Point(10, 0) Me.ListDemo.Name = "ListDemo" Me.ListDemo.RightToLeft = System.Windows.Forms.RightToLeft.No Me.ListDemo.Size = New System.Drawing.Size(78, 355) Me.ListDemo.TabIndex = 3 ' 'FrmPerceptron ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(608, 429) Me.Controls.Add(Me.CheckReinitialiser) Me.Controls.Add(Me.pnlGlobal) Me.Controls.Add(Me.CmdPause) Me.Controls.Add(Me.CmdDemarrer) Me.Controls.Add(Me.LblAvancement) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Location = New System.Drawing.Point(4, 23) Me.Name = "FrmPerceptron" Me.Text = "Perceptron multicouche simple en VB .Net" Me.pnlGlobal.ResumeLayout(False) Me.pnlGauche.ResumeLayout(False) Me.pnlListResultats.ResumeLayout(False) Me.pnlDroite.ResumeLayout(False) Me.ResumeLayout(False) End Sub #End Region Private m_rn As New ClsPerceptronMultiCouche Private m_bSimulationEnCours As Boolean, m_bInitialisation As Boolean Private Sub FrmPerceptron_Load(ByVal eventSender As Object, _ ByVal eventArgs As EventArgs) Handles MyBase.Load m_rn.ControleAffichage = Me.ListResultats m_rn.ControleAvancement = Me.LblAvancement m_rn.ControleGraphique = Me.PicboxGraphique Me.ListDemo.Items.Add("XOR") ' 0 Me.ListDemo.Items.Add("XOR2") ' 1 Me.ListDemo.Items.Add("XOR3") ' 2 Me.ListDemo.Items.Add("XOR4") ' 3 Me.ListDemo.Items.Add("XOR5") ' 4 Me.ListDemo.Items.Add("Sinus") ' 5 Me.ListDemo.SelectedIndex = 0 ' Sélectionner la demo n°1 End Sub Private Sub MAJGraphique() m_rn.ControleGraphique = Me.PicboxGraphique MAJListeDemos() End Sub Private Sub FrmPerceptron_Resize(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles MyBase.Resize MAJGraphique() End Sub Private Sub SplitterGH_SplitterMoved(ByVal sender As Object, _ ByVal e As Windows.Forms.SplitterEventArgs) Handles SplitterGH.SplitterMoved MAJGraphique() End Sub Private Sub SplitterV_SplitterMoved(ByVal sender As Object, _ ByVal e As Windows.Forms.SplitterEventArgs) Handles SplitterV.SplitterMoved MAJGraphique() End Sub Private Sub CheckReinitialiser_CheckStateChanged(ByVal eventSender As Object, _ ByVal eventArgs As System.EventArgs) _ Handles CheckReinitialiser.CheckStateChanged m_rn.bReinitialiserPoids = _ (Me.CheckReinitialiser.CheckState = CheckState.Checked) End Sub Private Sub ListDemo_SelectedIndexChanged(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles ListDemo.SelectedIndexChanged MAJListeDemos() End Sub Private Sub MAJListeDemos() If m_bSimulationEnCours Then m_rn.bStop = True : Exit Sub Me.ListResultats.Items.Clear() m_rn.EffacerGraphique() m_rn.InitialiserPerceptron() m_rn.bReinitialiserPoids = _ (Me.CheckReinitialiser.CheckState = CheckState.Checked) Dim sChemin$ = Application.StartupPath & "\Donnees\" Const iHauteurMoitiePixels% = 172 'Const iHauteurDoublePixels% = 382 Me.ListResultats.Height = iHauteurMoitiePixels ' Lorsqu'il n'y a pas de graphique à afficher, on augmente la taille 'Me.ListResultats.Height = iHauteurDoublePixels Select Case Me.ListDemo.Text Case "XOR" m_rn.sCheminFichier = sChemin & "xor.dat" Afficher("Apprentissage d'une porte logique XOR") Afficher("Fonction d'activation : Sigmoïde") m_rn.iNbCouches = 3 ' Le dimensionnement du RN est minimal et optimal ici m_rn.iNbNeuronesCouche(1) = 2 ' Couche d'entrée m_rn.iNbNeuronesCouche(2) = 2 ' Couche intermédiaire m_rn.iNbNeuronesCouche(3) = 1 ' Couche de sortie ' A faire après avoir défini la structure du RN m_rn.DimensionnerReseau() m_rn.iNbSortiesSignif = 1 ' 1 neurone = 1 sortie ' Un succès est comptabilisé si on obtient en sortie de neurone : ' < .3 pour 0, ou > .7 pour 1 (elle est normalisée entre 0 et 1) m_rn.rToleranceErr = 0.3 m_rn.rTauxResultatMinPourcent = 100 ' PC=% : 100% de résultats au minimum ! ' Erreur moyenne max. d'activation des neurones ' par rapport à leurs cibles respectives m_rn.rTauxErreurMax = 0.25 ' Si le taux de résultat obtenu est trop faible, ou si le ' taux d'erreur est trop élevé, recommencer plusieurs tentatives m_rn.iNbTentativesMax = 5 ' Afficher les résultats tous les 5% du nombre d'itération m_rn.rFreqAffichagePourcent = 5 ' Ces paramètres ont été trouvés grâce au RN Autoconfigurant ' http://patrice.dargenton.free.fr/ia/ialab/rnautoconfigurant.html ' Si vous laissez les paramètres par défaut, cela marchera aussi ' mais moins rapidement (sauf pour le Pas unitaire, la Tangente ' hyperbolique et le Sinus, dont les réglages sont plus délicats : ' il faudrait plus de neurones pour que ça marche par défaut) m_rn.fctActivation = TFctActivation.SigmoideStandard m_rn.rCoeffAjustPoids = 0.8 m_rn.rCoeffApprentissage = 1 m_rn.rGainSignal = 1.8 m_rn.rCentreFctActivation = 0 m_rn.iNbIterations = 200 ' Nbre d'itérations pour l'apprentissage Case "XOR2" m_rn.sCheminFichier = sChemin & "xor.dat" m_rn.sCheminFichierPoids = sChemin & "xor2.pds" Afficher("Apprentissage d'une porte logique XOR") Afficher("Fonction d'activation : Double-seuil") Afficher("(la dérivée de la fonction sigmoïde est utilisée") Afficher(" en guise de dérivée de la fonction d'activation") m_rn.iNbCouches = 3 m_rn.iNbNeuronesCouche(1) = 2 m_rn.iNbNeuronesCouche(2) = 2 m_rn.iNbNeuronesCouche(3) = 1 m_rn.DimensionnerReseau() m_rn.iNbSortiesSignif = 1 m_rn.rToleranceErr = 0.3 m_rn.rTauxResultatMinPourcent = 100 m_rn.rTauxErreurMax = 0.25 m_rn.iNbTentativesMax = 5 m_rn.rFreqAffichagePourcent = 5 m_rn.fctActivation = TFctActivation.DoubleSeuil m_rn.rCoeffAjustPoids = 1.3 m_rn.rCoeffApprentissage = 1.7 m_rn.rGainSignal = 1 m_rn.rCentreFctActivation = 0 m_rn.iNbIterations = 200 Case "XOR3" m_rn.sCheminFichier = sChemin & "xor.dat" m_rn.sCheminFichierPoids = sChemin & "xor3.pds" Afficher("Apprentissage d'une porte logique XOR") Afficher("Fonction d'activation : Pas unitaire") Afficher("(la dérivée de la fonction sigmoïde est utilisée") Afficher(" en guise de dérivée de la fonction d'activation") m_rn.iNbCouches = 3 m_rn.iNbNeuronesCouche(1) = 2 m_rn.iNbNeuronesCouche(2) = 2 m_rn.iNbNeuronesCouche(3) = 1 m_rn.DimensionnerReseau() m_rn.iNbSortiesSignif = 1 m_rn.rToleranceErr = 0.3 m_rn.rTauxResultatMinPourcent = 100 m_rn.rTauxErreurMax = 0.25 m_rn.rFreqAffichagePourcent = 5 ' Cette fct d'activation est moins stable mais + rapide m_rn.iNbTentativesMax = 20 ' Recommencer plusieurs fois pour tester la stabilité ' de l'apprentissage 'm_rn.iNbTentativesMin = 20 m_rn.fctActivation = TFctActivation.PasUnitaire ' Ne fonctionnera pas avec les valeurs par défaut m_rn.rCoeffAjustPoids = 0.5 m_rn.rCoeffApprentissage = 2.8 m_rn.rGainSignal = 0.3 m_rn.rCentreFctActivation = 0.8 m_rn.iNbIterations = 100 Case "XOR4" m_rn.sCheminFichier = sChemin & "xor.dat" m_rn.sCheminFichierPoids = sChemin & "xor4.pds" Afficher("Apprentissage d'une porte logique XOR") Afficher("Fonction d'activation : Gaussienne") m_rn.iNbCouches = 3 m_rn.iNbNeuronesCouche(1) = 2 m_rn.iNbNeuronesCouche(2) = 2 m_rn.iNbNeuronesCouche(3) = 1 m_rn.DimensionnerReseau() m_rn.iNbSortiesSignif = 1 m_rn.rToleranceErr = 0.3 m_rn.rTauxResultatMinPourcent = 100 m_rn.rTauxErreurMax = 0.25 m_rn.iNbTentativesMax = 5 m_rn.rFreqAffichagePourcent = 5 m_rn.fctActivation = TFctActivation.Gaussienne m_rn.rCoeffAjustPoids = 1.3 m_rn.rCoeffApprentissage = 1.4 m_rn.rGainSignal = 0.3 m_rn.rCentreFctActivation = 0 m_rn.iNbIterations = 20 Case "XOR5" m_rn.sCheminFichier = sChemin & "xor.dat" m_rn.sCheminFichierPoids = sChemin & "xor5.pds" Afficher("Apprentissage d'une porte logique XOR") Afficher("Fonction d'activation : Tangente hyperbolique") m_rn.iNbCouches = 3 m_rn.iNbNeuronesCouche(1) = 2 m_rn.iNbNeuronesCouche(2) = 2 m_rn.iNbNeuronesCouche(3) = 1 m_rn.DimensionnerReseau() m_rn.iNbSortiesSignif = 1 m_rn.rToleranceErr = 0.3 m_rn.rTauxResultatMinPourcent = 100 m_rn.rTauxErreurMax = 0.25 m_rn.iNbTentativesMax = 5 m_rn.rFreqAffichagePourcent = 5 m_rn.fctActivation = TFctActivation.TangenteHyperbolique ' Ne fonctionnera pas avec les valeurs par défaut m_rn.rCoeffAjustPoids = 0.25 m_rn.rCoeffApprentissage = 0.35 m_rn.rGainSignal = 1 m_rn.rCentreFctActivation = 0 m_rn.iNbIterations = 200 Case "Sinus" m_rn.sCheminFichier = sChemin & "sin.dat" Afficher("Apprentissage d'une fonction Sinus()") m_rn.iNbCouches = 4 m_rn.iNbNeuronesCouche(1) = 1 m_rn.iNbNeuronesCouche(2) = 3 m_rn.iNbNeuronesCouche(3) = 2 m_rn.iNbNeuronesCouche(4) = 1 m_rn.DimensionnerReseau() ' Nombre de sorties signifiantes m_rn.iNbSortiesSignif = 1 m_rn.rTauxResultatMinPourcent = 100 m_rn.rTauxErreurMax = 0.13 m_rn.rToleranceErr = 0.13 m_rn.iNbTentativesMax = 10 ' Tracer la sortie en fonction de l'entrée : ' Fonction non monotone : y = f(x) au lieu de y = f(t) avec ' t croissant régulièrement m_rn.bTracerSortieFctEntree = True m_rn.rFreqAffichagePourcent = 5 m_rn.iNbLignesApprentissageMax = 19 m_rn.iNbLignesAPredire = 6 m_rn.fctActivation = TFctActivation.Gaussienne ' Ne fonctionnera pas avec les valeurs par défaut m_rn.rCoeffAjustPoids = 0.8 m_rn.rCoeffApprentissage = 0.6 m_rn.rGainSignal = 0.4 m_rn.rCentreFctActivation = 0 m_rn.iNbIterations = 1000 End Select m_rn.AfficherParametresRN() m_rn.TracerFctActivation(m_rn.fctActivation) Fin: ' Se repositionner au début de l'affichage des prm de la démo If Me.ListResultats.Items.Count > 0 Then _ Me.ListResultats.SelectedIndex = 0 End Sub Private Sub Afficher(ByVal sMessage$) Me.ListResultats.Items.Add(sMessage) ' Positionnement de la zone de liste sur la dernière ligne affichée Me.ListResultats.SelectedIndex = Me.ListResultats.Items.Count - 1 End Sub Private Sub CmdDemarrer_Click(ByVal eventSender As Object, _ ByVal eventArgs As EventArgs) Handles CmdDemarrer.Click DemarrerRN() End Sub Private Sub DemarrerRN() If m_bSimulationEnCours Then m_rn.bStop = True : Exit Sub m_bSimulationEnCours = True Me.CmdDemarrer.Text = "Stop" Me.CmdPause.Text = "Pause" Me.CmdPause.Enabled = True Me.Cursor = Windows.Forms.Cursors.WaitCursor m_rn.Demarrer() ' Pour éviter une fausse manip. Me.CheckReinitialiser.CheckState = CheckState.Unchecked ' False m_rn.bReinitialiserPoids = False Me.Cursor = Windows.Forms.Cursors.Default Me.CmdPause.Enabled = False m_bSimulationEnCours = False m_rn.bStop = False m_rn.bPause = False Me.CmdDemarrer.Text = "Démarrer" Me.CmdPause.Text = "Continuer" End Sub Private Sub CmdPause_Click(ByVal eventSender As Object, _ ByVal eventArgs As EventArgs) Handles CmdPause.Click m_rn.bPause = Not m_rn.bPause If m_rn.bPause Then Me.Cursor = Cursors.Default Me.CmdPause.Text = "Continuer" Else Me.Cursor = Cursors.WaitCursor Me.CmdPause.Text = "Pause" End If End Sub Private Sub FrmPerceptron_Closing(ByVal sender As Object, _ ByVal e As System.ComponentModel.CancelEventArgs) _ Handles MyBase.Closing If m_bSimulationEnCours Then m_rn.bStop = True : e.Cancel = True End Sub Protected Overrides Sub OnActivated(ByVal e As EventArgs) ' Prêt à tracer maintenant If Not m_bInitialisation Then m_bInitialisation = True MAJListeDemos() End If End Sub End Class ClsPerceptronMC.vb ' Fichier ClsPerceptronMultiCouche.vb ' ----------------------------------- ' IA:RN:VBPerceptron.Net : le code le + simple possible en VB .Net ' Par Patrice Dargenton ' patrice.dargenton@free.fr ' http://patrice.dargenton.free.fr/index.html ' http://patrice.dargenton.free.fr/CodesSources/index.html ' http://www.vbfrance.com/listeauteur2.aspx?ID=1124 ' http://patrice.dargenton.free.fr/ia/ialab/perceptron.html ' Documentation : perceptron.html ' Version 0.53 du 04/06/2005 ' D'après les fichiers originaux : ' ********************************************************************* ' * File : mlp.h (+ mlp.cpp) ' * Author: Sylvain BARTHELEMY ' * mailto:sylvain@sylbarth.com ' * http://www.sylbarth.com/mlp.php ' * Date : 2000-08 ' ********************************************************************* Option Strict On Option Explicit On Class ClsPerceptronMultiCouche #If Debug Then ' Ne pas trapper les erreurs si on debug Private Const m_bTrapErr As Boolean = False ' Pour la suite, m_bDebug est plus simple à écrire que #If Debug Private Const m_bDebug As Boolean = True #Else Private Const m_bTrapErr As Boolean = True Private Const m_bDebug As Boolean = False #End If #Region "Déclarations" Private Const m_sTitreMsg$ = "VBPerceptron.Net" Private Const m_rVersionFichierPoids! = 1.02! ' Implémenter le biais automatique en ajoutant un poids Private Const m_bImplementerBiaisAutom As Boolean = True ' Valeurs par défaut des paramètres du RN ' Alpha : momentum factor : coeff. d'ajustement des poids ' Eta : learning rate : coeff. d'apprentissage par l'erreur ' Gain : gain of sigmoid function : gain de la fonction sigmoïde ' et des autres fonction d'activation Private Const m_rCoeffAjustPoidsDef! = 0.9 ' .5 <= dAlpha <= .9 Private Const m_rCoeffApprentissageDef! = 0.25 ' .05 <= dEta <= .25 Private Const m_rGainSignalDef! = 1 Private Const m_rInitPoidsMinDef! = 0 ' Bornes pour l'initialisation des poids Private Const m_rInitPoidsMaxDef! = 1 Private Const m_iNbIterationsDef% = 5000 Private Const m_fctActivationDef As TFctActivation = TFctActivation.Gaussienne Private Const m_rExpMax! = 50 ' Gestion des dépassements de capacité Private Const m_sFormatErr$ = "0.0000" Private Const m_sFormatRes$ = "0.00%" Private Const m_rReelMax! = 999999 Private Const m_rReelMin! = -999999 Private Const m_rMinNorme! = 0 ' Bornes de la normalisation Private Const m_rMaxNorme! = 1 Private Structure TNeurone Dim rSignal!, rErreur!, rPoids!() Dim rAjustPoids!() ' Ajustement du poids ' Mémorisation du poids si l'erreur moyenne augmente au lieu de baisser Dim rMemPoids!() Dim rMemSignal! ' Mémorisation du signal pour le calcul de la dérivée End Structure Private Structure TCoucheNeurones Dim iNbNeurones% ' Nombre de poids = Nombre de neurones ' sauf si on implémente le biais autom.: +1 poids avec signal à 1 Dim iNbPoids% Dim aNeurones() As TNeurone End Structure Private Structure TFonctionTransfert Dim arEntree!(), arCible!() ' Mémorisation de la série cible pour l'affichage Dim sLigneCible$ ' S'il n'y a qu'un seul neurone, mémorisation de la sortie ' pour les graphiques Dim rSortie1! End Structure Private Structure TResultatSimple Dim iIndice% ' Indice de la ligne ou bien n° de l'itération Dim iNbLignes% ' Nombre de lignes prises en compte dans le calcul Dim iSucces% ' Nombre de succès Dim iMaxSucces% ' Nombre max. de succès Dim rTauxResultat! ' 1 correspond à 100% Dim rSommeErreur! ' Cumul de l'erreur moyenne Dim rTauxErreur! ' entre 0 et 1 Dim iNbLignesPred% ' Nombre de lignes de prédiction Dim iSuccesPred% ' Nombre de succès de prédiction Dim rSommeErrPred! ' Cumul de l'erreur moyenne de prédiction End Structure Private Structure TResultatComplet Dim iNbResultats% Dim aRes() As TResultatSimple Dim resCumul As TResultatSimple Dim aResCumul() As TResultatSimple End Structure Private Structure TAmplitude Dim rMin!, rMax! End Structure Private Structure TVariables Dim iNbNeuronesEntree%, iNbNeuronesSortie% Dim iNbLignesBase% Dim iNbLignesApprentissage% Dim iNbLignesApprentissageMax% Dim iNumIteration%, iNbIterationsMin% Dim iNumTentative%, iNbTentativesOk% Dim rTauxResultat!, rTauxErreurs! Dim bModePrediction As Boolean Dim amplitEntree As TAmplitude ' Entrées de même amplitude Dim amplitSortie As TAmplitude Dim aAmplitEntree() As TAmplitude ' Entrées indépendantes Dim aAmplitSortie() As TAmplitude Dim arEcartSC!() ' Ecart normalisé entre la sortie et la cible ' Taux d'apprentissage normalisé de la première sortie Dim rTauxApprentissageS1! Dim grPicBox As Graphics End Structure Private Structure TParametres ' Short pour garder la compatibilité des fichiers de poids (.pds) ' avec la version du logiciel en VB6 ' (Short = VB6.Integer et Integer = VB6.Long) Dim iNbCouches As Short Dim aiNbNeuronesCouche() As Short Dim iNbSortiesSignif% Dim bModeRapide As Boolean ' Ne pas afficher le texte ' Graphique possible : tracer les valeurs du premier neurone de sortie Dim bGraphique As Boolean Dim bReinitialiserPoids As Boolean ' Mode apprentissage Dim bStop As Boolean, bPause As Boolean Dim sCheminFichier$, sCheminFichierPoids$ Dim iNbLignesApprentissageMax% Dim iNbLignesAPredire% Dim bTracerSortieFctEntree As Boolean ' Normalisation indépendante des entrées ' (dans le cas où leurs amplitudes sont distinctes) Dim bNormalisationIndep As Boolean Dim iNbIterations%, rToleranceErr! Dim rTauxResultatMinPourcent!, rTauxErreurMax! Dim iNbTentativesMin%, iNbTentativesMax% Dim rCoeffAjustPoids!, rCoeffApprentissage! Dim rInitPoidsMin!, rInitPoidsMax! Dim rGainSignal!, rCentreFctActivation! Dim fctActivation As TFctActivation Dim sFormatSignal$, rFreqAffichagePourcent! Dim ctrlAffichage As Windows.Forms.ListBox Dim ctrlAvancement As Windows.Forms.Label Dim ctrlGraphique As Windows.Forms.PictureBox End Structure Private m_prm As TParametres Private m_var As TVariables Private m_aCouches() As TCoucheNeurones Private m_aApprentissage() As TFonctionTransfert #End Region #Region "Propriétés" Public Property iNbCouches() As Short Get iNbCouches = m_prm.iNbCouches End Get Set(ByVal iValeur As Short) m_prm.iNbCouches = iValeur ReDim m_prm.aiNbNeuronesCouche(m_prm.iNbCouches - 1) End Set End Property Public Property iNbNeuronesCouche(ByVal iIndiceCouche%) As Short Get iNbNeuronesCouche = 0 On Error Resume Next iNbNeuronesCouche = m_prm.aiNbNeuronesCouche(iIndiceCouche - 1) End Get Set(ByVal iValeur As Short) m_prm.aiNbNeuronesCouche(iIndiceCouche - 1) = iValeur End Set End Property Public Property bReinitialiserPoids() As Boolean Get bReinitialiserPoids = m_prm.bReinitialiserPoids End Get Set(ByVal bValeur As Boolean) m_prm.bReinitialiserPoids = bValeur End Set End Property Public Property bNormalisationIndep() As Boolean Get bNormalisationIndep = m_prm.bNormalisationIndep End Get Set(ByVal bValeur As Boolean) m_prm.bNormalisationIndep = bValeur End Set End Property Public Property bGraphique() As Boolean Get bGraphique = m_prm.bGraphique End Get Set(ByVal bValeur As Boolean) m_prm.bGraphique = bValeur End Set End Property Public Property bTracerSortieFctEntree() As Boolean Get bTracerSortieFctEntree = m_prm.bTracerSortieFctEntree End Get Set(ByVal bValeur As Boolean) m_prm.bTracerSortieFctEntree = bValeur End Set End Property Public Property iNbLignesAPredire%() Get iNbLignesAPredire = m_prm.iNbLignesAPredire End Get Set(ByVal iValeur%) m_prm.iNbLignesAPredire = iValeur m_var.bModePrediction = False If m_prm.iNbLignesAPredire > 0 Then m_var.bModePrediction = True End Set End Property Public Property iNbSortiesSignif%() Get iNbSortiesSignif = m_prm.iNbSortiesSignif End Get Set(ByVal iValeur%) m_prm.iNbSortiesSignif = iValeur End Set End Property Public Property bStop() As Boolean Get bStop = m_prm.bStop End Get Set(ByVal bValeur As Boolean) m_prm.bStop = bValeur End Set End Property Public Property bPause() As Boolean Get bPause = m_prm.bPause End Get Set(ByVal bValeur As Boolean) m_prm.bPause = bValeur End Set End Property Public Property bModeRapide() As Boolean Get bModeRapide = m_prm.bModeRapide End Get Set(ByVal bValeur As Boolean) m_prm.bModeRapide = bValeur End Set End Property Public WriteOnly Property ControleAffichage() As ListBox Set(ByVal Value As ListBox) m_prm.ctrlAffichage = Value End Set End Property Public WriteOnly Property ControleAvancement() As Label Set(ByVal Value As Label) m_prm.ctrlAvancement = Value End Set End Property Public WriteOnly Property ControleGraphique() As PictureBox Set(ByVal Value As PictureBox) m_prm.ctrlGraphique = Value m_var.grPicBox = m_prm.ctrlGraphique.CreateGraphics End Set End Property Public Property rFreqAffichagePourcent!() Get rFreqAffichagePourcent = m_prm.rFreqAffichagePourcent End Get Set(ByVal rValeur!) m_prm.rFreqAffichagePourcent = rValeur End Set End Property Public Property rToleranceErr!() Get rToleranceErr = m_prm.rToleranceErr End Get Set(ByVal rValeur!) m_prm.rToleranceErr = rValeur End Set End Property Public Property iNbIterations%() Get iNbIterations = m_prm.iNbIterations End Get Set(ByVal iValeur%) m_prm.iNbIterations = iValeur End Set End Property Public Property rTauxResultatMinPourcent!() Get rTauxResultatMinPourcent = m_prm.rTauxResultatMinPourcent End Get Set(ByVal rValeur!) m_prm.rTauxResultatMinPourcent = rValeur End Set End Property Public Property rTauxErreurMax!() Get rTauxErreurMax = m_prm.rTauxErreurMax End Get Set(ByVal rValeur!) m_prm.rTauxErreurMax = rValeur End Set End Property Public Property iNbTentativesMin%() Get iNbTentativesMin = m_prm.iNbTentativesMin End Get Set(ByVal iValeur%) m_prm.iNbTentativesMin = iValeur End Set End Property Public Property iNbTentativesMax%() Get iNbTentativesMax = m_prm.iNbTentativesMax End Get Set(ByVal iValeur%) m_prm.iNbTentativesMax = iValeur End Set End Property Public Property rCoeffAjustPoids!() Get rCoeffAjustPoids = m_prm.rCoeffAjustPoids End Get Set(ByVal rValeur!) m_prm.rCoeffAjustPoids = rValeur End Set End Property Public Property rCoeffApprentissage!() Get rCoeffApprentissage = m_prm.rCoeffApprentissage End Get Set(ByVal rValeur!) m_prm.rCoeffApprentissage = rValeur End Set End Property Public Property rGainSignal!() Get rGainSignal = m_prm.rGainSignal End Get Set(ByVal rValeur!) m_prm.rGainSignal = rValeur End Set End Property Public Property rInitPoidsMin!() Get rInitPoidsMin = m_prm.rInitPoidsMin End Get Set(ByVal rValeur!) m_prm.rInitPoidsMin = rValeur End Set End Property Public Property rInitPoidsMax!() Get rInitPoidsMax = m_prm.rInitPoidsMax End Get Set(ByVal rValeur!) m_prm.rInitPoidsMax = rValeur End Set End Property Public Property sCheminFichier$() Get sCheminFichier = m_prm.sCheminFichier End Get Set(ByVal sValeur$) m_prm.sCheminFichier = sValeur End Set End Property Public Property sCheminFichierPoids$() Get sCheminFichierPoids = m_prm.sCheminFichierPoids End Get Set(ByVal sValeur$) m_prm.sCheminFichierPoids = sValeur End Set End Property Public Property sFormatSignal$() Get sFormatSignal = m_prm.sFormatSignal End Get Set(ByVal sValeur$) m_prm.sFormatSignal = sValeur End Set End Property Public Property iNbLignesApprentissageMax%() Get iNbLignesApprentissageMax = m_prm.iNbLignesApprentissageMax End Get Set(ByVal iValeur%) m_prm.iNbLignesApprentissageMax = iValeur End Set End Property Public Property fctActivation() As TFctActivation Get fctActivation = m_prm.fctActivation End Get Set(ByVal fctActivation As TFctActivation) m_prm.fctActivation = fctActivation End Set End Property Public Property rCentreFctActivation!() Get rCentreFctActivation = m_prm.rCentreFctActivation End Get Set(ByVal rValeur!) m_prm.rCentreFctActivation = rValeur End Set End Property #End Region #Region "Algorithme du Perceptron" Public Sub InitialiserPerceptron() ' Valeurs par défaut m_prm.bGraphique = False m_prm.bStop = False m_prm.bPause = False m_prm.bReinitialiserPoids = False m_prm.bTracerSortieFctEntree = False m_prm.bNormalisationIndep = False m_prm.bModeRapide = False m_prm.sCheminFichier = "" m_prm.sCheminFichierPoids = "" m_prm.sFormatSignal = "0.00" m_prm.iNbLignesApprentissageMax = 0 ' Pas de limite m_prm.iNbLignesAPredire = 0 m_prm.iNbIterations = m_iNbIterationsDef m_prm.iNbTentativesMin = 1 m_prm.iNbTentativesMax = 1 m_prm.rTauxResultatMinPourcent = 0 ' 0% de résultats au minimum : pas d'exigence m_prm.rTauxErreurMax = 1.0! ' pas d'exigence m_prm.rCoeffAjustPoids = m_rCoeffAjustPoidsDef m_prm.rCoeffApprentissage = m_rCoeffApprentissageDef m_prm.rGainSignal = m_rGainSignalDef m_prm.rInitPoidsMin = m_rInitPoidsMinDef m_prm.rInitPoidsMax = m_rInitPoidsMaxDef m_prm.rFreqAffichagePourcent = 10 m_prm.rToleranceErr = 0.4! ' Légère activation du neurone vers 0 ou 1 m_prm.fctActivation = m_fctActivationDef m_prm.rCentreFctActivation = 0.0! m_var.bModePrediction = False m_var.amplitSortie.rMin = m_rMinNorme ' 0 m_var.amplitSortie.rMax = m_rMaxNorme ' 1 m_var.iNumTentative = 0 End Sub Public Sub DimensionnerReseau() '/* --- création des couches */ ReDim m_aCouches(m_prm.iNbCouches - 1) '/* --- initialisation des couches */ Dim i%, j% For i = 0 To m_prm.iNbCouches - 1 With m_aCouches(i) '/* --- création des neurones */ .iNbNeurones = m_prm.aiNbNeuronesCouche(i) .iNbPoids = .iNbNeurones ' Si on implémente le Biais autom., on ajoute un poids ' comme si on ajoutait un neurone à la couche précédente ' (et donc pas sur la dernière couche) If m_bImplementerBiaisAutom And i < m_prm.iNbCouches - 1 Then _ .iNbPoids += 1 ReDim .aNeurones(.iNbNeurones - 1) '/* --- initialisation des neurones */ For j = 0 To .iNbNeurones - 1 .aNeurones(j).rSignal = m_rMinNorme ' 0.0! .aNeurones(j).rErreur = 0.0! If (i > 0) Then Dim iNbPoids% = m_aCouches(i - 1).iNbPoids ReDim .aNeurones(j).rPoids(iNbPoids - 1) ReDim .aNeurones(j).rAjustPoids(iNbPoids - 1) ReDim .aNeurones(j).rMemPoids(iNbPoids - 1) End If Next j End With Next i m_var.iNbNeuronesEntree = m_aCouches(0).iNbNeurones m_var.iNbNeuronesSortie = m_aCouches(m_prm.iNbCouches - 1).iNbNeurones End Sub Private Sub EcrireFichierPoids() On Error GoTo Err_bEFP Dim i%, j%, k% Const iNumFichier% = 2 FileOpen(iNumFichier, m_prm.sCheminFichierPoids, OpenMode.Binary, _ OpenAccess.Write) FilePut(iNumFichier, m_rVersionFichierPoids) FilePut(iNumFichier, m_prm.iNbCouches) For i = 0 To m_prm.iNbCouches - 1 FilePut(iNumFichier, m_prm.aiNbNeuronesCouche(i)) Next i For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 ' Version 1.02 : Changement depuis m_rVersionFichierPoids = 1.01 : ' le tableau était dimensionné trop grand de 1, et ' le biais autom. n'était pas pris en compte 'For k = 0 To m_aCouches(i-1).iNbNeurones = m_prm.aiNbNeuronesCouche(i - 1) FilePut(iNumFichier, m_aCouches(i).aNeurones(j).rPoids(k)) Next k : Next j : Next i FileClose(iNumFichier) Exit Sub Err_bEFP: FileClose() ' Fermer tous les fichiers ouverts AfficheMsgErreur(Err, "", "EcrireFichierPoids") End Sub Private Function bLireFichierPoids() As Boolean ' Attention, on ne vérifie pas si le fichier est compatible ' avec les paramètres actuels du RN : à faire ! Try Dim i%, j%, k% Dim rVersionFichierPoids! Const iNumFichier% = 2 ' Essayer d'ouvrir le fichier des poids et de lire ' son n° de version FileOpen(iNumFichier, m_prm.sCheminFichierPoids, OpenMode.Binary, _ OpenAccess.Read) FileGet(iNumFichier, rVersionFichierPoids) If rVersionFichierPoids = 0 Then Exit Function If rVersionFichierPoids <> m_rVersionFichierPoids Then _ Exit Function ' Finally sera quand même appelé FileGet(iNumFichier, m_prm.iNbCouches) ReDim m_prm.aiNbNeuronesCouche(m_prm.iNbCouches - 1) For i = 0 To m_prm.iNbCouches - 1 FileGet(iNumFichier, m_prm.aiNbNeuronesCouche(i)) Next i DimensionnerReseau() For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 FileGet(iNumFichier, m_aCouches(i).aNeurones(j).rPoids(k)) Next k : Next j : Next i bLireFichierPoids = True Catch bLireFichierPoids = False Finally FileClose() ' Fermer tous les fichiers ouverts End Try End Function Private Sub RandomiserPoids() Dim i%, j%, k% For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 With m_aCouches(i).aNeurones(j) .rPoids(k) = rRandomiser(m_prm.rInitPoidsMin, m_prm.rInitPoidsMax) .rAjustPoids(k) = 0 .rMemPoids(k) = 0 End With Next k : Next j : Next i End Sub Private Sub AppliquerSignal(ByRef arEntree!()) ' arEntree n'est pas modifié Dim i% For i = 0 To m_var.iNbNeuronesEntree - 1 m_aCouches(0).aNeurones(i).rSignal = arEntree(i) Next i End Sub Private Sub LireSignalSortie(ByRef arSortie!()) Dim i% For i = 0 To m_var.iNbNeuronesSortie - 1 arSortie(i) = m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rSignal If arSortie(i) > m_rReelMax Then arSortie(i) = m_rMaxNorme '1 If arSortie(i) < m_rReelMin Then arSortie(i) = m_rMinNorme '0 Next i End Sub Private Sub SauverPoids() Dim i%, j%, k% For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 m_aCouches(i).aNeurones(j).rMemPoids(k) = _ m_aCouches(i).aNeurones(j).rPoids(k) Next k : Next j : Next i End Sub Private Sub RestaurerPoids() Dim i%, j%, k% For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 m_aCouches(i).aNeurones(j).rPoids(k) = _ m_aCouches(i).aNeurones(j).rMemPoids(k) Next k : Next j : Next i End Sub Private Sub PropagerSignal() ' Propagation du signal de la 1ère couche à la dernière '/* calculate and feedforward outputs from the first layer to the last */ On Error Resume Next Dim i%, j%, k%, rSignalPropage!, rSignal! '/* --- la boucle commence avec la seconde couche */ For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 With m_aCouches(i).aNeurones(j) '/* --- calcul de la somme pondérée en entrée */ rSignalPropage = 0 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 ' Pour l'implémentation du biais autom., le signal ' est mis à 1 (MaxNorme) pour le dernier poids rSignal = m_rMaxNorme If k < m_aCouches(i - 1).iNbNeurones Then _ rSignal = m_aCouches(i - 1).aNeurones(k).rSignal rSignalPropage += .rPoids(k) * rSignal Next k ' Dépassement de capacité If Err.Number = 6 Then _ .rSignal = m_rMinNorme : Err.Clear() : GoTo Suite ' Mémorisation du signal pour le calcul de la dérivée ' Note : le signal propagé est une somme qui peut varier entre ' -10 et +10 rien que pour le XOR, donc avec une amplitude encore ' plus importante dans des RN de taille supérieure ! .rMemSignal = rSignalPropage ' TFctActivation.SigmoideStandard '/* --- application de la fonction d'activation (sigmoide) */ '.rSignal = 1! / (1! + Exp(-m_prm.rGainSignal * rSignalPropage)) ' Généralisation des fonctions d'activation .rSignal = rFctActivation(m_prm.fctActivation, rSignalPropage) End With Suite: Next j : Next i End Sub Private Function rFctActivation!( _ ByVal fctActivation As TFctActivation, ByVal rVal!) Dim rValArg! Select Case fctActivation Case TFctActivation.SigmoideStandard rValArg = -m_prm.rGainSignal * (rVal - m_prm.rCentreFctActivation) ' Pour éviter les dépassements de capacité If rValArg > m_rExpMax Then rFctActivation = 1 ElseIf rValArg < -m_rExpMax Then rFctActivation = 0 Else rFctActivation = CSng(1.0# / (1.0# + Math.Exp(rValArg))) End If Case TFctActivation.TangenteHyperbolique rValArg = -2 * m_prm.rGainSignal * _ (rVal - m_prm.rCentreFctActivation) If rValArg > m_rExpMax Then rFctActivation = 1 ElseIf rValArg < -m_rExpMax Then rFctActivation = 0 Else rFctActivation = CSng(2.0# / (1.0# + Math.Exp(rValArg))) - 1 ' Equivalent à : ' tanh(z) = sinh(z) / cosh(z) ' = (exp(z) – exp(-z)) / (exp(z) + exp(-z)) ' rFctActivation = (Exp(rValArg) - Exp(-rValArg)) / _ ' (Exp(rValArg) + Exp(-rValArg)) End If Case TFctActivation.DoubleSeuil ' Avec le coefficient Gain/8, la fonction Double-seuil ' approxime bien la sigmoide quelque soit le gain, et le maximum ' de la dérivée de la sigmoide coincide bien avec le centre des ' 2 seuils. De plus, on peut toujours décaler le centre de la ' fonction d'activation rValArg = CSng((rVal - m_prm.rCentreFctActivation + _ 0.5 / (m_prm.rGainSignal / 8)) * (m_prm.rGainSignal / 8)) If rValArg < 0.33 Then rFctActivation = 0 ElseIf rValArg > 0.66 Then rFctActivation = 1 Else rFctActivation = CSng(rValArg / 0.33) - 1 End If Case TFctActivation.PasUnitaire ' Rappel : les fonctions à seuils ne sont pas dérivables partout ' on utilise donc une sigmoïde en guise de dérivée, ' et le maximum de la dérivée de la sigmoïde coïncide ' bien avec le seuil de la fonction d'activation : on peut ' toujours décaler le centre de la fonction d'activation ' Attention, il n'y a plus de lien entre le gain de la dérivée ' de la simgoïde et la fonction de seuil ' Résultats : Cette fct d'activation est moins stable ' mais converge encore plus vite ! If rVal >= m_prm.rCentreFctActivation Then rFctActivation = 1 Else rFctActivation = 0 End If Case TFctActivation.Gaussienne rValArg = rVal - m_prm.rCentreFctActivation rValArg = -m_prm.rGainSignal * rValArg * rValArg If rValArg > m_rExpMax Then rFctActivation = 1 ElseIf rValArg < -m_rExpMax Then rFctActivation = 0 Else rFctActivation = CSng(Math.Exp(rValArg)) End If Case TFctActivation.Identite rFctActivation = m_prm.rGainSignal * _ (rVal - m_prm.rCentreFctActivation) End Select End Function Private Function rDeriveeFctActivation!( _ ByVal fctActivation As TFctActivation, ByVal rVal!) ' Formules générales des dérivées : ' (fg)' = f'g+fg' ' (f/g)' = f'g-fg'/g^2 ' (f°g)' = (f'°g)g' = f(g(x))' = f'(g(x))g'(x) Dim rC!, rExp! Select Case fctActivation ' Les fonctions avec seuils ne sont pas dérivables ' en tout point, on les approxime avec la sigmoïde : Case TFctActivation.SigmoideStandard, _ TFctActivation.PasUnitaire, _ TFctActivation.DoubleSeuil If m_prm.rGainSignal = 1 Then ' Lorsque le gain est égale à 1, la dérivée de la sigmoïde ' se calcule rapidement à partir de la sigmoïde directe : ' Si y = 1 / (1 + exp(-x)) ' y' = y * (1 - y) Dim rValArg! = rFctActivation(TFctActivation.SigmoideStandard, rVal) rDeriveeFctActivation = rValArg * (1 - rValArg) Else ' m_prm.rGainSignal <> 1 ' Dans le cas général, la dérivée de F(X) = 1/(1+Exp(c*X)) ' se calcule ainsi : dérivée(u/v) = (vu' - uv')/v^2 ' soit : F'(X) = -c*Exp(c*X) / (1+Exp(c*X))^2 ' Elle ressemble à une gausienne, mais n'en est pas une. ' Vous pouvez vérifier que ce calcul est identique au ' précédent dans le cas où le gain vaut 1 rC = -m_prm.rGainSignal rExp = CSng(Math.Exp(rC * (rVal - m_prm.rCentreFctActivation))) rDeriveeFctActivation = -rC * rExp / ((1 + rExp) * (1 + rExp)) End If Case TFctActivation.TangenteHyperbolique If m_prm.rGainSignal = 1 Then ' Pareil avec la Tangente hyperbolique : ' Si y = 2 / (1 + exp(-2x)) ' y' = 1 - y^2 Dim rValArg! = rFctActivation(TFctActivation.TangenteHyperbolique, rVal) rDeriveeFctActivation = 1 - rValArg * rValArg Else rC = -2 * m_prm.rGainSignal rExp = CSng(Math.Exp(rC * (rVal - m_prm.rCentreFctActivation))) rDeriveeFctActivation = -2 * rC * rExp / ((1 + rExp) * (1 + rExp)) End If Case TFctActivation.Gaussienne Dim rX! = (rVal - m_prm.rCentreFctActivation) rC = -m_prm.rGainSignal rExp = CSng(Math.Exp(rC * rX * rX)) rDeriveeFctActivation = 2 * rC * rX * rExp Case TFctActivation.Identite rDeriveeFctActivation = m_prm.rGainSignal End Select End Function Private Function rCalculerErreurSortie!(ByRef arCible!()) ' arCible n'est pas modifié Dim i%, rDelta!, rSignal!, rErrAbsMoy! rErrAbsMoy = 0 On Error Resume Next For i = 0 To m_var.iNbNeuronesSortie - 1 rSignal = m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rSignal rDelta = arCible(i) - rSignal If Err.Number = 6 Then ' Dépassement de capacité m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rErreur = 1 Err.Clear() Else If m_prm.fctActivation = TFctActivation.SigmoideStandard And _ m_prm.rGainSignal = 1 Then ' Attention : y' = y * (1 - y) n'est la dérivée de la ' sigmoïde que si rGainSignal = 1 (y étant la fct ' d'activation directe : sa valeur vient d'être calculée ' et stockée dans rSignal pour chaque neurone m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rErreur = _ rSignal * (1 - rSignal) * rDelta ElseIf m_prm.fctActivation = TFctActivation.TangenteHyperbolique And _ m_prm.rGainSignal = 1 Then ' Même remarque pour y' = 1 - y^2 m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rErreur = _ (1 - rSignal * rSignal) * rDelta Else ' Dans le cas général, le signal a été stocké dans rMemSignal m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rErreur = _ rDelta * rDeriveeFctActivation(m_prm.fctActivation, _ m_aCouches(m_prm.iNbCouches - 1).aNeurones(i).rMemSignal) End If End If rErrAbsMoy += Math.Abs(rDelta) Next i '/* --- erreur absolue moyenne */ rErrAbsMoy /= m_var.iNbNeuronesSortie rCalculerErreurSortie = rErrAbsMoy End Function Private Sub RetropropagerErreur() ' Rétropropagation de l'erreur de la couche de sortie ' vers la 1ère couche en entrée '/* backpropagate error from the output layer through to the first layer */ On Error Resume Next Dim i%, j%, k%, rSignal!, rErreurCumulee! '/* --- la boucle commence à l'avant dernière couche */ For i = m_prm.iNbCouches - 2 To 0 Step -1 '/* --- couche inférieure */ For j = 0 To m_aCouches(i).iNbNeurones - 1 rErreurCumulee = 0 '/* --- couche supérieure */ For k = 0 To m_aCouches(i + 1).iNbNeurones - 1 rErreurCumulee += m_aCouches(i + 1).aNeurones(k).rPoids(j) * _ m_aCouches(i + 1).aNeurones(k).rErreur Next k If Err.Number = 6 Then ' Dépassement de capacité m_aCouches(i).aNeurones(j).rErreur = 1 Err.Clear() Else ' Voir les remarques précisées dans rCalculerErreurSortie() If m_prm.fctActivation = TFctActivation.SigmoideStandard And _ m_prm.rGainSignal = 1 Then rSignal = m_aCouches(i).aNeurones(j).rSignal m_aCouches(i).aNeurones(j).rErreur = _ rSignal * (1.0! - rSignal) * rErreurCumulee ElseIf m_prm.fctActivation = TFctActivation.TangenteHyperbolique And _ m_prm.rGainSignal = 1 Then rSignal = m_aCouches(i).aNeurones(j).rSignal m_aCouches(i).aNeurones(j).rErreur = _ (1.0! - rSignal * rSignal) * rErreurCumulee Else m_aCouches(i).aNeurones(j).rErreur = rErreurCumulee * _ rDeriveeFctActivation(m_prm.fctActivation, _ m_aCouches(i).aNeurones(j).rMemSignal) End If End If Next j : Next i End Sub Private Sub AjusterPoids() ' Mise à jour des poids des neurones de la 1ère à la dernière couche '/* update weights for all of the neurons from the first to the last layer */ Dim i%, j%, k%, rErreur!, rSignal!, rAjustPoids!, rApprentissage! '/* --- la boucle commence avec la seconde couche */ For i = 1 To m_prm.iNbCouches - 1 For j = 0 To m_aCouches(i).iNbNeurones - 1 For k = 0 To m_aCouches(i - 1).iNbPoids - 1 With m_aCouches(i).aNeurones(j) ' Pour l'implémentation du biais autom., le signal ' est mis à 1 (MaxNorme) pour le dernier poids rSignal = m_rMaxNorme If k < m_aCouches(i - 1).iNbNeurones Then _ rSignal = m_aCouches(i - 1).aNeurones(k).rSignal rErreur = .rErreur rAjustPoids = .rAjustPoids(k) If rErreur > m_rReelMax Or rErreur < m_rReelMin Then .rPoids(k) = 0 .rAjustPoids(k) = 0 GoTo Suite End If rApprentissage = m_prm.rCoeffApprentissage * rSignal * rErreur .rPoids(k) += rApprentissage + _ m_prm.rCoeffAjustPoids * rAjustPoids .rAjustPoids(k) = rApprentissage End With Suite: Next k : Next j : Next i End Sub Private Function bLireNombreReel(ByVal iNumFichier%, ByRef rNombre!) _ As Boolean Dim sCar$ = " " Dim sNombre$ = "" Dim i% Do While (i < 255) ' Lecture d'une ligne de 255 caractères max. If EOF(iNumFichier) Then Exit Do FileGet(iNumFichier, sCar) ' Gestion d'une ligne de commentaires If sCar = "'" Then ' LineInput pertube FileGet, on le reprogramme nous-même 'Dim sRem$ = LineInput(iNumFichier) Do While Not EOF(iNumFichier) FileGet(iNumFichier, sCar) If sCar = vbCr Then FileGet(iNumFichier, sCar) Exit Do End If Loop i = 0 GoTo Suite End If If sCar = "." Or sCar = "0" Or sCar = "1" Or _ sCar = "2" Or sCar = "3" Or sCar = "4" Or _ sCar = "5" Or sCar = "6" Or sCar = "7" Or _ sCar = "8" Or sCar = "9" Or sCar = "-" Then sNombre &= sCar i += 1 Else If (i > 0) Then Exit Do End If Suite: Loop If i = 0 Then bLireNombreReel = False : Exit Function rNombre = CSng(Val(sNombre)) bLireNombreReel = True End Function Private Function bLireApprentissage( _ Optional ByVal bLectureSimple As Boolean = False) As Boolean Dim iNbNeuronesEntree%, iNbNeuronesCible% Dim rNombre!, rMemNombre!, sLigneCible$, i% Dim arEntree!(), arCible!() Const iNumFichier% = 1 If m_prm.sCheminFichierPoids = "" Then _ m_prm.sCheminFichierPoids = Left(m_prm.sCheminFichier, _ Len(m_prm.sCheminFichier) - 4) & ".pds" RelireApprentissage: iNbNeuronesEntree = 0 : iNbNeuronesCible = 0 If m_bTrapErr Then On Error GoTo Err_LA FileOpen(iNumFichier, m_prm.sCheminFichier, OpenMode.Binary, _ OpenAccess.Read) ReDim arEntree(m_var.iNbNeuronesEntree) ReDim arCible(m_var.iNbNeuronesSortie) m_var.iNbLignesBase = 0 ReDim m_aApprentissage(0) m_var.iNbLignesApprentissageMax = m_prm.iNbLignesApprentissageMax sLigneCible = "" Do While bLireNombreReel(iNumFichier, rNombre) And _ (m_var.iNbLignesBase < (m_prm.iNbLignesApprentissageMax + _ m_prm.iNbLignesAPredire) Or m_prm.iNbLignesApprentissageMax = 0) ' Saisie des entrées ou des cibles If (iNbNeuronesEntree < m_var.iNbNeuronesEntree) Then arEntree(iNbNeuronesEntree) = rNombre iNbNeuronesEntree += 1 ElseIf (iNbNeuronesCible < m_var.iNbNeuronesSortie) Then arCible(iNbNeuronesCible) = rNombre iNbNeuronesCible += 1 sLigneCible &= rNombre & " " End If If (iNbNeuronesEntree = m_var.iNbNeuronesEntree And _ iNbNeuronesCible = m_var.iNbNeuronesSortie) Then ReDim Preserve m_aApprentissage(m_var.iNbLignesBase) With m_aApprentissage(m_var.iNbLignesBase) ' Méthode la plus simple pour dupliquer un tableau en pur VB.Net .arEntree = DirectCast(arEntree.Clone, Single()) '.arEntree = VB6.CopyArray(arEntree) '.arEntree = (arEntree) ' Non, cela ne suffit pas à déréferencer 'ReDim .arEntree(arEntree.GetUpperBound(0)) 'Dim j% 'For j = 0 To arEntree.GetUpperBound(0) ' .arEntree(j) = arEntree(j) 'Next j .arCible = DirectCast(arCible.Clone, Single()) '.arCible = VB6.CopyArray(arCible) 'ReDim .arCible(arCible.GetUpperBound(0)) 'For j = 0 To arCible.GetUpperBound(0) ' .arCible(j) = arCible(j) 'Next j .sLigneCible = sLigneCible End With m_var.iNbLignesBase += 1 iNbNeuronesEntree = 0 iNbNeuronesCible = 0 sLigneCible = "" End If Suite: Loop FileClose(iNumFichier) If bLectureSimple Then bLireApprentissage = True : Exit Function ' Normalisation des entrées et sorties entre 0 et 1 Normaliser() Dim iNbLignes% = m_var.iNbLignesBase ' Si on n'a pas précisé le nombre de lignes à apprendre, on apprend ' tout en tenant compte du nbre de lignes à prédire If m_var.iNbLignesApprentissageMax = 0 Then m_var.iNbLignesApprentissageMax = _ iNbLignes - m_prm.iNbLignesAPredire If m_var.iNbLignesApprentissageMax < 1 Then _ m_var.iNbLignesApprentissageMax = 1 End If ' Si on a précisé un nombre supérieur au nombre de lignes possible If m_var.iNbLignesApprentissageMax > iNbLignes Then _ m_var.iNbLignesApprentissageMax = iNbLignes If m_prm.iNbLignesAPredire + _ m_var.iNbLignesApprentissageMax > iNbLignes Then _ m_prm.iNbLignesAPredire = iNbLignes - _ m_var.iNbLignesApprentissageMax m_var.iNbLignesApprentissage = m_var.iNbLignesApprentissageMax bLireApprentissage = True Exit Function Err_LA: FileClose() ' Fermer tous les fichiers ouverts AfficheMsgErreur(Err, "", "bLireApprentissage") End Function Private Sub Normaliser() ' Normalisation des entrées et des sorties entre 0 et 1 ' (entre m_rMinNorme et m_rMaxNorme) Dim aAmplitE() As TAmplitude Dim aAmplitS() As TAmplitude Dim i%, j%, k%, iFinj%, rNombre! ReDim aAmplitE(m_var.iNbNeuronesEntree - 1) ReDim aAmplitS(m_var.iNbNeuronesSortie - 1) iFinj = m_var.iNbNeuronesEntree - 1 For j = 0 To iFinj aAmplitE(j).rMin = m_rReelMax aAmplitE(j).rMax = -m_rReelMax Next j For j = 0 To m_var.iNbNeuronesSortie - 1 aAmplitS(j).rMin = m_rReelMax aAmplitS(j).rMax = -m_rReelMax Next j ' Calcul des min. et max. des entrées For i = 0 To m_var.iNbLignesBase - 1 For j = 0 To iFinj rNombre = m_aApprentissage(i).arEntree(j) k = 0 If m_prm.bNormalisationIndep Then k = j If rNombre < aAmplitE(k).rMin Then aAmplitE(k).rMin = rNombre If rNombre > aAmplitE(k).rMax Then aAmplitE(k).rMax = rNombre Next j : Next i m_var.amplitEntree = aAmplitE(0) m_var.amplitSortie = aAmplitE(0) ' Méthode la plus simple pour dupliquer un tableau en pur VB .Net m_var.aAmplitEntree = DirectCast(aAmplitE.Clone, TAmplitude()) m_var.aAmplitSortie = DirectCast(aAmplitE.Clone, TAmplitude()) 'm_var.aAmplitEntree = VB6.CopyArray(aAmplitE) 'm_var.aAmplitSortie = VB6.CopyArray(aAmplitE) 'ReDim m_var.aAmplitEntree(m_var.iNbNeuronesEntree - 1) 'ReDim m_var.aAmplitSortie(m_var.iNbNeuronesSortie - 1) 'For j = 0 To m_var.aAmplitEntree.GetUpperBound(0) ' m_var.aAmplitEntree(j) = aAmplitE(j) 'Next j 'For j = 0 To m_var.aAmplitSortie.GetUpperBound(0) ' m_var.aAmplitSortie(j) = aAmplitE(j) 'Next j ' Normalisation des entrées entre 0 et 1 For j = 0 To iFinj k = 0 If m_prm.bNormalisationIndep Then k = j If m_var.aAmplitEntree(k).rMax - _ m_var.aAmplitEntree(k).rMin <> 0 Then For i = 0 To m_var.iNbLignesBase - 1 rNombre = m_aApprentissage(i).arEntree(j) m_aApprentissage(i).arEntree(j) = m_rMinNorme + _ (m_rMaxNorme - m_rMinNorme) * _ (rNombre - m_var.aAmplitEntree(k).rMin) / _ (m_var.aAmplitEntree(k).rMax - _ m_var.aAmplitEntree(k).rMin) Next i End If Next j ' Normalisation des sorties ' Cas où l'entrée et la sortie sont spécifiées ' Calcul des min. et max. des sorties iFinj = m_prm.iNbSortiesSignif - 1 For i = 0 To m_var.iNbLignesBase - 1 For j = 0 To iFinj rNombre = m_aApprentissage(i).arCible(j) k = 0 If m_prm.bNormalisationIndep Then k = j If rNombre < aAmplitS(k).rMin Then aAmplitS(k).rMin = rNombre If rNombre > aAmplitS(k).rMax Then aAmplitS(k).rMax = rNombre Next j : Next i m_var.amplitSortie = aAmplitS(0) ' Méthode la plus simple pour dupliquer un tableau en pur VB .Net m_var.aAmplitSortie = DirectCast(aAmplitS.Clone, TAmplitude()) 'm_var.aAmplitSortie = VB6.CopyArray(aAmplitS) 'For i = 0 To aAmplitS.GetUpperBound(0) ' m_var.aAmplitSortie(i) = aAmplitS(i) 'Next i ' Normalisation des sorties entre 0 et 1 For j = 0 To iFinj k = 0 If m_prm.bNormalisationIndep Then k = j If m_var.aAmplitSortie(k).rMax - _ m_var.aAmplitSortie(k).rMin <> 0 Then For i = 0 To m_var.iNbLignesBase - 1 rNombre = m_aApprentissage(i).arCible(j) m_aApprentissage(i).arCible(j) = m_rMinNorme + _ (m_rMaxNorme - m_rMinNorme) * _ (rNombre - m_var.aAmplitSortie(k).rMin) / _ (m_var.aAmplitSortie(k).rMax - _ m_var.aAmplitSortie(k).rMin) Next i End If Next j End Sub Private Function rSimuler!(ByRef arEntree!(), ByRef arSortie!(), _ ByRef arCible!(), ByVal sLigneCible$, ByVal iNumLigne%, _ ByRef iNbSucces%, ByVal bModePrediction As Boolean, _ ByVal bAfficherRes As Boolean, ByVal bCalculerRes As Boolean, _ ByVal bApprentissage As Boolean, _ Optional ByVal bDerniereLigne As Boolean = False) ' arEntree et arCible ne sont pas modifiés '/* --- on fait passer le signal dans le réseau */ AppliquerSignal(arEntree) PropagerSignal() LireSignalSortie(arSortie) If bCalculerRes Then CalculerResultats(arEntree, arSortie, _ arCible, sLigneCible, iNumLigne, iNbSucces, bApprentissage, _ bModePrediction, bCalculerRes, bAfficherRes, bDerniereLigne) '/* --- calcul de l'erreur en sortie par rapport à la cible */ '/* ce calcul sert de base pour la rétropropagation */ rSimuler = rCalculerErreurSortie(arCible) '/* --- si c'est un apprentissage, on fait une rétropropagation de l'erreur */ If bApprentissage Then RetropropagerErreur() AjusterPoids() End If End Function Public Sub Demarrer() Dim rMinErrMoy!, rErrMoy! Dim i%, iIteration%, arSortie!() Dim iNbSucces% Dim rErrMoyTotJeuTest!, rMemErrMoyTotJeuTest! Dim rMaxTauxResultat!, rMinTauxErreur! Dim sObjectifRes$, sObjectifErr$, sMessage$ Dim bAfficherRes As Boolean Dim iNbLignesTot%, iFinAppr% Dim iNbRestaurations%, iNbSauvegardes%, iNbNeutres% Dim bCalculerRes, bModePrediction As Boolean Dim bStopTentative, bGraphiquePossible As Boolean Dim res As TResultatComplet sObjectifRes = "" : sObjectifErr = "" bGraphiquePossible = False If m_prm.iNbSortiesSignif = 1 Then bGraphiquePossible = True If m_prm.bGraphique Then bGraphiquePossible = True ' Les lignes d'apprentissages sont mémorisées If Not bLireApprentissage() Then Exit Sub iNbLignesTot = m_var.iNbLignesApprentissage + m_prm.iNbLignesAPredire ' Si une seule ligne, pas de normalisation possible If iNbLignesTot < 2 Then _ Afficher("Nombre de lignes insuffisant") : Exit Sub iFinAppr = m_var.iNbLignesApprentissage - 1 ReDim arSortie(m_var.iNbNeuronesSortie) ReDim m_var.arEcartSC(m_var.iNbNeuronesSortie) If m_prm.rTauxResultatMinPourcent > 0 Then _ sObjectifRes = " / " & m_prm.rTauxResultatMinPourcent & "%" If m_prm.rTauxErreurMax < 1 Then _ sObjectifErr = " / " & m_prm.rTauxErreurMax If Not m_prm.bNormalisationIndep Then Afficher("Valeur min. en entrée : " & m_var.amplitEntree.rMin) Afficher("Valeur max. en entrée : " & m_var.amplitEntree.rMax) Afficher("Valeur min. en sortie : " & m_var.amplitSortie.rMin) Afficher("Valeur max. en sortie : " & m_var.amplitSortie.rMax) End If Afficher("Nombre de lignes max. du fichier : " & _ m_var.iNbLignesApprentissage + m_prm.iNbLignesAPredire) Afficher("") If m_var.iNbLignesApprentissage = 0 Then GoTo Fin If Not m_prm.bReinitialiserPoids Then If bLireFichierPoids() Then ' Tracé du signal d'entrée en noir (appris) et bleu (à prédire) EffacerGraphique() TracerCourbe(iNbLignesTot, 0, iNbLignesTot - 1, _ Color.Black, Color.Blue, iFinAppr, bTracerSortie:=False) GoTo ModePredictionPonctuelle End If End If rMaxTauxResultat = 0 rMinTauxErreur = 1 m_var.iNumTentative = 0 m_var.iNbTentativesOk = 0 If m_prm.iNbTentativesMin > m_prm.iNbTentativesMax Then _ m_prm.iNbTentativesMax = m_prm.iNbTentativesMin NouvelleTentative: m_var.iNumTentative += 1 ' Tracé du signal d'entrée en noir (appris) et bleu (à prédire) EffacerGraphique() TracerCourbe(iNbLignesTot, 0, iNbLignesTot - 1, _ Color.Black, Color.Blue, iFinAppr, bTracerSortie:=False) iIteration = 0 : m_var.iNumIteration = 0 m_var.iNbIterationsMin = 0 res.iNbResultats = iNbLignesTot m_var.rTauxResultat = 0 : m_var.rTauxErreurs = 0 rMinErrMoy = 1 : rMemErrMoyTotJeuTest = 0 iNbSauvegardes = 0 : iNbRestaurations = 0 : iNbNeutres = 0 bModePrediction = False : bStopTentative = False Afficher("") Afficher("Tentative d'apprentissage n°" & m_var.iNumTentative & _ " / " & m_prm.iNbTentativesMax, bSautDeLigne:=True) '/* --- init du générateur de nombres aléatoires */ '/* --- et génération des pondérations aléatoires */ Randomize() : RandomiserPoids() ' Apprentissage et vérification des résultats ' Note : il y a une étape de moins par rapport à la version d'origine ' en C++ : dans la fonction Run, il y avait : ' Train(fname) puis Test(fname), c.a.d. 2x l'appel à Simulate ' alors qu'un seul suffit pour faire l'apprentissage Dim rNorm! Dim sPrecision$ Do m_var.iNumIteration = iIteration rErrMoyTotJeuTest = 0 res.resCumul.iNbLignes = 0 res.resCumul.iSucces = 0 res.resCumul.rSommeErreur = 0 ' Affichage et bilan à intervalle régulier bCalculerRes = bCalculerResultat(m_var.iNumIteration, _ m_prm.iNbIterations, m_prm.rFreqAffichagePourcent) For i = 0 To m_var.iNbNeuronesSortie - 1 m_var.arEcartSC(i) = 0 Next i m_var.rTauxApprentissageS1 = 0 For i = 0 To m_var.iNbLignesApprentissage - 1 bAfficherRes = bCalculerRes And bAfficherDegressivement(i + 1) rErrMoy = rSimuler(m_aApprentissage(i).arEntree, arSortie, _ m_aApprentissage(i).arCible, _ m_aApprentissage(i).sLigneCible, i, iNbSucces, _ bModePrediction, bAfficherRes, bCalculerRes, _ bApprentissage:=True) If bCalculerRes Then res.resCumul = ComptabiliserResultat(iNbSucces, _ m_prm.iNbSortiesSignif, rErrMoy, res.resCumul, _ bResultatSimple:=False, bPrediction:=False) If bAfficherRes Then _ Afficher("Appr. cumul. " & _ sFormaterResultat(res.resCumul, bPrediction:=False)) End If rErrMoyTotJeuTest = rErrMoyTotJeuTest + rErrMoy If bGraphiquePossible Then _ m_aApprentissage(i).rSortie1 = arSortie(0) Next i ' Fin d'une itération iIteration += 1 rErrMoyTotJeuTest /= m_var.iNbLignesApprentissage m_var.rTauxErreurs = rErrMoyTotJeuTest If m_var.rTauxErreurs < rMinTauxErreur Then _ rMinTauxErreur = m_var.rTauxErreurs If (rErrMoyTotJeuTest < rMinErrMoy) Then rMinErrMoy = rErrMoyTotJeuTest SauverPoids() iNbSauvegardes += 1 ElseIf (rErrMoyTotJeuTest > 1.2 * rMinErrMoy) Then RestaurerPoids() iNbRestaurations += 1 Else iNbNeutres += 1 End If ' Affichage à intervalle régulier If Not bCalculerRes Then GoTo SuiteApprent m_var.rTauxResultat = res.resCumul.rTauxResultat If m_var.rTauxResultat > rMaxTauxResultat Then _ rMaxTauxResultat = m_var.rTauxResultat ' Mémorisation du nbre min d'itération pour atteindre l'objectif If m_var.iNbIterationsMin = 0 And _ m_var.rTauxResultat * 100 >= m_prm.rTauxResultatMinPourcent And _ m_var.rTauxErreurs < m_prm.rTauxErreurMax Then m_var.iNbIterationsMin = iIteration End If Afficher("Itération " & iIteration & "/" & _ m_prm.iNbIterations + 1 & " :") Afficher("Taux Résultat final : " & res.resCumul.iSucces & _ "/" & res.resCumul.iMaxSucces & " = " & _ sFormater(m_var.rTauxResultat, m_sFormatRes) & _ " (max = " & sFormater(rMaxTauxResultat, m_sFormatRes) & _ sObjectifRes & ")") Afficher("Erreur moyenne = " & _ sFormater(rErrMoyTotJeuTest, m_sFormatErr) & _ " (min = " & _ sFormater(rMinTauxErreur, m_sFormatErr) & _ sObjectifErr & ")") m_var.rTauxApprentissageS1 = 1 - m_var.arEcartSC(0) / _ m_var.iNbLignesApprentissage Afficher(" Taux d'apprentissage de la première sortie : " & _ sFormater(m_var.rTauxApprentissageS1, "0.00%")) ' Affichage du résultat de chaque sortie If m_prm.bNormalisationIndep Then For i = 0 To m_var.iNbNeuronesSortie - 1 rNorm = m_var.aAmplitSortie(i).rMax - _ m_var.aAmplitSortie(i).rMin m_var.arEcartSC(i) *= rNorm / m_var.iNbLignesApprentissage sPrecision = " à " & sFormater(m_prm.rToleranceErr, "0%") & _ " près = " & sFormater(m_prm.rToleranceErr * rNorm, "0.0") sMessage = " Ecart " & i + 1 & " = " & _ sFormater(m_var.arEcartSC(i), m_prm.sFormatSignal) & sPrecision sMessage = sMessage & " Min " & i + 1 & " = " & _ sFormater(m_var.aAmplitSortie(i).rMin, m_prm.sFormatSignal) & _ " Max " & i + 1 & " = " & sFormater(m_var.aAmplitSortie(i).rMax, _ m_prm.sFormatSignal) Afficher(sMessage) Next i End If ' Si au bout d'un moment l'erreur moyenne ne baisse plus, ' on refait une nouvelle tentative If (iIteration >= m_prm.iNbIterations / 3) And _ (Math.Abs(rMemErrMoyTotJeuTest - _ rErrMoyTotJeuTest) < 0.0001) Then ' Si objectif atteint, poursuivre qd même ? 'And rTauxResultat * 100 < m_prm.rTauxResultatMinPourcent And _ 'rTauxErreurs >= m_prm.rTauxErreurMax Then Afficher(" -> L'erreur ne diminue plus, fin de cette tentative") bStopTentative = True End If rMemErrMoyTotJeuTest = rErrMoyTotJeuTest Afficher("") ' Saut de ligne ' Tracé du signal d'apprentissage en vert If bGraphiquePossible Then TracerCourbe(iNbLignesTot, 0, _ m_var.iNbLignesApprentissage - 1, Color.LightGreen, Color.Blue, _ iNbLignesTot, bTracerSortie:=True) While m_prm.bPause And Not m_prm.bStop Application.DoEvents() End While SuiteApprent: Loop While ((Not m_prm.bStop) And (Not bStopTentative) And _ (iIteration <= m_prm.iNbIterations)) ' une de plus pour l'affichage ! If m_prm.bStop Then GoTo Fin Afficher("Sauvegardes des poids : " & iNbSauvegardes & " / " & _ iIteration & " : " & sFormater(CSng(iNbSauvegardes / iIteration), _ m_sFormatRes)) Afficher("Restaurations des poids : " & iNbRestaurations & " / " & _ iIteration & " : " & sFormater(CSng(iNbRestaurations / iIteration), _ m_sFormatRes)) Afficher("Itérations neutres : " & iNbNeutres & " / " & _ iIteration & " : " & sFormater(CSng(iNbNeutres / iIteration), _ m_sFormatRes)) Afficher("") If m_var.rTauxResultat * 100 >= m_prm.rTauxResultatMinPourcent And _ m_var.rTauxErreurs < m_prm.rTauxErreurMax Then If m_prm.rTauxResultatMinPourcent > 0 Or m_prm.rTauxErreurMax < 1 Then Afficher("Objectif atteint :") Afficher("Taux de résultat : " & _ sFormater(m_var.rTauxResultat, m_sFormatRes) & " >= " & _ m_prm.rTauxResultatMinPourcent & "%") Afficher("Taux d'erreur : " & _ sFormater(m_var.rTauxErreurs, m_sFormatErr) & " < " & _ m_prm.rTauxErreurMax, bSautDeLigne:=True) End If m_var.iNbTentativesOk += 1 EcrireFichierPoids() If m_var.iNumTentative <= m_prm.iNbTentativesMin - 1 Then _ GoTo NouvelleTentative Else If m_var.iNumTentative <= m_prm.iNbTentativesMax - 1 Then _ GoTo NouvelleTentative If m_var.iNumTentative <= m_prm.iNbTentativesMin - 1 Then _ GoTo NouvelleTentative Afficher("Echec de l'apprentissage") GoTo Fin End If ' Le mode de prédiction ponctuelle fonctionne lorsque l'apprentissage ' n'est réalisé que sur une partie seulement des données, le reste ' des données servant à évaluer le taux de prédiction ponctuelle à ' partir des données apprises. ' D'une façon pratique, il faut utiliser une fenêtre glissante sur ' les données du fichier de façon à éviter de dupliquer les lignes ' d'apprentissage, mais cela complique le code : des exemples avec ' la prédiction des taches solaires, du CAC40 et du Loto sont ' disponibles ici : ' http://www.vbfrance.com/article.asp?Val=2878 ModePredictionPonctuelle: ' ------------------------------------------------------------------------- If m_prm.iNbLignesAPredire = 0 Then Afficher("Test de l'apprentissage", bSautDeLigne:=True) Else Afficher("prédiction ponctuelle (à partir des données exactes)", _ bSautDeLigne:=True) End If ' Taux de résultat de chaque ligne d'apprentissage Dim resPrevPonct As TResultatComplet resPrevPonct.iNbResultats = iNbLignesTot ReDim resPrevPonct.aRes(resPrevPonct.iNbResultats - 1) ReDim resPrevPonct.aResCumul(resPrevPonct.iNbResultats - 1) Dim iFin% Dim bDerniereLigne As Boolean iFin = iNbLignesTot - 1 For i = 0 To iFin If i >= m_var.iNbLignesApprentissage Then bAfficherRes = bAfficherDegressivement( _ i - m_var.iNbLignesApprentissage + 1) Else bAfficherRes = bAfficherDegressivement(i + 1) End If ' Le dernier tirage est prédit et affiché (utile pour le loto :-) If i = iFin Then bAfficherRes = True : bDerniereLigne = True If i >= m_var.iNbLignesApprentissage Then bModePrediction = True rErrMoy = rSimuler(m_aApprentissage(i).arEntree, arSortie, _ m_aApprentissage(i).arCible, _ m_aApprentissage(i).sLigneCible, i, iNbSucces, _ bModePrediction, bAfficherRes, bCalculerRes:=True, _ bApprentissage:=False, bDerniereLigne:=bDerniereLigne) If bGraphiquePossible Then _ m_aApprentissage(i).rSortie1 = arSortie(0) If bModePrediction Then ' Mode prédiction ponctuelle resPrevPonct.aRes(i) = ComptabiliserResultat(iNbSucces, _ m_prm.iNbSortiesSignif, rErrMoy, resPrevPonct.resCumul, _ bResultatSimple:=True, bPrediction:=True) resPrevPonct.aResCumul(i) = ComptabiliserResultat(iNbSucces, _ m_prm.iNbSortiesSignif, rErrMoy, resPrevPonct.resCumul, _ bResultatSimple:=False, bPrediction:=True) resPrevPonct.resCumul = resPrevPonct.aResCumul(i) If bAfficherRes Then Afficher("Prév. ponct. cumul. " & _ sFormaterResultat(resPrevPonct.resCumul)) Else ' Mode test apprentissage resPrevPonct.aRes(i) = ComptabiliserResultat(iNbSucces, _ m_prm.iNbSortiesSignif, rErrMoy, resPrevPonct.resCumul, _ bResultatSimple:=True, bPrediction:=False) resPrevPonct.aResCumul(i) = ComptabiliserResultat(iNbSucces, _ m_prm.iNbSortiesSignif, rErrMoy, resPrevPonct.resCumul, _ bResultatSimple:=False, bPrediction:=False) resPrevPonct.resCumul = resPrevPonct.aResCumul(i) m_var.rTauxResultat = resPrevPonct.resCumul.rTauxResultat m_var.rTauxErreurs = resPrevPonct.resCumul.rTauxErreur If bAfficherRes Then Afficher("Appr. cumul. " & _ sFormaterResultat(resPrevPonct.resCumul, bPrediction:=False)) End If While m_prm.bPause And Not m_prm.bStop Application.DoEvents() End While If m_prm.bStop Then Exit For Next i ' Tracé du signal d'apprentissage en jaune et prédiction en rouge If bGraphiquePossible Then _ TracerCourbe(iNbLignesTot, 0, iNbLignesTot - 1, _ Color.Yellow, Color.Red, iFinAppr, bTracerSortie:=True) If m_prm.bStop Then GoTo Fin Afficher("") Afficher("Bilan final :") Dim iIndice% For i = 0 To resPrevPonct.iNbResultats - 1 iIndice = i + 1 If i >= m_var.iNbLignesApprentissage Then _ iIndice = i - m_var.iNbLignesApprentissage + 1 If bAfficherDegressivement(iIndice) And _ resPrevPonct.aResCumul(i).iNbLignes > 0 Then If i = m_var.iNbLignesApprentissage Then Afficher("Prédiction ponctuelle :") End If sMessage = sFormaterResultat(resPrevPonct.aResCumul(i), _ bPrediction:=False) Afficher(sMessage) End If Next i If m_prm.bReinitialiserPoids Then _ Afficher("Nbre d'itérations min.: " & m_var.iNbIterationsMin) Afficher("") Afficher("Légende") Afficher("En noir : Les données exactes") If m_prm.iNbLignesAPredire > 0 Then _ Afficher("En Bleu : Les données exactes non apprises") If m_prm.bReinitialiserPoids Then _ Afficher("En vert : Apprentissage en cours") Afficher("En jaune : Les données apprises au mieux") If m_var.bModePrediction Then _ Afficher("En rouge : Prédiction à partir des données exactes") Afficher("La cible magenta marque la fin de la zone d'apprentissage") Afficher("") Fin: If m_prm.iNbTentativesMin > 1 And m_prm.bReinitialiserPoids Then Afficher("Nbre de tentatives réussies : " & _ m_var.iNbTentativesOk & " / " & m_prm.iNbTentativesMin) Afficher("Dernière tentative :") Afficher("Taux Resultat : " & sFormater(m_var.rTauxResultat, "0.00")) Afficher("Taux Erreur : " & sFormater(m_var.rTauxErreurs, "0.00")) Afficher("Itérations Min.: " & m_var.iNbIterationsMin) End If If m_prm.bStop Then Afficher("Interruption de l'utilisateur") Afficher("Fin.", bSautDeLigne:=True) m_var.iNumIteration = 0 End Sub #End Region #Region "Fonctions utilitaires" Private Function sFormater$(ByVal rReel!, ByVal sFormat$) 'sFormater = String.Format(sFormat, rReel) sFormater = rReel.ToString(sFormat) ' Bug corrigé : Version 0.53 End Function Private Sub Afficher(ByVal sMessage$, _ Optional ByVal bSautDeLigne As Boolean = False) If m_prm.ctrlAffichage Is Nothing Then Exit Sub If m_prm.bModeRapide Then Exit Sub On Error GoTo Err_Aff m_prm.ctrlAffichage.Items.Add(sMessage) ' Positionnement de la zone de liste sur la dernière ligne affichée m_prm.ctrlAffichage.SelectedIndex = m_prm.ctrlAffichage.Items.Count - 1 If bSautDeLigne Then m_prm.ctrlAffichage.Items.Add("") If Not (m_prm.ctrlAvancement Is Nothing) And _ m_prm.iNbTentativesMax > 0 And m_prm.iNbIterations > 0 Then m_prm.ctrlAvancement.Text = _ m_var.iNumTentative & " / " & m_prm.iNbTentativesMax & _ " Avancement : " & _ sFormater(CSng(m_var.iNumIteration / m_prm.iNbIterations), "0%") & _ " Résultat : " & _ sFormater(m_var.rTauxResultat, m_sFormatRes) & _ " Erreur : " & _ sFormater(m_var.rTauxErreurs, m_sFormatErr) End If Application.DoEvents() Exit Sub Err_Aff: AfficheMsgErreur(Err, "", "Afficher") m_prm.bStop = True End Sub Public Sub EffacerGraphique() m_var.grPicBox.Clear(Color.Cyan) End Sub Private Sub TracerCourbe(ByVal iNbLignesTot%, ByVal iDebut%, ByVal iFin%, _ ByVal CouleurAppr As Color, ByVal CouleurPrediction As Color, _ ByVal iFinAppr%, ByVal bTracerSortie As Boolean) If iNbLignesTot < 2 Then Exit Sub Dim penLocal As Pen ' Couleur de l'apprentissage Dim penCouleurAppr As New Pen(CouleurAppr, 1) ' 1 : épaisseur du trait Dim penCouleurPrediction As New Pen(CouleurPrediction, 1) Dim penMagenta As New Pen(Color.Magenta, 1) Dim i%, iMemY%, iY%, iHaut%, iLarg%, iX%, iMemX% Const iMargePixels% = 5 iLarg = m_prm.ctrlGraphique.ClientRectangle.Width - iMargePixels * 2 iHaut = m_prm.ctrlGraphique.ClientRectangle.Height - iMargePixels * 2 For i = iDebut To iFin If i > iFinAppr Then penLocal = penCouleurPrediction Else penLocal = penCouleurAppr End If iX = CInt(1.0! * iLarg * i / (iNbLignesTot - 1)) If bTracerSortie Then iY = CInt(1.0! * iHaut * m_aApprentissage(i).rSortie1) Else iY = CInt(1.0! * iHaut * m_aApprentissage(i).arCible(0)) End If ' Fonction non monotone : y = f(x) au lieu de y = f(t) avec t croissant If m_prm.bTracerSortieFctEntree Then _ iX = CInt(1.0! * iLarg * m_aApprentissage(i).arEntree(0)) If i > iDebut Then m_var.grPicBox.DrawLine(penLocal, _ iMargePixels + iMemX, iMargePixels + iHaut - iMemY, _ iMargePixels + iX, iMargePixels + iHaut - iY) iMemX = iX : iMemY = iY ' Tracé de la fin de l'apprentissage If i = iFinAppr Then iX = CInt(1.0! * iLarg * i / (iNbLignesTot - 1)) If m_prm.bTracerSortieFctEntree Then _ iX = CInt(1.0! * iLarg * m_aApprentissage(i).arEntree(0)) m_var.grPicBox.DrawLine(penMagenta, _ iMargePixels + iX, iMargePixels, _ iMargePixels + iX, iMargePixels + iHaut) If bTracerSortie Then _ m_var.grPicBox.DrawLine(penMagenta, _ iMargePixels, iMargePixels + iHaut - iY, _ iMargePixels + iLarg, iMargePixels + iHaut - iY) End If Next i Application.DoEvents() End Sub Public Sub TracerFctActivation(ByVal fctActivation As TFctActivation) Dim m_pen As New Pen(Color.Black, 1) Dim i!, iMemY%, iY%, iHaut%, iLarg%, iX%, iMemX%, iDebut% Const iMargePixels! = 5 iDebut = 0 iLarg = CInt(m_prm.ctrlGraphique.ClientRectangle.Width - iMargePixels * 2) iHaut = CInt(m_prm.ctrlGraphique.ClientRectangle.Height - iMargePixels * 2) Dim m_penJaune As New Pen(Color.Yellow, 1) ' Axe vertical m_var.grPicBox.DrawLine(m_penJaune, _ iMargePixels + iLarg \ 2, iMargePixels + iHaut, _ iMargePixels + iLarg \ 2, iMargePixels) ' Axe horizontal m_var.grPicBox.DrawLine(m_penJaune, _ iMargePixels, iMargePixels + iHaut \ 2, - _ iMargePixels + iLarg, iMargePixels + iHaut \ 2) For i = 0 To 1 Step 0.01 iX = CInt(1.0! * iLarg * i) iY = CInt(1.0! * iHaut * _ (rFctActivation(fctActivation, i * 20 - 10) + 1) / 2) If i > iDebut Then m_var.grPicBox.DrawLine(m_pen, _ iMargePixels + iMemX, iMargePixels + iHaut - iMemY, _ iMargePixels + iX, iMargePixels + iHaut - iY) iMemX = iX : iMemY = iY Next i ' Tracé de la dérivée aussi m_pen = New Pen(Color.Blue, 1) For i = 0 To 1 Step 0.01 iX = CInt(1.0! * iLarg * i) Dim rDerivee! = rDeriveeFctActivation(fctActivation, i * 20 - 10) iY = CInt(1.0! * iHaut * (rDerivee + 0.5)) If i > iDebut Then m_var.grPicBox.DrawLine(m_pen, _ iMargePixels + iMemX, iMargePixels + iHaut - iMemY, _ iMargePixels + iX, iMargePixels + iHaut - iY) iMemX = iX : iMemY = iY Next i Application.DoEvents() End Sub Private Function ComptabiliserResultat(ByVal iNbSucces%, _ ByVal iNbSortiesSignif%, ByVal rErrMoy!, _ ByVal resCumul As TResultatSimple, ByVal bResultatSimple As Boolean, _ ByVal bPrediction As Boolean) As TResultatSimple Dim iSucces%, iNbLignes0%, rSommeErr! Dim res As TResultatSimple If bResultatSimple Then res.iNbLignes = 1 res.iSucces = iNbSucces res.rSommeErreur = rErrMoy Else If bPrediction Then res.iNbLignesPred = resCumul.iNbLignesPred + 1 res.iSuccesPred = resCumul.iSuccesPred + iNbSucces res.rSommeErrPred = resCumul.rSommeErrPred + rErrMoy ' On recopie pour une présentation unique des résultats res.iNbLignes = res.iNbLignesPred res.iSucces = res.iSuccesPred res.rSommeErreur = res.rSommeErrPred Else res.iNbLignes = resCumul.iNbLignes + 1 res.iSucces = resCumul.iSucces + iNbSucces res.rSommeErreur = resCumul.rSommeErreur + rErrMoy End If End If iNbLignes0 = res.iNbLignes iSucces = res.iSucces rSommeErr = res.rSommeErreur If Not bResultatSimple And bPrediction Then iNbLignes0 = res.iNbLignesPred iSucces = res.iSuccesPred rSommeErr = res.rSommeErrPred End If res.iIndice = iNbLignes0 res.iMaxSucces = iNbSortiesSignif * iNbLignes0 res.rTauxResultat = 0 If res.iMaxSucces > 0 Then _ res.rTauxResultat = CSng(iSucces / res.iMaxSucces) res.rTauxErreur = 0 If iNbLignes0 > 0 Then _ res.rTauxErreur = rSommeErr / iNbLignes0 ComptabiliserResultat = res End Function Private Function sFormaterResultat$(ByVal res As TResultatSimple, _ Optional ByVal bPrediction As Boolean = True) Dim sPrecision$, rToleranceErr!, rAmplitudeSignal! rToleranceErr = m_prm.rToleranceErr rAmplitudeSignal = m_var.amplitSortie.rMax - m_var.amplitSortie.rMin sPrecision = " à " & sFormater(rToleranceErr, "0%") If Not m_prm.bNormalisationIndep Then _ sPrecision = sPrecision & " près = " & _ sFormater(rToleranceErr * rAmplitudeSignal, "0.0") If bPrediction Then sFormaterResultat = "L" & res.iIndice & " : " & _ res.iSuccesPred & "/" & res.iMaxSucces & _ " soit " & sFormater(CSng(res.iSuccesPred / res.iMaxSucces), _ "0.00%") & sPrecision Else sFormaterResultat = "L" & res.iIndice & " : " & _ res.iSucces & "/" & res.iMaxSucces & _ " soit " & sFormater(CSng(res.iSucces / res.iMaxSucces), _ "0.00%") & sPrecision End If End Function Public Sub AfficherParametresRN() Afficher("") Afficher("Nombre de couches : " & m_prm.iNbCouches) Dim i% For i = 0 To m_prm.iNbCouches - 1 Afficher("Nombre de neurones de la couche " & i + 1 & _ " : " & m_prm.aiNbNeuronesCouche(i)) Next i Afficher("") Afficher("Chemin du fichier d'apprentissage :") Afficher(" " & m_prm.sCheminFichier) If m_prm.iNbLignesApprentissageMax > 0 Then _ Afficher("Nombre de lignes d'apprentissage max.: " & _ m_prm.iNbLignesApprentissageMax) If m_var.bModePrediction Then _ Afficher("Nombre de lignes à prédire : " & _ m_prm.iNbLignesAPredire) Afficher("") Afficher("Nombre d'itérations : " & m_prm.iNbIterations) Afficher("Coefficient d'ajustement des poids (Alpha) : " & _ m_prm.rCoeffAjustPoids) Afficher("Coefficient d'apprentissage (Eta : Signal x Erreur) : " & _ m_prm.rCoeffApprentissage) Afficher("Gain de la fct d'activation : " & m_prm.rGainSignal) Afficher("Centre de la fct d'activation : " & m_prm.rCentreFctActivation) If m_bImplementerBiaisAutom Then Afficher("Implémentation du biais automatique : poids supplémentaire") Else Afficher("Implémentation du biais automatique désactivée") End If Afficher("Nombre de sorties significatives : " & _ m_prm.iNbSortiesSignif) Afficher("Tolérance à l'erreur : " & m_prm.rToleranceErr) If m_prm.rTauxResultatMinPourcent > 0 Then _ Afficher("Taux de résultat minimum : " & _ m_prm.rTauxResultatMinPourcent & "%") If m_prm.rTauxErreurMax < 1 Then _ Afficher("Taux d'erreur maximal : " & m_prm.rTauxErreurMax) Afficher("Nombre minimum de tentatives : " & m_prm.iNbTentativesMin) Afficher("Nombre maximum de tentatives : " & m_prm.iNbTentativesMax) If m_prm.bNormalisationIndep Then _ Afficher("Normalisation indépendante des entrées et des sorties") Afficher("Fréquence d'affichage des résultats : " & _ m_prm.rFreqAffichagePourcent & "%") Afficher("") Afficher("Légende du graphique :") Afficher("En noir est tracé la fonction d'activation des neurones") Afficher("En bleu est tracé sa dérivée") Afficher("") End Sub Private Sub CalculerResultats(ByRef arEntree!(), ByRef arSortie!(), _ ByRef arCible!(), ByVal sLigneCible$, ByVal iNumLigne%, _ ByRef iNbSucces%, ByVal bApprentissage As Boolean, _ ByVal bModePrediction As Boolean, ByVal bCalculerRes As Boolean, _ ByVal bAfficherRes As Boolean, ByVal bDerniereLigne As Boolean) ' arEntree, arSortie et arCible ne sont pas modifiés Dim i%, sMessage$, rNorm! iNbSucces = 0 For i = 0 To m_var.iNbNeuronesSortie - 1 If Math.Abs(arSortie(i) - arCible(i)) < _ m_prm.rToleranceErr Then iNbSucces += 1 Next i If Not m_prm.bNormalisationIndep Then For i = 0 To m_var.iNbNeuronesSortie - 1 m_var.arEcartSC(i) += Math.Abs(arSortie(i) - arCible(i)) Next i If bAfficherRes Then rNorm = m_var.amplitSortie.rMax - m_var.amplitSortie.rMin sMessage = " C1=" & sFormater(arCible(0) * rNorm + _ m_var.amplitSortie.rMin, m_prm.sFormatSignal) & _ " S1=" & sFormater(arSortie(0) * rNorm + _ m_var.amplitSortie.rMin, m_prm.sFormatSignal) & _ " Ok=" & iNbSucces & "/" & m_var.iNbNeuronesSortie rNorm = m_var.amplitEntree.rMax - m_var.amplitEntree.rMin For i = 0 To m_var.iNbNeuronesEntree - 1 sMessage = sMessage & " E" & i + 1 & "=" & _ sFormater(arEntree(i) * rNorm + _ m_var.amplitEntree.rMin, m_prm.sFormatSignal) ' Affichage des 2 premières entrées seulement If i = 1 And m_var.iNbNeuronesEntree > 2 Then _ sMessage = sMessage & "..." : Exit For Next i sMessage = sMessage & " (" & iNumLigne + 1 & ")" Afficher(sMessage) End If Else ' If m_prm.bNormalisationIndep Then If bAfficherRes Then Afficher("Ligne n°" & iNumLigne + 1 & " :") iNbSucces = 0 For i = 0 To m_var.iNbNeuronesSortie - 1 If Math.Abs(arSortie(i) - arCible(i)) < _ m_prm.rToleranceErr Then iNbSucces += 1 rNorm = m_var.aAmplitSortie(i).rMax - _ m_var.aAmplitSortie(i).rMin m_var.arEcartSC(i) += Math.Abs(arSortie(i) - arCible(i)) Dim sPrecision$ = " à " & sFormater(m_prm.rToleranceErr, "0%") & _ " près = " & sFormater(m_prm.rToleranceErr * rNorm, "0.0") sMessage = " C" & i & "=" & sFormater(arCible(i) * rNorm + _ m_var.aAmplitSortie(i).rMin, m_prm.sFormatSignal) & _ " S" & i & "=" & sFormater(arSortie(i) * rNorm + _ m_var.aAmplitSortie(i).rMin, m_prm.sFormatSignal) & _ " Ok=" & iNbSucces & "/" & i + 1 & sPrecision Afficher(sMessage) Next i sMessage = "" For i = 0 To m_var.iNbNeuronesEntree - 1 rNorm = m_var.aAmplitEntree(i).rMax - _ m_var.aAmplitEntree(i).rMin sMessage = sMessage & " E" & i + 1 & "=" & _ sFormater(arEntree(i) * rNorm + _ m_var.aAmplitEntree(i).rMin, m_prm.sFormatSignal) Next i Afficher(sMessage) End If End If End Sub Private Function rRandomiser!(ByVal rMin!, ByVal rMax!) If rMin = rMax Then rRandomiser = rMin : Exit Function rRandomiser = Rnd() * (rMax - rMin) + rMin End Function Private Function bCalculerResultat(ByVal iIteration%, _ ByVal iMaxIterations%, ByVal rFreq!) As Boolean ' Pour ne calculer les résultats que de temps en temps If rFreq = 0 Then Exit Function bCalculerResultat = True If (iIteration Mod (iMaxIterations / (100 / rFreq)) > 0) Then _ bCalculerResultat = False End Function Private Function bAfficherDegressivement(ByVal iNumLigne%) As Boolean ' Pour afficher de moins en moins de résultats ' si le fichier d'apprentissage est très grand If iNumLigne <= 20 Then bAfficherDegressivement = True ElseIf iNumLigne > 20 And iNumLigne <= 100 Then If iNumLigne Mod 10 = 0 Then bAfficherDegressivement = True ElseIf iNumLigne > 100 Then If iNumLigne Mod 100 = 0 Then bAfficherDegressivement = True End If End Function Private Sub AfficheMsgErreur(ByRef Erreur As Microsoft.VisualBasic.ErrObject, _ ByVal sMsg$, _ Optional ByVal sTitreFct$ = "", _ Optional ByVal sDetailMsgErr$ = "") If Not (Cursor.Current Is Cursors.Default) Then _ Cursor.Current = Cursors.Default If sTitreFct <> "" Then sMsg = "Fonction : " & sTitreFct & vbCrLf & sMsg End If If Erreur.Number > 0 Then sMsg &= vbCrLf & "Err n°" & Str(Erreur.Number) & " :" sMsg &= vbCrLf & Erreur.Description End If If sDetailMsgErr <> "" Then sMsg &= vbCrLf & sDetailMsgErr & vbCrLf End If MsgBox(sMsg, MsgBoxStyle.Critical, m_sTitreMsg) End Sub #End Region End Class ModPerceptron.vb ' Fichier ModPerceptron.vb ' ------------------------ ' Définition des types publics utilisés dans la classe ' ClsPerceptronMultiCouche Option Strict On Option Explicit On Public Enum TFctActivation ' Types de fonction d'activation SigmoideStandard PasUnitaire DoubleSeuil TangenteHyperbolique Gaussienne Identite ' Aucun résultat obtenu End Enum