This program can learn some symbol like alphabet and reconize a symbol writer. If symbol a is learn, and you write a different, He reconize symbol a

Code pour darkBasic Pro

Alors voila, mes petits travaux du mois de janvier
m'ont ammené sur les réseaux neuronaux.
Je vous propose ici un reseau type perceptron.
Si vous présentez des exemple au perceptron,
il sera capable de les apprendres. Si maintenant vous lui
donnée un exemple voisin, il sera capable de l'associer avec ce
qu'il connait (si bien sur le reseau est bien configuré)
Prenons un exemple pour le faire fonctionner.
Dessinez dans paint ou autre une image (en 12 x 15)
Dessinez un a (en noir)
enregistrez le à la racine du programme
faites une nouvelle image (b) puis c puis d
les fichiers auront pour nom a.bmp b.bmp c.bmp d.bmp

Au lancement, notepad se lance (désolé, j'utilise chez moi une dll payante pour les fenetres)
taper dans notepad : (attention aux minuscules/majuscules)

CINOB 0 a.bmp
CINOB 1 b.bmp
CINOB 2 c.bmp
CINOB 3 d.bmp
fin

enregistrez sous _console_.txt à la racine du prog
CINOB veut dire Charge Image Noir Ou blanc
Donc on vient de charger a.bmp dans le layer 0
b.bmp dans le layer 1 ...
Maintenant, on va créer le reseau
retourner dans notepad
effacez tout
tapez

CRBack 0 180 8 10 4 sigmoide
MPA 0 0.6
graphe 3
CONR 0 254 0
fin

faites control+S (ou sauvegarde)
Le programme travail un certain temps
Une fois terminé, si vous clicker sur oreille droite,
vous pouvez vous deplacer autour du reseau (avec fleches et maintient bouton droit).
les petits neurones sont les neurones d'entrées. Les neurones de sortie sont bleus
Plus le bleu est brillant, plus il est proche de la valeur 1.
Pour cet exemple, la lettre a attendra comme resultat 1 0 0 0
le b : 0 1 0 0
le c : 0 0 1 0
le d : 0 0 0 1

Les fils sont les liaisons. Les liaisons d'entree sont simplement representé par un fil bleu (de travers... oup's)
CRBack veut dire Creer reseau backpropagation
0 est le numero du reseau
180 c'est tous simplement 12 x 15
6 c'est le nombre de neurones d'entrée
8 neurones cachés
4 neurone de sortie. Ce chiffre doit etre égale au nombre de lettre que vous voulez lui
faire apprendre...
sigmoide c'est la fonction de transfert
MPA veut dire Modifier Pas Apprentissage
0 est le n° du reseau
0.6 est la valeur du pas
graphe 3 pour tracer l'erreur du reseau. le rouge est l'erreur moyenne
CONR c'est CONsulte Reseau.
0 : n° du reseau
254 c'est le n° du stimulis (laisser tjs à 254)
et 0 c'est notre layer a
On peut voir que les sortie sont toute éclairées à peut pres pareilles

Il ne nous reste plus qu'a lui faire apprendre les lettres
retour dans notepad
on efface tout

APPR 280 0 0 254
fin

control+S pour sauver
APPR comme apprendre
280 c'est le nombre de fois (70 fois 4 layer)
0 c'est le numero du reseau
0 pour une presentation ordonee
(-1 pour dire que l'on veut une presentation aléatoire des layers)
254 c'est le stimulis

Maintenant, le reseau apprend. Ca peut etre tres long (qq minutes)
Une fois terminé,
aller dans notepad, effacer tout puis ecrivez

CONR 0 254 0
fin

Le reseau repond correctement. Le neurone de sortie n°1 correspond au layer 0
Le neurone est plus éclairé que les autres
essayez

CONR 0 254 1
fin

puis

CONR 0 254 2
fin

CONR 0 254 3
fin

voila, le reseau fait la difference entre a b c et d

Il peut être modifier selon le nombre de chose à apprendre.
Pour ceux qui ne connaissent pas du tout les neurones,
RDV dans le turorial de Newbieone Kenooby volet 1 (dans le forum)

Pour ce perceptron, la fonction de transfert des neurones est une fonction
sigmoide (ou logistique). Elle renvoie une valeur comprise entre -1 et 1
Les poids sont répartis au depart aléatoirement entre -1 et 1 (mais ils peuvent prendre toutes valeurs)

Vous pouvez essayer de modifier le pas d'apprentissage et observer sur la barre d'erreur ce qui se passe
Essayer -1 à la place de 0 dans APPR, la presentation des layers sera aléatoire. Il y a des inconvenients
mais aussi des avantages
Ne vous fiez pas trop au graphe avec -1 dans l'apprentissage
Le programme n'a aucun parachute. En clair, une commande mal renseignée fera sans doute planter le programme...

?
fin

pour l'aide

Si le programme n'arrive plus a se lancer, effacer _console_.txt
je n'ai pas terminé cette partie
et bien d'autres encore
Si vous faites des améliorations à ce programme, merci de les poster sur
ce forum, pour faire avancer le schmilblik

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    ` --------------------------------------------------- 
`  Janvier 2007 
`   Auteur : Yoann CURE 
`  Licence : Libre 
`  Des questions          : yoanncure@gmail.com 
`   ou modifications interessantes 

set window on 
set window size 800,600 
set window title "Schmilblik" 
` -------   Pour tracer en 3D   ------- 
`Tableau des objets des entrees des neurones 
` Le neurone 1 correspond à l'objet 1 
` Mais les entrées sont stocké de 65000 à 65000-entree 
type matr 
   neurone as integer 
   entree as integer 
endtype 
dim objet_entree(0) as matr 

type glo 
    x as float 
    y as float 
    z as float 
    cax as float 
    cay as float 
    nb_objet 
endtype 
locale as glo 
global vitesse_deplacement# 
vitesse_deplacement#=6.0  ` Vitesse de déplacement dans la 3D 
locale.nb_objet=65000   ` indice des objets -entree- Ne pas toucher 



` -------   Pour tracer les graphiques   ------- 
` Les variables à renseigner 
global G_X as integer       ` position X 
global G_Y as integer       ` position Y 
global G_TX as integer      ` Taille X 
global G_TY as integer      ` Taille Y 
global nb_graphe as integer ` Nombre de graphiques simultanés -1<nb_graphe <4 
G_X=10 
G_Y=10 
G_TX=200 
G_TY=100 
nb_graphe=0 

dim G_rouge(G_TX) as float 
global G_r as integer       ` Indice dans G_Rouge 
global Rmaxvar as float     ` Variation maximum dans G_rouge 
dim G_vert(G_TX) as float 
global G_v as integer 
global Vmaxvar as float 
dim G_bleu(G_TX) as float 
global G_b as integer       ` Indice dans G_Rouge 
global Bmaxvar as float     ` Variation maximum dans G_rouge 
dim G_blanc(G_TX) as float 
global G_bl as integer 
global BLmaxvar as float 
inc G_r 
inc G_v 
inc G_b 
inc G_bl 
Rmaxvar=0.0      ` Valeur supposée max (pas obligatoire) 


` -------   Analyse phrasé   ------- 
dim nieme_mot(100) as string 
global indice_nieme=0 

`console 
dim console(0) as string 

global Limit_p=100 `N'est pas utilile dans le cas du perceptron 
` MEMBLOCK DU SYSTEM =255,254 
` 255 pour gestion futur des neurones ou gestion image 
` 254 pour interface utilisateur (retine/stimulis) 



`Layer correspond au signe à lui faire apprendre. 
` 
global layer=100    `heu ça je sais plus pourquoi mais faut le laisser 
global nb_boolean=200 ` Taille max du tableau (12*15) 
global limit_poid as float  `Inutile pour l'instant 
limit_poid=0.9 


dim stimulis(layer,nb_boolean) as boolean 
type stimulus 
   chaine_dossier as string 
   fichier as string 
   type as string 
   type2 as integer 
   xg as integer 
   yg as integer 
   Resultat_espere as string  ` resultat sur plusieurs neurone 
endtype 

`Tableau pour typer les stimulis 
dim sti(layer) as stimulus 
sti(0).chaine_dossier="Stimuli/Visuel/bol5x5" ` Inutil pour l'instant 
sti(0).fichier="+"   ` Inutil pour l'instant 

`ne sert pas pour l'instant 
sti(0).type="boolean" 
sti(0).type2=0       

global pointeur_layer ` la ou en est la lecture du signal 
` Indice_layer = nb_de stimulis (ou d'exemple) en mémoire 
global indice_layer as integer 





` TABLEAU POUR DESSINER ou transformer UN STIMULIS 
dim Grille(20,20) 
global xg 
global yg 
xg=5 
yg=5 
global xy 
xy=xg*yg 



`tableau stockant le neurone correspondant au memblock. Non utilisé pour l'instant 
` MB(1)=no neurone 
dim MB(256) as integer 

` Liste des neurones créés le plus recement 
` list_MB(0)= le memblock le plus recement créé 
dim list_MB(255) as integer 

type neuro 
   KP as integer ` memblock Stock poid et lien entree/sortie 
   sortie as float ` Memorise la valeur de la sortie 
   nb_entree as integer ` 
   fonction as string ` Fonction de transfert 
   Erreur as float 
   S as integer ` Si le neurone est une sortie (personne n'a d'entrée connecté à lui) 
   indice_entree as integer ` pointe vers le tableau des objet_entree 3D 
endtype 

Global Limite_P as float  ` Limite de la valeur du poid 
Limite_P=1                 ` Utilisation d'entrées binaires 
dim Neurone(0) as neuro 
`neurone vide doit exister mais doit rester vide 
rem array insert at bottom neurone(0) 


`Creation du tableau reseau 
type link 
   forme as integer 
   nb_neurone as integer 
   sortie as integer  ` renvoi le neurone de sortie le plus concerné 
   nb_sortie as integer 
   pas_apprentissage as float 
   Sorties_adaptees 
endtype 
`forme=1  --> backprop 
dim reseau(10) as link 
global nb_reseau as integer 
`création du tableau pour ordonner l'ordre de consultation et d'apprentissage 
dim ordre(10,3,255) as integer 

`POUR LE WORDPAD 
global f_console as string 
f_console="_console_.txt" 
`--------------------------------------------------------------------------- 
`                           Boucle principale 
`--------------------------------------------------------------------------- 
init_console() 
do 
    
   deplace_camera() 
   evenement_console() 
    
loop 

function init_console() 
   rem if file exist(f_console) then delete file f_console 
   execute file "notepad.exe","",get dir$() 
endfunction 

function evenement_console() 
   if file exist(f_console) 
      auto(f_console) 
      delete file f_console 
   endif 
endfunction 
  



` --------------------------------------------------------------- 
`                           TOOLS 
` --------------------------------------------------------------- 
`Outils pour creer, modifier reseau/neurone... 

function console2(commande$) 
   backdrop off 
   nb_et=extraire_mot(commande$,"&") 
   dim ET(nb_et) as string 
   for i=0 to nb_et-1 
      ET(i)=nieme_mot(i) 
   next i 
    
   while no_et<nb_et 
      nb_mot=extraire_mot(ET(no_et)," ") 
       
      if lower$(nieme_mot(0))="rem" then exitfunction 
      remstart 
      for i=1 to indice_nieme 
         Cprint(0,nieme_mot(i),0) 
      next i 
      remend 
       
      select indice_nieme 
         case 1 
             
            if commande$="debug" 
               if file open(32) then close file 32 
               if file open(31) then close file 31 
            endif 
            if commande$="auto" then auto("_tempo_lk") 
            if commande$="cmd" then auto("test") 
            if commande$="FSV" then Fabrique_stimulis_visuel(0) 
               if commande$="?" 
               print "CN F$:Créer un neurone avec F$ en fonction de transfert" 
               print "CE N :Ajouter une entrée au neurone N" 
               print "CL N E S :Créer un lien entre entree et neurone." 
               print "    N doit etre ici le neurone de l'entrer à connecter" 
               print "    E, le n° de l'entrée et S le n° du neurone dont la sortie est connectee à cet entree" 
               print "---   Commande lecture   ---" 
               print " " 
               print "FSV L :Fabriquer Stimulis Visuel no L" 
               print "DG n :Dessiner la grille(layer) n° n" 
               print " " 
               print "APPR nb_fois reso layer St:Fais apprendre le réseau des impulsions St. si layer=-1 --> aleatoire" 
               print " "                
               print "CONR reso St Layer : Consulte le reseau " 
               print "réseau ---------------------------" 
               print "CRBack no nb_entree_sti nb_neurone_entree nb_neurone_cache nb_neurone sortie fonction$" 
               print "         Crée un réseau perceptron" 
               print "VR reso : Ecrit dans reso.txt les connection est poid de tout" 
               print "SS fichier : Sauvegarde tous les stimulis" 
               print "CS fichier : Charge tous les stimulis du fichier" 
               print "IR reso mode$: réinitialise les poid du reseau. mode$=rnd alors aléatoire sinon 0.0" 
               print "3D reso : Donne une representation 3D de reso" 
               print "MPA reso valeur(float) : modifie la valeur du pas d'apprentissage du reseau. default:0.1" 
               print "graphe n : n=-1 pas de graphe temps réel mais 3D, n=0 graphe rouge n=1 graphe vert ..." 
               print "CINOB layer fichier$ : Charge une image dans un layer" 
               print "quit ou exit :fin programme" 
             
            endif 
         endcase 
          
         case 2 
            if nieme_mot(0)="NS" 
               neurone_est_sortie(val(nieme_mot(1))) 
            endif 
            if lower$(nieme_mot(0))="graphe" 
               nb_graphe=val(nieme_mot(1)) 
            endif 
            if nieme_mot(0)="3D" 
                representation_reseau(val(nieme_mot(1))) 
            endif 
            if nieme_mot(0)="SS" 
                sauvegarder_stimulis(nieme_mot(1)) 
            endif 
            if nieme_mot(0)="CS" 
                charger_stimulis(nieme_mot(1)) 
            endif 
            if nieme_mot(0)="VR" 
               verifie_reseau(val(nieme_mot(1))) 
            endif 
            if nieme_mot(0)="FSV" then fabrique_stimulis_visuel(val(nieme_mot(1))) 
            if nieme_mot(0)="DG" then reciproque_transformer_stimulis_visuel(val(nieme_mot(1))):dessiner_grille(20,5) 
            if nieme_mot(0)="CN" then print add_neurone(nieme_mot(1)) 
            if nieme_mot(0)="CE" 
               N$=nieme_mot(1) 
               N=val(N$) 
               add_entree(N) 
            endif 
         endcase 
          
         case 3 
            if nieme_mot(0)="CINOB" 
               charger_image_N_ou_B(val(nieme_mot(1)),nieme_mot(2)) 
            endif 
            if nieme_mot(0)="IR" then reset_reseau(val(nieme_mot(1)),nieme_mot(2)) 
            if nieme_mot(0)="MPA" then change_pas_apprentissage(val(nieme_mot(1)),val(nieme_mot(2)))    
         endcase 
         case 4 
            if nieme_mot(0)="CONR" 
               Consulte_reseau(val(nieme_mot(1)),val(nieme_mot(2)),val(nieme_mot(3))) 
            endif 
            if nieme_mot(0)="CL" 
               Creer_lien(val(nieme_mot(1)) ,val(nieme_mot(2)) ,val(nieme_mot(3))) 
               Cprint(0,"Lien crée",0) 
            endif 
            if nieme_mot(0)="RL" 
               N$=nieme_mot(1) 
               N=val(N$) 
               if N=0 then CPrint(0,"Vous devez specifier un numéro de neurone.",6) :exitfunction 
               a$=nieme_mot(2) 
               a=val(a$) 
               b$=nieme_mot(3) 
               b=val(b$) 
            endif 
         endcase 
         case 5 
            if nieme_mot(0)="APPR" 
               apprendre(val(nieme_mot(1)),val(nieme_mot(2)),val(nieme_mot(3)),val(nieme_mot(4))) 
            endif 
         endcase 
         case 7 
            if nieme_mot(0)="CRBack"    
                Creer_reseau_backprop(val(nieme_mot(1)),val(nieme_mot(2)),val(nieme_mot(3)),val(nieme_mot(4)),val(nieme_mot(5)),nieme_mot(6)) 
                console2("auto") 
            endif 
         endcase 
      endselect 
      inc no_et 
   endwhile 
endfunction 

`Fonction automatique de commande 
function auto(file$) 
   free=free_file():open to read free,file$ 
   read string free,commande$ 
   cls 
   set cursor 250,0 
   Cprint(0,"Commande :"+commande$,6) 
   while commande$<>"fin" 
      console2(commande$) 
      read string free,commande$ 
      Cprint(0,"Commande :"+commande$,6) 
   endwhile 
   close file free 
endfunction 

`Renvoi un fichier libre 
function free_file() 
   for i=1 to 32 
      if file open(i)=0 then exitfunction i 
   next i 
endfunction i 

function CPrint(a as float,phrase$,mode) 
   select mode 
        case 6 
            lon=len(phrase$) 
          for i=1 to lon 
             a$=mid$(phrase$,i) 
             if a$="#" 
                   p$=left$(phrase$,i-1)+" : "+str$(a)+" " 
                   if i<lon then phrase$=p$+right$(p$,lon-i-1) : else : phrase$=p$ 
                i=lon 
             endif 
          next i 
          CPrint_Console(phrase$) 
        endcase 
   endselect 
   `Pour debugguer sur fichier 
    remstart 
   case 7 
            if file open(31)=0 
             if file exist("debug.txt") then delete file "debug.txt" 
             open to write 31,"debug.txt" 
          endif 
          lon=len(phrase$) 
          for i=1 to lon 
             a$=mid$(phrase$,i) 
             if a$="#" 
                   p$=left$(phrase$,i-1)+" : "+str$(a)+" " 
                   if i<lon then phrase$=p$+right$(p$,lon-i-1) : else : phrase$=p$ 
                i=lon 
             endif 
          next i 
          write string 31,phrase$ 
        endcase 
        remend 
endfunction 

function CPrint_Console(phrase$) 
   backdrop off 
   ink rgb(255,255,255),rgb(0,0,0) 
   if array count(console(0))<15 
      array insert at bottom console(0) 
   else 
      array delete element console(0),0 
      array insert at bottom console(0) 
   endif 
   console(array count(console(0)))=phrase$ 
   cls 
   set cursor 0,250 
   for i=0 to array count(console(0)) 
      print console(i) 
   next i 
    
endfunction 
function Extraire_mot(phrase$,separateur$) 
    `Enleve les separateurs en mettant les mots dans un tableau 
    `Nieme(nieme mot) 
   indice_nieme=0 
    
   lon=len(phrase$) 
   ancien_espace=0 
   for i=1 to lon 
      a$=mid$(phrase$,i) 
      if a$=separateur$ 
         nieme_mot(indice_nieme)=mids(phrase$,ancien_espace+1,i-ancien_espace-1) 
         inc indice_nieme 
         ancien_espace=i 
      endif 
   next i 
   nieme_mot(indice_nieme)=right$(phrase$,len(phrase$)-ancien_espace) 
   inc indice_nieme 
endfunction indice_nieme 

` Fonction mid$ pour version 6 
function mids(s$ as string ,indice as integer,longueur as integer) 
    if s$="" then exitfunction "" 
    long=len(s$) 
    s$=right$(s$,long-indice+1) 
    long=len(s$) 
    s$=left$(s$,longueur) 
endfunction s$ 

`Fonction pas belle pour dessiner ma grille 
function dessiner_grille(taille_carre,espacement) 
   backdrop off 
   cls 
   for i=0 to xg 
      for j=0 to yg 
         if grille(i,j)=0 
            box i*taille_carre+espacement,j*taille_carre+espacement,i*taille_carre+taille_carre,j*taille_carre+taille_carre,rgb(0,0,0),rgb(0,0,0),rgb(0,0,0),rgb(128,128,128) 
         else 
            box i*taille_carre+espacement,j*taille_carre+espacement,i*taille_carre+taille_carre,j*taille_carre+taille_carre,rgb(255,255,255),rgb(255,255,0),rgb(0,0,0),rgb(255,255,255) 
         endif 
      next j 
   next i 
    
endfunction 

` Fonction pas belle pour dessiner dans ma grille 
function dessiner_dans_grille(taille_carre,espacement) 
   backdrop off 
   dessiner_grille(taille_carre,espacement) 
   while spacekey()=0 
      mc=mouseclick() 
      if mc>0 
         mx=mousex() : my=mousey() 
         for i=0 to xg 
            for j=0 to yg 
               left=i*taille_carre+espacement 
               top=j*taille_carre+espacement 
               right=i*taille_carre+taille_carre 
               bottom=j*taille_carre+taille_carre 
               if mx>left 
                  if mx<right 
                     if my>top 
                        if my<bottom 
                           if mc=2 
                              grille(i,j)=0 
                              box i*taille_carre+espacement,j*taille_carre+espacement,i*taille_carre+taille_carre,j*taille_carre+taille_carre,rgb(0,0,0),rgb(0,0,0),rgb(0,0,0),rgb(128,128,128) 
                           else 
                              grille(i,j)=1 
                              box i*taille_carre+espacement,j*taille_carre+espacement,i*taille_carre+taille_carre,j*taille_carre+taille_carre,rgb(255,255,255),rgb(255,255,0),rgb(0,0,0),rgb(255,255,255) 
                           endif 
                           wait 50 
                        endif 
                     endif 
                  endif 
               endif 
            next j 
         next i 
      endif 
   endwhile 
endfunction 


` ------------------------------------------------------------------------ 
`                               NEURONES 
` ------------------------------------------------------------------------ 

FUNCTION Consulte_Neurone(N,layer,St) 
     `N = Neurone 
      
     ` On ne modifie rien dans le neurone. On le consulte 
      
     `` Ici, si le neurone n'est pas ouvert,on l'ouvre 
     `completement sans utiliser de MB temporaire 
     valeur as float 
     Somme as float 
     entree as integer 
     poid as float 
     sortie as float 
      
  
     `Le n° du MB est dans Liste_MB(0) 
     for i=1 to neurone(N).nb_entree 
        poid = Lit_poid(N, i) 
        entree = lit_liaison(N,i) 
        if entree=St 
           valeur = stimulis(layer,pointeur_layer) 
           inc pointeur_layer 
        else 
           valeur=neurone(entree).sortie 
        endif 
        Somme = Somme + valeur * Poid 
     next i 
     ` Ici, ca depend de la fonction de Transfert 
     `du neurone. 
     Sortie = _H(N,somme) 
     CPrint(sortie,"Sortie #",4) 
     neurone(N).sortie=Sortie 
ENDFUNCTION Sortie 

` FONCTION DE TRANSFERT 
` Cette fonction est appelée logistique. 
function _H(N,sortie as float) 
      sortie=1.0/(1.0+exp(-sortie)) 
endfunction sortie 

function add_neurone(f_Transfert$ as string) 
   `lien et ensuite poid 
   `Taille de la memoire : 1+ 1float+1dword par entree 
   array insert at bottom neurone(0) 
   no=array count(neurone(0)) 
   fm=free_memblock() 
   MB(fm)=no 
   array insert at top List_MB(0) 
   array delete element List_MB(255) 
   List_MB(0)=fm 
   make memblock List_MB(0),1 
   neurone(no).Fonction=f_Transfert$ 
   neurone(no).Erreur=0.5 
endfunction no 

function detruire_tout() 
   `Pas opérationnelle 
   for i=0 to 255 
      List_MB(i)=0 
   next i 
   for i=1 to 252 
      if memblock exist(i) then delete memblock i 
   next i 
   for i=1 to 65000 
      if object exist(i) then delete object i 
   next i 
endfunction 

function Add_Entree(N) 
   `Ajoute une entrée au neurone N 
   rn as float 
   nmb=N    
   if nmb>0 
      make memblock 255,get memblock size(N) + 8 + 4 
      copy memblock nmb,255,0,0,get memblock size(N) 
      delete memblock nmb 
      make memblock nmb,get memblock size(255) 
      copy memblock 255,nmb,0,0,get memblock size(255) 
      delete memblock 255 
      neurone(N).nb_entree=neurone(N).nb_entree+1 
      rn=initialise_poid("rnd") 
      Ecrit_poid(nmb,neurone(N).nb_entree,rn) 
   else 
      CPrint(0,"Le neurone "+str$(N)+" doit être ouvert pour ajouter une entrée !",6) 
   endif    
endfunction 

function initialise_poid(mode$) 
    ` Initialise un poid 
    rn as float 
    if mode$="rnd" 
        rn=rnd(100) 
        rn=rn/100 
        if rnd(1)=1 then rn=-rn 
    else 
        rn=0.0 
    endif 
endfunction rn 

Function Creer_Lien(N ,entree , sortieNP as integer) 
   ` Crée un lien entre une entree existante et un neurone existant 
   write memblock dword N , (entree-1)*4+8*entree+1, sortieNP 
endfunction 

    
function ecrit_poid(N, entree , poid as float) 
   ` Ecrit le poid correspondant à l'entree du neurone 
   write memblock float N , (entree-1)*(8+4)+1, Poid    
endfunction 

function lit_poid(N, entree) 
   ` Renvoi le poid de l'entree du neurone 
   poid as float 
   poid=memblock float(N , (entree-1)*(8+4)+1) 
endfunction poid 


function lit_liaison(N, entree) 
   `Renvoi le neurone connecté à l'entré 
      liaison as integer 
      liaison=memblock dword(N ,(entree-1)*4+8*entree+1) 
endfunction liaison 

function neurone_est_sortie(N) 
   neurone(N).S=1 
endfunction 

function cherche_entree(N,Ne) 
   `recherche l'entrée connectée à Ne 
   for i=1 to neurone(N).nb_entree 
      if lit_liaison(N,i)=Ne then exitfunction i 
   next i 
endfunction 0 

function free_memblock() 
   `Retourne -1 si tous les memblocks sont utilisés 
   `Sinon no_memblock 
   for i=1 to 252 
      if memblock exist(i)=0 then exitfunction i 
   next i 
endfunction -1 

`  -----------------------  NEURONE 3D  -------------------------- 
function representation_reseau(reso) 
    couche=0 
   N=0 
   Erreur as float 

   while couche<3 
      while ordre(reso,couche,N)>0 
         select couche 
            case 0 `couche entree 
                    make object sphere ordre(reso,couche,N),50 
                    position object ordre(reso,couche,N),X0,0,couche*300 
                    Erreur=neurone(ordre(reso,couche,N)).erreur 
                    inc X0,300 
                    dec locale.nb_objet 
                    Line3D(locale.nb_objet, object position x(ordre(reso,couche,N)),object position y(ordre(reso,couche,N)),object position z(ordre(reso,couche,N)),object position x(ordre(reso,couche,N))-300,object position y(ordre(reso,couche,N)),object position z(ordre(reso,couche,N))-300 , rgb(10,128,255)) 
                     neurone(ordre(reso,couche,N)).indice_entree=locale.nb_objet 
               endcase 
            case default 
               make object sphere ordre(reso,couche,N),100 
               position object ordre(reso,couche,N),X0,0,couche*300 
               Erreur=neurone(ordre(reso,couche,N)).erreur 
               NC=couche-1 
               NN=0 
               neurone(ordre(reso,couche,N)).indice_entree=locale.nb_objet-1 
                
               while ordre(reso,NC,NN)>-1 
                  dec locale.nb_objet 
                  Line3D(locale.nb_objet, object position x(ordre(reso,couche,N)),object position y(ordre(reso,couche,N)),object position z(ordre(reso,couche,N)), object position x(ordre(reso,NC,NN)),object position y(ordre(reso,NC,NN)),object position z(ordre(reso,NC,NN)), rgb(255,255,255)) 
                  inc NN 
               endwhile 
                    inc X0,300 
            endcase 
         endselect 
         inc N 
      endwhile 
      N=0 
      inc couche 
      X0=0 
   endwhile 
   sync 
endfunction 
  
FUNCTION Line3D(Num_Objet, X1,Y1,Z1, X2,Y2,Z2, RGBValue) 
  make object triangle Num_Objet, X1,Y1,Z1,X1,Y1,Z1, X2,Y2,Z2 
  SET OBJECT WIREFRAME Num_Objet,1 
  set object ambient Num_Objet,0 
  SET OBJECT EMISSIVE Num_Objet, RGBValue 
ENDFUNCTION 
  


function deplace_camera() 
    
   if mouseclick()=2 
   backdrop on 
      
      mmx=mousemovex() 
      mmy=mousemovey() 
      

      while mouseclick()=2 
        

         mmx=mousemovex() 
         mmy=mousemovey() 
         ocay#=locale.cay 
          ocax#=locale.cax 
          locale.cay=wrapvalue(locale.cay+mmx*0.2) 
          locale.cax=wrapvalue(locale.cax+mmy*0.2) 
          if upkey()=1 
             locale.x=newxvalue(locale.x,wrapvalue(locale.cay),vitesse_deplacement#) 
             locale.z=newzvalue(locale.z,wrapvalue(locale.cay),vitesse_deplacement#) 
             locale.y=newyvalue(locale.y,locale.cax,vitesse_deplacement#) 
             position camera locale.x,locale.y,locale.z 
          endif 
          if downkey()=1 
             locale.x=newxvalue(locale.x,wrapvalue(locale.cay-180),vitesse_deplacement#) 
             locale.z=newzvalue(locale.z,wrapvalue(locale.cay-180),vitesse_deplacement#) 
             locale.y=newyvalue(locale.y,wrapvalue(locale.cax-180),vitesse_deplacement#) 
             position camera locale.x,locale.y,locale.z 
          endif 
          a#=curveangle(locale.cay,ocay#,100) 
          b#=curveangle(locale.cax,ocax#,100) 
         yrotate camera a# 
         xrotate camera b# 
          sync 
      endwhile 
     Trace_graphique() 
   endif 
endfunction 




` ------------------------------------------------------------------------------------------ 
`                                   STIMULIS 
` ------------------------------------------------------------------------------------------ 


function Fabrique_stimulis_visuel(layer) 
   backdrop off 
   print "Type de stimulis : Visuel" 
   input "Taille de la grille en X :",xg 
   input "Taille de la grille en Y :",yg 
   dec xg 
   dec yg 
   dessiner_dans_grille(20,5) 
   transformer_stimulis_visuel(layer) 
   wait 150 
   input "Resultat attendu ?",a$ 
   sti(layer).Resultat_espere=a$ 
   backdrop on 
endfunction 

function transformer_stimulis_visuel(layer) 
   Cprint(0,"Transformation du stimulis...",0) 
   for i=0 to xg 
      for j=0 to yg 
         stimulis(layer,k)=grille(i,j) 
         inc k 
      next j 
   next i 
   if sti(layer).type2=0 then inc indice_layer 
   sti(layer).type2=k-1 
   sti(layer).xg=xg 
   sti(layer).yg=yg 
endfunction 

function reciproque_transformer_stimulis_visuel(layer) 

   xg=sti(layer).xg 
   yg=sti(layer).yg 
   k=0 
   for i=0 to xg 
      for j=0 to yg 
         grille(i,j)=stimulis(layer,k) 
         inc k 
      next j 
   next i 
endfunction 

function sauvegarder_stimulis(fichier$) 
    free=free_file() 
    if file exist(fichier$) then delete file fichier$ 
    open to write free,fichier$ 
    write string free,str$(indice_layer) 
    for i=0 to indice_layer-1 
        write string free,sti(i).chaine_dossier 
        write string free,sti(i).fichier 
        write string free,sti(i).type 
        write string free,str$(sti(i).type2) 
        write string free,str$(sti(i).xg) 
        write string free,str$(sti(i).yg) 
        write string free,sti(i).Resultat_espere 
        for a=0 to sti(i).type2 
            write string free,str$(stimulis(i,a)) 
        next a 
    next i 
    write string free,"fin" 
    close file free 
    CPrint(0,"Stimulis sauvés",6) 
endfunction 

function charger_stimulis(fichier$) 
    free=free_file() 
    if file exist(fichier$)=0 then CPrint(0,"Le fichier n'existe pas !",6):exitfunction 
    open to read free,fichier$ 
    read string free,b$ 
    indice_layer=val(b$) 
    for i=0 to indice_layer-1 
        read string free,sti(i).chaine_dossier 
        read string free,sti(i).fichier 
        read string free,sti(i).type 
        read string free,b$ 
        sti(i).type2=val(b$) 
        read string free,b$ 
        sti(i).xg=val(b$) 
        read string free,b$ 
        sti(i).yg=val(b$) 
        read string free,sti(i).Resultat_espere 
        CPrint(0,"RE "+sti(i).resultat_espere,0) 
        for a=0 to sti(i).type2 
            read string free,b$ 
            stimulis(i,a)=val(b$) 
        next a 
    next i 
    close file free 
endfunction 

function charger_image_N_ou_B(layer,fichier$) 
   `Les fichiers images seront chargés et traité en tant que stimulis 
   `Ici, on modifie l'image pour quelle n'est que des 0 ou 1 
   if file exist(fichier$)=0 then CPrint(0,"Le fichier n'existe pas !",6) : exitfunction 
   load bitmap fichier$,1 
   if memblock exist(255) then delete memblock 255 
   ` On fabrique un memblock pour extraire les couleurs 
   make memblock from bitmap 255,1 
   largeur=bitmap width(1)-1 
   hauteur=bitmap height(1)-1 
   for i=0 to largeur 
      for j=0 to hauteur 
         couleur=Couleur_Pixel(255, i, j) 
         couleur=int((rgbr(couleur)+rgbg(couleur)+rgbb(couleur))/3) 
         if couleur>127 
            couleur=0 
         else 
            couleur=1 
         endif 
         grille(i,j)=couleur 
      next j 
   next i 
   delete bitmap 1 
   delete memblock 255 
   xg=largeur 
   yg=hauteur 
   transformer_stimulis_visuel(layer) 
   CPrint(0,"Image transformee en stimulis.",6) 
   if nb_reseau>0 then adaptation_sortie(reso)    `Pour adapter le nombre de chose à apprendre avec le reseau 
endfunction 

Function Couleur_Pixel(nMB, x, y)   `Merci au messieur qui a fait cette fonction, simple, efficace. 
   Largeur_Image = MemBlock DWord(nMB,0) 
   Position = 12 + (4 * ((y * Largeur_Image) + x)) 
   Sortie = MemBlock DWord(nMB, Position) 
EndFunction Sortie 



` ------------------------------------------------------------------------------------------ 
`                                       RESEAU 
` ------------------------------------------------------------------------------------------ 

 ` Fonctions relatives a la creation d'ensemble de neurones 
` types de reseaux 
` Backpropagation : Toutes les entrées du stimulis sont 
`                     reliés à chaque entrée de chaque neurone 
`                     Si l'on prend 010 equivalent à + 
`                                  111 
`                                  010 
`                    Ce qui fait 010111010  
`                    on choisit le nombre de neurone d'entrée 
`                    chaque neurone aura donc 9 entrées donc 9 poids 
`                    Ce qui nous fait deja 81. 
`                    ensuite on fabrique une couche intermédiaire de neurone 
`                    appelé couche caché 
`                    puis une derniere couche avec 1 neurone par caractere à apprendre 
`                    Et biensure toute les entrées de chaque neurone sont reliés à toute les sorties 
`                    des neurone de la couche caché 
`             Consultation: on consulte normalement chaque neurone d'entrée H(poid * entrée) 
            `               On mettra ici une fonction sigmoide c'est a dire Sortie=1/(1+exp(-la phrase du dessus)))))) 
`             Pour l'apprentissage, on calcul l'erreur de la derniere couche (on connait les valeurs qu'elles doivent prendre) 
`            pour les propager selon le poid de l'entree reliant chaque neurone de la couche précedente . 
`             






function Creer_reseau_backprop(no,nb_entree,nb_neurone_entree,nb_neurone_cache,nb_neurone_sortie,fonction$) 
   ` Fonction permettant la création d'un fichier reseau backdrop 
    
   inc nb_reseau 
   if file exist("_tempo_lk")=1 then delete file "_tempo_lk" 
   free=free_file():open to write free,"_tempo_lk" 
   write string free,"rem Création des neurones d'entrée" 
   for i=1 to nb_neurone_entree 
      write string free,"CN "+fonction$ 
   next i 
   write string free,"rem Création des entrées et des liens" 
   for a=1 to nb_neurone_entree 
      for i=1 to nb_entree 
         write string free,"CE "+str$(a) 
         write string free,"CL "+str$(a)+" "+str$(i)+" 254" 
      next i 
   next a 
   write string free,"rem -------------------" 
   write string free,"rem    Couche cachée" 
   for i=1 to nb_neurone_cache 
      write string free,"CN "+fonction$ 
   next i 
   write string free,"rem Création des entrées" 
   for a=nb_neurone_entree+1 to nb_neurone_entree+nb_neurone_cache 
      for i=1 to nb_neurone_entree 
         write string free,"CE "+str$(a) 
         write string free,"CL "+str$(a)+" "+str$(i)+" "+str$(i) 
      next i 
   next a 
   write string free,"rem -------------------" 
   write string free,"rem  Couche de sortie" 
   for i=1 to nb_neurone_sortie 
      write string free,"CN "+fonction$ 
   next i 
   write string free,"rem Création des entrées" 
   for a=nb_neurone_entree+nb_neurone_cache+1 to nb_neurone_entree+nb_neurone_cache+nb_neurone_sortie 
      write string free,"NS "+str$(a) 
      for i=1 to nb_neurone_cache 
         write string free,"CE "+str$(a) 
         write string free,"CL "+str$(a)+" "+str$(i)+" "+str$(nb_neurone_entree+i) 
      next i 
   next a 
   write string free,"rem stipule que l'ordre du reseau est sauvé dans ordre" 
   write string free,"Ordre" 
   write string free,"REM pour avoir une representation 3D du reseau" 
   write string free,"3D 0" 
   write string free,"fin" 
   close file free 
    
   if file exist("ordre") then delete file "ordre" 
   open to write free,"Ordre" 
   ind=0 
   for i=1 to nb_neurone_entree 
      ordre(no,0,ind)=i 
      inc ind 
      write string free,str$(i) 
   next i 
   write string free,"-1" 
   ordre(no,0,ind)=-1 
   ind=0 
   for i=nb_neurone_entree+1 to nb_neurone_entree+nb_neurone_cache 
      ordre(no,1,ind)=i 
      inc ind 
      write string free,str$(i) 
   next i 
   write string free,"-1" 
   ordre(no,1,ind)=-1 
   ind=0 
   for i=nb_neurone_entree+nb_neurone_cache+1 to nb_neurone_entree+nb_neurone_cache+nb_neurone_sortie 
      ordre(no,2,ind)=i 
      inc ind 
      write string free,str$(i) 
   next i 
   ordre(no,2,ind)=-1 
   write string free,"fin" 

   close file free 
   reseau(no).nb_neurone=nb_neurone_entree+nb_neurone_cache+nb_neurone_sortie+2 ` +2 car on met des 0 a chaque couche 
   reseau(no).forme=1 
   reseau(no).pas_apprentissage=0.1 
   reseau(no).nb_sortie=nb_neurone_sortie 
endfunction 

` Fonction généraliste prenant en compte la forme du reseau 
function Consulte_reseau(reso,Sti,layer) 
   select reseau(reso).forme 
      case 1 : Consulte_RBack(reso,Sti,layer) : endcase 
   endselect 
endfunction 

`COnsultation propre au RBack 
function Consulte_RBack(reso,Sti,layer) 
    
   sortie as float 
   couche=0 
   N=0 
   while couche<3 
      select ordre(reso,couche,N) 
         case -1 
            inc couche 
            N=-1 
         endcase 
         case default 
            pointeur_layer=0 
            sortie=consulte_neurone(ordre(reso,couche,N),layer,Sti) 
         endcase 
      endselect 
      inc N 
   endwhile 
   ` On ecrit les sorties dans la console 
   couche=2 
   N=0 
   while ordre(reso,couche,N)>-1 
      Cprint(ordre(reso,couche,N),"Neurone #",6) 
      CPrint(neurone(ordre(reso,couche,N)).sortie,"Valeur #",6) 
      inc N 
   endwhile 
   ` On ecrit dans la 3D 
   for i=1 to array count(neurone(0)) 
      if neurone(i).S=0 
         SET object emissive i,rgb(0,255*neurone(i).Sortie,0) 
      else 
         SET object emissive i,rgb(0,0,255*neurone(i).Sortie) 
      endif 
   next i 
   sync 
endfunction 
    

function verifie_reseau(reso) 
   if file exist("Reseau.txt") then delete file "Reseau.txt" 
    free=free_file():open to write free,"Reseau.txt" 
   couche=0 
   N=0 
   poid as float 
   while couche<3 
      while ordre(reso,couche,N)>-1 
         write string free,"Neurone "+str$(ordre(reso,couche,N)) 
         for i=1 to neurone(ordre(reso,couche,N)).nb_entree 
            write string free,"Entree "+str$(i) 
            ll=lit_liaison(ordre(reso,couche,N),i) 
            write string free,"Reliée à "+str$(ll) 
            Poid = lit_poid(ordre(reso,couche,N),i) 
            write string free,"Poid = "+str$(poid) 
         next i 
         inc N 
      endwhile 
      N=0 
      inc couche 
   endwhile 
   close file free 
endfunction 
    
` ------------------------------------------------- 
`                      APPRENTISSAGE 
` ------------------------------------------------- 
function apprendre(nb_fois,reso,layer,Sti) 
   if reseau(reso).forme=1 then apprendre_back(nb_fois,reso,layer,Sti) 
endfunction 

`fonction d'apprentissage par backpropagation 
function apprendre_back(nb_fois,reso,layer,Sti) 
    
   if reseau(reso).sorties_adaptees=0 then adaptation_sortie(reso) 
    
   if layer=-1 then layer=rnd(indice_layer-1):ly=-1 
    
   poid as float 
   ll as integer 
   Erreur as float 
   sortie as float 
   TOTAL_ERREUR as float 

   `Extraction des résultats à obtenir 
   `A modifier plus tard, lent... 
   nb_mot=extraire_mot(sti(layer).resultat_espere," ") 
   dim result_espere(indice_layer,nb_mot+1) as float 
   for i=0 to indice_layer-1 
      nb_mot=extraire_mot(sti(i).resultat_espere," ") 
      for m=0 to nb_mot 
         result_espere(i,m)=val(nieme_mot(m)) 
      next m 
   next i 

   ` S'il y a 6 stimulis a différencier, 6 tours=1 apprentissage complet 
   for nbf=1 to nb_fois    
       
      `CONSULTATION DU RESEAU 
      couche=0 
      N=0 
      while couche<3 
         select ordre(reso,couche,N) 
            case -1 
               inc couche 
               N=-1 
            endcase 
            case default 
               pointeur_layer=0 
               sortie=consulte_neurone(ordre(reso,couche,N),layer,Sti) 
               pointeur_layer=0 
            endcase 
         endselect 
         inc N 
      endwhile 
       
       
      ` Boucle de propagation de l'erreur 
      ` On démarre de la couche de sortie pour comparer 
      ` ce que l'on doit avoir et ce que l'on a. 
      couche=2 
      N=0 
      while couche>-1 
         select ordre(reso,couche,N) 

            case -1 
               dec couche 
               N=-1 
            endcase 

            case default 
               select couche 

                  case 2 ` couche de sortie 
                     Erreur = (result_espere(layer,N) - neurone(ordre(reso,couche,N)).Sortie) 
                     Erreur = Erreur /(2*(1+Hcos(neurone(ordre(reso,couche,N)).Sortie))) 
                     Ajoute_graphique(N+1,Erreur) 
                     TOTAL_ERREUR=TOTAL_ERREUR+abs(Erreur) 
                     Neurone(ordre(reso,couche,N)).Erreur=Erreur 
                  endcase 
                   
                  case 1 ` Couche cachée 
                     ` On regarde le poid des entrees des neurones de sortie 
                     ` Que l'on multiplie par son erreur(du neurone de sortie) 
                     ` On fait la somme de tous ça 
                     NC=2 
                     NN=0 
                     Erreur = 0 
                     while ordre(reso,NC,NN)>-1 
                        entree=cherche_entree(ordre(reso,NC,NN),ordre(reso,couche,N)) 
                        Erreur = Erreur + neurone(ordre(reso,NC,NN)).erreur*lit_poid(ordre(reso,NC,NN),Entree) 
                        inc NN 
                     endwhile 
                     ` On applique la dérivé de H sur l'erreur 
                     Erreur = Erreur /(2*(1+Hcos(neurone(ordre(reso,couche,N)).Sortie))) 
                     neurone(ordre(reso,couche,N)).Erreur=Erreur 
                  endcase 
                   
                  case 0 `Couche d'entrée 
                     ` Identique à l'autre couche. elle est séparée pour améliortion ulterieure 
                     NC=1 
                     NN=0 
                     Erreur = 0 
                     while ordre(reso,NC,NN)>-1 
                        entree=cherche_entree(ordre(reso,NC,NN),ordre(reso,couche,N)) 
                        Erreur = Erreur +neurone(ordre(reso,NC,NN)).erreur*lit_poid(ordre(reso,NC,NN),Entree) 
                        inc NN 
                     endwhile 
                     ` On applique la dérivé de H sur l'erreur 
                     Erreur  = Erreur /(2*(1+Hcos(neurone(ordre(reso,couche,N)).Sortie))) 
                     neurone(ordre(reso,couche,N)).Erreur=Erreur 
                  endcase 
               endselect 
            endcase 
         endselect 
         inc N 
      endwhile 
       
      `Modification des poids 
      `formule : poidNi=poidNi+pa_app*erreurNi*sortie_du neurone avant 
      ` Ni est le poid du neurone en question 
      ` pa_app est le pas d'apprentissage 
      ` Sortie du neurone avant c'est le neurone relié à l'entrée du neurone en question 
      couche=0 
      N=0 
      while couche<3 
         while ordre(reso,couche,N)>0 
            select couche 
               case 0 `couche entree car neurone avant=stimulis 
                  for i=1 to neurone(ordre(reso,couche,N)).nb_entree 
                     poid=lit_poid(ordre(reso,couche,N),i) 
                     poid=poid+reseau(reso).pas_apprentissage*neurone(ordre(reso,couche,N)).erreur*stimulis(layer,i-1) 
                     ecrit_poid(ordre(reso,couche,N),i,poid) 
                  next i 
               endcase 
               case default 
                  for i=1 to neurone(ordre(reso,couche,N)).nb_entree 
                     poid=lit_poid(ordre(reso,couche,N),i) 
                     ll=lit_liaison(ordre(reso,couche,N),i) 
                     poid=poid+reseau(reso).pas_apprentissage*neurone(ordre(reso,couche,N)).erreur*neurone(ll).Sortie 
                     ecrit_poid(ordre(reso,couche,N),i,poid) 
                  next i 
               endcase 
            endselect 
            inc N 
         endwhile 
         N=0 
         inc couche 
      endwhile 
      if ly=-1 
         layer=rnd(indice_layer) 
      else 
         inc layer 
      endif 
      if layer=indice_layer 
         layer=0 
         Ajoute_graphique(0,TOTAL_ERREUR) 
         ` on met a jour la sortie sur la 3D 
         if nb_graphe=-1 
            for i=1 to array count(neurone(0)) 
                 if neurone(i).S>0 
                    erreur=abs(neurone(i).Erreur) 
                  SET OBJECT EMISSIVE i,rgb(255*erreur,255*(1-erreur),0) 
                 else 
                    SET object emissive i,rgb(255*(1-neurone(i).Sortie),255*neurone(i).Sortie,255*(1-neurone(i).Sortie)) 
               endif 
            next i 
            sync 
        else 
            `Ou bien l'erreur sur le graphe 
            Trace_graphique() 
        endif 
        TOTAL_ERREUR=0.0 
      endif 
   next nbf 
   Trace_graphique() 
   CPrint(0,"Apprentissage terminé",6) 
endfunction 

`Remet les poids à rnd ou zero 
function reset_reseau(reso,mode$) 
   couche=0 
   N=0 
   while couche<3 
      while ordre(reso,couche,N)>0 
            for i=1 to neurone(ordre(reso,couche,N)).nb_entree 
                ecrit_poid(ordre(reso,couche,N),i,initialise_poid(mode$)) 
            next i 
            inc N 
      endwhile 
      N=0 
      inc couche 
   endwhile 
   CPrint(reso,"Initialisation du reseau #",6) 
endfunction 

function adaptation_sortie(reso) 
   `Fonction inscrivant le resultat espere dans sti 
   `Par exemple, si on a 4 lettre à lui faire apprendre, il faut 4 sorties 
   ` Il stocke dons dans sti de la lettre a : 1 0 0 0 
   `Dans sti de la lettre b : 0 1 0 0 
    
   if indice_layer<>reseau(reso).nb_sortie 
       CPrint(0,"Incompatibilité du nombre de stimulis",6) 
      exitfunction 
   endif 
   dim sortie(reseau(reso).nb_sortie) as string 
   for i=0 to reseau(reso).nb_sortie 
      for a=0 to reseau(reso).nb_sortie 
         if i<>a 
            sortie(a)=sortie(a)+"0 " 
         endif 
      next a 
      sortie(i)=sortie(i)+"1 " 
   next i 
    
   for i=0 to indice_layer-1 
      sti(i).resultat_espere=left$(sortie(i),len(sortie(i))-1) 
   next i 
   reseau(reso).sorties_adaptees=1 
   CPrint(0,"Adaptation du reseau terminée",6) 
   undim sortie(0) 
endfunction 

function change_pas_apprentissage(reso,pas as float) 
   reseau(reso).pas_apprentissage=pas 
endfunction 
  
  
  
  
`--------------------------------------------------------------------------- 
`                          TRACE DES GRAPHIQUES 
`--------------------------------------------------------------------------- 



` Fonction permettant de tracer des graphiques d'une variable quelquonque 
` Elle s'adapte en X et en Y 
` Par contre, vous perdez la linéarité d'une fonction mathématique lorsque vous dépassez G_TX valeurs. 
` Attention quand meme, cette fonction est gourmande et ralentit bcp le programme 
` Mais elle peut être très utile pour débuguer un programme 
` Par exemple, vous voulez connaitre la valeur que prend tableau a chaque modification de tableau 
` Vous avez juste à faire dans l'editeur, remplace 
` remplace : tableau=           par    Trace_graphique(0,tableau)  : tableau=    
` Mais attention, dans ce cas, vous tracer la valeur precedente... 
` Ou simplement le mettre manuellement dans le code ex: tableau=x  à remplacer par tableau=x:Trace_graphique(0,tableau) 


function Ajoute_graphique(couleur as integer,valeur as float) 
     rem if couleur=-1 then exitfunction 
        ` Couleur représente la no de la courbe 
        ` couleur=0 --> rouge 
        ` couleur=1 --> vert 
        ` couleur=2 --> bleu 
        ` couleur=3 --> blanc 
        `si vous tracer un seul graphique (nb_graphe=0) dans ce cas, si vous mettez couleur=1 alors le graphique ne sera pas tracé 
        ` mais la valeur sera quand meme enregistré 
        ` Valeur est tous simplement la valeur à ajouter au graphe(couleur) 
    
    select couleur 
        case 0 
             if G_r=G_TX then compresse_rouge() 
            G_rouge(G_r)=valeur 
             inc G_r 
             if abs(valeur)>Rmaxvar then Rmaxvar=abs(valeur) 
        endcase 
        case 1 
             if G_v=G_TX then compresse_vert() 
            G_vert(G_v)=valeur 
             inc G_v 
             if abs(valeur)>Vmaxvar then Vmaxvar=abs(valeur) 
        endcase 
        case 2 
             if G_b=G_TX then compresse_bleu() 
            G_bleu(G_b)=valeur 
             inc G_b 
             if abs(valeur)>Bmaxvar then Bmaxvar=abs(valeur) 
        endcase 
        case 3 
             if G_bl=G_TX then compresse_blanc() 
            G_blanc(G_bl)=valeur 
             inc G_bl 
             if abs(valeur)>BLmaxvar then BLmaxvar=abs(valeur) 
        endcase 
    endselect 
endfunction 
function Trace_graphique()    
    Backdrop off 
    cls 
    ink rgb(255,255,255),rgb(0,0,0) 
    line G_x,G_y,G_x+G_Tx,G_y 
    line G_x,G_y,G_x,G_y+G_Ty 
    line G_x+G_Tx,G_y,G_x+G_Tx,G_x+G_Ty 
    line G_x,G_y+G_Ty,G_x+G_Tx,G_y+G_Ty 
    
    
    GT as integer 
    GT1 as float 
    GT2 as float 
    GT3 as float 
    GT4 as float 
    GT=(G_TY+G_Y) 
    GT1=G_Ty/Rmaxvar 
    GT2=G_Ty/Vmaxvar 
    GT3=G_Ty/Bmaxvar 
    GT4=G_Ty/BLmaxvar 
    
    ` On dessine le graphe rouge 
    ink rgb(255,126,126),rgb(0,0,0) 
    line G_X+1,GT,G_X+G_Tx,GT 
    ink rgb(255,0,0),rgb(0,0,0) 
    for i=1 to G_Tx 
        if G_rouge(i)>0 
            y=G_rouge(i)*GT1 
            dot G_X+i,GT-y 
        else  `Cas d'un valeur négative: A VERIFIER 
            y=G_rouge(i)*GT1+G_TY 
            dot G_X+i,GT-y 
        endif 
    next i 
        
    if nb_graphe>0 
        `On dessine le graphe vert 
        ink rgb(0,255,0),rgb(0,0,0) 
        for i=1 to G_Tx 
            if G_vert(i)>0 
                y=G_vert(i)*GT2 
                dot G_X+i,GT-y 
            else 
                y=G_vert(i)*GT2+G_TY 
                dot G_X+i,GT-y 
            endif 
        next i 
        if nb_graphe>1 
            `On dessine le graphe bleu 
            ink rgb(0,0,255),rgb(0,0,0) 
            for i=1 to G_Tx 
                if G_bleu(i)>0 
                    y=G_bleu(i)*GT3 
                    dot G_X+i,GT-y 
                else 
                    y=G_bleu(i)*GT3+G_TY 
                    dot G_X+i,GT-y 
                endif 
            next i 
            if nb_graphe>2 
                `On dessine le graphe blanc 
                ink rgb(255,255,255),rgb(0,0,0) 
                for i=1 to G_Tx 
                    if G_blanc(i)>0 
                        y=G_blanc(i)*GT4 
                        dot G_X+i,GT-y 
                    else 
                        y=G_blanc(i)*GT4+G_TY 
                        dot G_X+i,GT-y 
                    endif 
                next i 
            endif 
        endif    
    endif      
    sync 
endfunction 
function compresse_rouge() 
    for i=0 to G_Tx-2 
        array delete element G_rouge(0),i+1 
        array insert at bottom G_rouge(0) 
    next i    
    G_r=int(G_Tx/2) 
endfunction 
function compresse_vert() 
    for i=0 to G_Tx-2 
        array delete element G_vert(0),i+1 
        array insert at bottom G_vert(0) 
    next i    
    G_v=int(G_Tx/2) 
endfunction 
function compresse_bleu() 
    for i=0 to G_Tx-2 
        array delete element G_bleu(0),i+1 
        array insert at bottom G_bleu(0) 
    next i    
    G_b=int(G_Tx/2) 
endfunction 
function compresse_blanc() 
    for i=0 to G_Tx-2 
        array delete element G_blanc(0),i+1 
        array insert at bottom G_blanc(0) 
    next i    
    G_bl=int(G_Tx/2) 
endfunction