Added upstream from http://ftp.icm.edu.pl/pub/loglan/
[loglan.git] / examples / apply / total / neocogni.log
1 program RESNEURONAL;\r
2 \r
3 (*-------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
4 \r
5 (*-------------------------------------------------  Definition des outils de gestion de l'envirronement graphique --------------------------------------------------*)\r
6 \r
7 unit ekran: iiuwgraph class;\r
8                                 \r
9 \r
10   (* Tracage d'une boite *)                         \r
11   unit box : procedure(x,y,xl,yl,co : integer);\r
12   begin\r
13     call color(co);\r
14     call move(x,y);\r
15     call draw(x+xl,y);\r
16     call draw(x+xl,y+yl);\r
17     call draw(x,y+yl);\r
18     call draw(x,y);\r
19   end box; \r
20     \r
21 \r
22 \r
23   (* Impression des coefficients non nuls d'une matrice (n*n) *)   \r
24   unit circles_in_box : procedure( invers_img,x,y,n:integer , boite :mat );\r
25     var i,j : integer;\r
26         \r
27   begin\r
28     \r
29     for i:=1 to n do\r
30       for j:=1 to n do \r
31         \r
32         (* teste le mode d'impression ("inverse motif" ou non) *)\r
33         if (invers_img=1) then\r
34           if (boite.tab(j,i)=/=0) then call color(1)\r
35           else call color(0) fi\r
36         else \r
37           if (boite.tab(j,i)=/=0) then call color(0)\r
38           else call color(1) fi\r
39         fi;              \r
40 \r
41         call cirb(x+(i-1)*10,y+(j-1)*10,5,0,0,0,1,1,1);\r
42         call cirb(x+(i-1)*10+1,y+(j-1)*10+1,4,0,0,0,1,1,1); \r
43         call cirb(x+(i-1)*10+2,y+(j-1)*10+2,3,0,0,0,1,1,1);\r
44         call cirb(x+(i-1)*10+3,y+(j-1)*10+3,2,0,0,0,1,1,1);\r
45         call cirb(x+(i-1)*10+4,y+(j-1)*10+4,1,0,0,0,1,1,1)\r
46         \r
47       od\r
48     od\r
49 \r
50   end circles_in_box;\r
51 \r
52 \r
53   \r
54   (* Tracage d'un graphique a partir d'une matrice de reels donnee a une echelle donnee *)\r
55   unit graphique : procedure( tab_don:arrayof integer , posx,posy:integer ,\r
56                               val_initx,pasx, val_inity,pasy:real ,\r
57                               leg_absc,leg_ord : string  );\r
58     var i,j,transl,nouvelx,nouvely : integer;\r
59   begin\r
60     (* Trace des axes *)\r
61     call move(posx,posy); call draw(posx,posy-150);\r
62     call move(posx,posy); call draw(posx+400,posy);\r
63     call move(posx,posy-150); call draw(posx+5,posy-140); \r
64     call move(posx,posy-150); call draw(posx-5,posy-140);\r
65     call move(posx+400,posy); call draw(posx+390,posy-5);\r
66     call move(posx+400,posy); call draw(posx+390,posy+5);\r
67     call grstrwrite(posx+410,posy,leg_absc);\r
68     call grstrwrite(posx,posy-160,leg_ord);    \r
69 \r
70 \r
71     (* Impression du pas *)\r
72     nouvelx:=posx;nouvely:=posy;\r
73     j:=upper(tab_don)-lower(tab_don); transl:=0;\r
74     for i:=0 to j do\r
75       call grintwrite(1,posx+i*(400 DIV j),posy+20,val_inity+i*pasy);\r
76       call grintwrite(1,posx-20,posy-i*(150 DIV j),val_initx+i*pasx);\r
77       call move(nouvelx,nouvely);\r
78       call draw(posx+i*(400 DIV j),posy-tab_don(i+1)*(150 DIV j));\r
79       nouvelx:=posx+i*(400 DIV j); nouvely:=posy-tab_don(i+1)*(150 DIV j);\r
80       transl:=tab_don(i+1)\r
81     od\r
82   end graphique;\r
83 \r
84 \r
85 \r
86 \r
87 \r
88   (* Ecriture d'un texte *)        \r
89   unit grstrwrite : procedure( x,y : real , s:string);\r
90     var a:arrayof char, i:integer;\r
91   begin\r
92     call move(x,y);  \r
93     a:=unpack(s);\r
94     for i:=lower(a) to upper(a) do  call HASCII(ORD(a(i)))  od; \r
95   end grstrwrite ;\r
96 \r
97 \r
98   (* Ecriture d'un reel quelconque < 10  *)\r
99   unit grintwrite : procedure( co,x,y:integer , nbe:real );\r
100     var i,j:integer;\r
101   begin\r
102     call color(co);\r
103     \r
104     (* On rend d'abord le reel entier *)\r
105     j:=nbe*1000; \r
106 \r
107     (* Puis on l'affiche en (x,y) *)\r
108     for i:=0 to 4 do\r
109      call move(x-i*8,y);\r
110      if i=3 then call HASCII(ORD('.'))\r
111       else call HASCII(j MOD 10 +48) ; j:=j DIV 10 fi\r
112     od \r
113   end grintwrite;\r
114 \r
115 \r
116 \r
117 \r
118   (* Saisie a la souris des formes proposees par l'utilisateur *)         \r
119   unit souris:mouse procedure;\r
120     var b,h,hs,hg,v,vs,vg,p,i,j,val:integer,l,r,c,ecrire,gommer: boolean;\r
121   begin\r
122     val:=1; ecrire:=false; gommer:=false;\r
123 \r
124     call box(117,87,196,208,1);\r
125     call grstrwrite(175,285,"F I G U R E");\r
126     call box(119,89,192,192,1);\r
127     call showcursor;\r
128     call box(400,125,140,100,1);\r
129     call grstrwrite(425,210,"S O U R I S");\r
130     call box(403,128,134,75,1);\r
131     call grstrwrite(410,140,"BOUTON 1: LEVE");\r
132     call grstrwrite(410,160,"BOUTON 2: STYLO");\r
133     call grstrwrite(410,180,"BOUTON 3: FIN ");\r
134                           \r
135     do\r
136                             \r
137       call status(h,v,l,r,c);\r
138       if not(ecrire) then call move(h,v) fi;\r
139       if ecrire then \r
140          j:=entier((h-130) DIV 10)+1;i:=entier((v-100) DIV 10)+1;\r
141          hg:=(j*10)+125;vg:=(i*10)+95;  \r
142          if (hg>=135 and hg<=295 and vg>=105 and vg<=265) then\r
143             forme.tab(i+1,j+1):=val;\r
144             call cirb(hg-5,vg-5,5,0,0,0,1,1,1);\r
145             call cirb(hg-4,vg-4,4,0,0,0,1,1,1); \r
146             call cirb(hg-3,vg-3,3,0,0,0,1,1,1);\r
147             call cirb(hg-2,vg-2,2,0,0,0,1,1,1);\r
148             call cirb(hg-1,vg-1,1,0,0,0,1,1,1)\r
149          fi                    \r
150       fi;\r
151 \r
152       hs:=inxpos;vs:=inypos;\r
153       call getpress(0,h,v,p,l,r,c);\r
154       if p=1 then \r
155         ecrire:=not(ecrire);\r
156         if ecrire then\r
157            call color(0); \r
158            call grstrwrite(410,140,"BOUTON 1: LEVE");\r
159            call color(1);\r
160            call grstrwrite(410,140,"BOUTON 1: BAISSE")\r
161         else  \r
162             call color(0);\r
163             call grstrwrite(410,140,"BOUTON 1: BAISSE");\r
164             call color(1);\r
165             call grstrwrite(410,140,"BOUTON 1: LEVE")                  \r
166         fi;\r
167         if gommer then call color(0) fi\r
168       fi;\r
169       call move(hs,vs); \r
170                           \r
171       hs:=inxpos;vs:=inypos;\r
172       call getpress(2,h,v,p,l,r,c);\r
173       if p=1 then \r
174          gommer:=not(gommer);\r
175          if gommer then\r
176             val:=0;\r
177             call color(0);\r
178             call grstrwrite(410,160,"BOUTON 2: STYLO");\r
179             call color(1);\r
180             call grstrwrite(410,160,"BOUTON 2: GOMME");\r
181             call color(0)  \r
182          else\r
183             val:=1;  \r
184             call color(0);\r
185             call grstrwrite(410,160,"BOUTON 2: GOMME");\r
186             call color(1);\r
187             call grstrwrite(410,160,"BOUTON 2: STYLO");\r
188             call color(1)\r
189          fi\r
190       fi; \r
191       call move(hs,vs);\r
192 \r
193       call getpress(1,h,v,p,l,r,c);\r
194       if p=1 then exit fi\r
195     od\r
196 \r
197   end souris;\r
198 \r
199   \r
200   unit introduction : mouse procedure;\r
201     var f:file,\r
202         i,j,hg,vg,p,h,v:integer,\r
203         l,r,c : boolean,\r
204         figure:arrayof arrayof integer;\r
205   begin\r
206     array figure dim (1:35);\r
207     for i:=1 to 35 do array figure(i) dim (1:72) od;\r
208 \r
209     open(f,integer,unpack("PRESENTATION"));\r
210     call reset(f);\r
211     for i:=1 to 35 do for j:=1 to 72 do          \r
212        get(f,figure(i,j)) \r
213     od od;                                          \r
214     kill(f);\r
215        \r
216     call cls;\r
217     call color(1);\r
218     for j:=1 to 72 do  for i:=1 to 35 do \r
219       call move(360,30); \r
220       hg:=((j-1)*10)+5;vg:=((i-1)*10)+5;  \r
221       if figure(i,j)=1 then             \r
222         call draw(hg-1,vg-1); call draw(hg+1,vg-1);\r
223         call draw(hg+1,vg+1); call draw(hg-1,vg+1);\r
224         call draw(hg-1,vg-1); call draw(hg,vg);\r
225 \r
226         call cirb(hg-5,vg-5,5,0,0,0,1,1,1);\r
227         call cirb(hg-4,vg-4,4,0,0,0,1,1,1);\r
228         call cirb(hg-3,vg-3,3,0,0,0,1,1,1);\r
229         call cirb(hg-2,vg-2,2,0,0,0,1,1,1);\r
230         call cirb(hg-1,vg-1,1,0,0,0,1,1,1);\r
231       fi           \r
232     od  od;       \r
233     call grstrwrite(110,40,"TOTAL  Jaimie");\r
234     call grstrwrite(520,40,"SAINT-JEAN  Patrick");\r
235     call grstrwrite(335,310,"CLIQUER");    \r
236     call box(300,300,120,30,1);\r
237       \r
238     do\r
239        call getpress(0,h,v,p,l,r,c);\r
240        if p=1 then exit fi;\r
241        call getpress(1,h,v,p,l,r,c);\r
242        if p=1 then exit fi;\r
243        call getpress(2,h,v,p,l,r,c);\r
244        if p=1 then exit fi;\r
245     od\r
246 \r
247   end introduction;\r
248 \r
249 \r
250 \r
251 \r
252 \r
253   unit presentation : procedure;\r
254   begin  \r
255     call cls;\r
256     call box(40,20,600,60,1);\r
257     call box(42,22,596,56,1);\r
258     call box(17,5,646,340,1);\r
259     call box(20,8,640,295,1);\r
260     call box(20,312,480,30,1);\r
261     call grstrwrite(155,325,"R E S E A U     N E U R O N A L");\r
262     call box(502,312,158,30,1); \r
263     call grstrwrite(567,318,"TOTAL");\r
264     call grstrwrite(542,330,"SAINT - JEAN")\r
265   end presentation;\r
266 \r
267 \r
268 \r
269   unit parties : procedure ( s:string );\r
270   begin\r
271     call cls;\r
272     call box(200,140,320,68,1);  call grstrwrite(286,173,s);\r
273     for i:=1 to 50000 do od;\r
274   end;\r
275 \r
276 \r
277 \r
278   unit affichage : procedure ( num : integer );\r
279     var i,j:integer;\r
280   begin\r
281     case num \r
282       when 1 :\r
283       (* Presentation graphique de l'apprentissage : *)\r
284       call presentation;\r
285       call grstrwrite(135,45,"APPRENTISSAGE DES MOTIFS DE LA PREMIERE COUCHE");\r
286       call box(40,260,600,20,1);\r
287       call grstrwrite(185,267,"niveau d'apprentissage de chaque motif");\r
288 \r
289       (* Affichage du 1er motif *)\r
290       call box(55,200,20,40,1); call box(49,129,32,32,1);\r
291       call circles_in_box(1,50,130,3,motif(1))\r
292 \r
293 \r
294 \r
295       when 2 :\r
296       for i:=1 to 25000 do od;\r
297       call presentation;\r
298       call grstrwrite(120,45,\r
299       "FIN DE L'APPRENTISSAGE DES MOTIFS DE LA PREMIERE COUCHE");\r
300       call grstrwrite(100,180,\r
301       "Le reseau est a meme de reconnaitre l'ensemble de ces motifs");\r
302 \r
303       for i:=1 to 100000 do od;\r
304 \r
305 \r
306 \r
307       when 3 :\r
308       call presentation;\r
309       call grstrwrite(225,45,"CONTROLE DES CONNAISSANCES");\r
310   \r
311 \r
312 \r
313       when 4:\r
314       (* Affichage des formes saisis   *)    \r
315       call box(220,105,220,20,1);\r
316       call grstrwrite(240,112,"FORME A RECONNAITRE ...");\r
317       call box(324,129,32,32,1);        \r
318       call circles_in_box(1,325,130,3,motif(1));\r
319       call box(180,170,310,20,1);\r
320       call grstrwrite(200,176,"... PARMIS LES FORMES PRESENTEES");\r
321       call box(100,250,410,20,1);\r
322       call grstrwrite(120,256,"... AVEC UN COEFFICIENT DE SELECTIVITE DE :");\r
323       call box(520,250,50,20,1);\r
324      \r
325       for i:=1 to 9 do \r
326         (* Affichage des motifs *) \r
327         call box(65*i-1,199,32,32,1);\r
328         call circles_in_box(1,65*i,200,3,formes_test(i))\r
329       od;     \r
330 \r
331       for i:=1 to 15000 do od\r
332 \r
333 \r
334 \r
335       when 5:\r
336       call grintwrite(1,560,256,k_selectivite);\r
337       for i:=1 to 4 do\r
338         call box(518,248,54,24,1);call box(519,249,52,22,1);\r
339         for k:=1 to 2000 do od;\r
340         call box(518,248,54,24,0);call box(519,249,52,22,0);\r
341         for k:=1 to 2000 do od\r
342       od\r
343 \r
344 \r
345 \r
346       when 7 :\r
347       for i:=1 to 30000 do od;\r
348 \r
349       call presentation;\r
350       call grstrwrite(200,45,"CONCLUSIONS SUR LE TEST");\r
351       call grstrwrite(60,100,\r
352       "  Nous nous  apercevons donc que, plus  le coefficient de selectivite");\r
353       call grstrwrite(60,130,\r
354       "augmente, et moins les formes sont considerees comme proche du modele");\r
355       call grstrwrite(60,160,"presente .");\r
356       call grstrwrite(60,190,\r
357       "De plus, cela permet de supposer que le  NEOCOGNITRON reconnait ( en");\r
358       call grstrwrite(60,220,\r
359       "generalisant  a tous les motifs de l'apprentissage ) des formes pro-");\r
360       call grstrwrite(60,250,"ches des modeles qui lui sont connus .");\r
361       call grstrwrite(60,280,\r
362       "  Choisissons la valeur du coefficient a partir de cette etude ...");\r
363 \r
364       for i:=1 to 300000 do od;\r
365 \r
366       call presentation;\r
367       call grstrwrite(140,45,"VISUALISATION GRAPHIQUE DES RESULTATS DU TEST")\r
368      \r
369 \r
370 \r
371       when 8 :\r
372       (* Impression du graphique *)\r
373       call graphique(tab_result,100,250,0,1,1.125,0.125,"K_SELECTIVITE",\r
374                              "NBE DE FORMES RECONNUES");    \r
375 \r
376       for i:=1 to 150000 do od;\r
377     \r
378       call box(300,100,320,40,1);\r
379       call grstrwrite(340,110,"On choisira un coefficient de:");\r
380       call grstrwrite(340,125,"            2.0");\r
381 \r
382       for i:=1 to 150000 do od\r
383     \r
384 \r
385     \r
386       when 9 :\r
387       call presentation;\r
388       call grstrwrite(180,45,"APPLICATION A UN MOTIF PLUS COMPLEXE");\r
389       for i:=1 to 30000 do od;\r
390 \r
391       call presentation;\r
392       call grstrwrite(200,45,"SAISIE DE LA FORME A LA SOURIS");\r
393       call souris;      \r
394 \r
395       (* Saisie de la visualisation graphique du motif *)\r
396       call move(117,87);tab_graph:=fenetre.getmap(313,295);\r
397 \r
398       (* Recherche des parties proche d'un des motifs connus de la 1ere couche *)\r
399       call presentation;\r
400       call grstrwrite(100,45,\r
401       "RECHERCHE DE CHACUN DES MOTIFS SUR LA FORME PRESENTEE");\r
402     \r
403       (* Mise en place graphique de la forme,du motif cherche sur la forme  et de la matrice de sortie de la 1ere couche *)\r
404       call move(90,87); call putmap(tab_graph);\r
405       call box(400,97,176,188,1); call box(402,99,172,172,1);\r
406       call grstrwrite(442,275,"SORTIE  PLAN");\r
407       call box(303,166,80,60,1); call box(303,236,80,40,1);\r
408       call grstrwrite(318,262,"CHERCHE");\r
409       call grstrwrite(325,245,"MOTIF");\r
410       call move(400,97); tab_graph:=getmap(576,285)   \r
411 \r
412 \r
413      \r
414       when 10 :    \r
415       (* Superposition des 12 plans *)\r
416       call presentation;\r
417       call grstrwrite(50,45,\r
418       "RECAPITULATIF DES SORTIES DES 12 PLANS DE NEURONES DE LA COUCHE");\r
419    \r
420       (* Recapitulatif graphique des sorties de chacun des 12 plans *)\r
421       for i:=1 to 12 do\r
422         call move(225,97);call putmap(res_final(i));\r
423         for j:=1 to 3000  do od; \r
424         call move(225,97);call putmap(tab_graph);             \r
425       od;\r
426 \r
427       for i:=1 to 20000 do od;\r
428 \r
429       call presentation;\r
430       call grstrwrite(100,45,\r
431       "SUPERPOSITION DES 12 PLANS DE SORTIE DE LA PREMIERE COUCHE");\r
432     \r
433       for i:=1 to 15000 do od;\r
434 \r
435       (* Superposition des 12 plans *)    \r
436       for i:=1 to 12 do\r
437         call move(225,97);call ormap(res_final(i));\r
438         for j:=1 to 5000  do od; \r
439       od;\r
440 \r
441       for i:=1 to 50000 do od;   \r
442 \r
443       call presentation;\r
444       call grstrwrite(290,45,"CONCLUSIONS");\r
445       call grstrwrite(250,150,\r
446       "ON OBTIENT BIEN LA FIGURE DONNEE");\r
447       call grstrwrite(200,200,      \r
448       "SEULEMENT A L'AIDE DE CES 12 MOTIFS ELEMENTAIRES");\r
449      \r
450       for i:=1 to 100000 do od\r
451 \r
452 \r
453 \r
454 \r
455     when 11 : call parties("P A R T I E     A")\r
456     when 12 : call parties("P A R T I E     B")     \r
457     when 13 : call parties("P A R T I E     C")\r
458 \r
459     when 14 : call parties("      F I N")\r
460 \r
461     esac\r
462 \r
463   end affichage;\r
464 \r
465 begin\r
466 \r
467   call gron(2);call border(0);call color(1);\r
468 \r
469 \r
470 end ekran;\r
471 \r
472 \r
473 \r
474 \r
475 \r
476 \r
477 \r
478 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
479 \r
480 \r
481 (* Definition d'une matrice (n*n) *)\r
482 unit mat : class (n : integer);\r
483   var tab : arrayof arrayof real,\r
484       i : integer;  \r
485 begin\r
486   array tab dim (1:n);\r
487   for i:=1 to n do array tab(i) dim (1:n) od;\r
488 end mat;\r
489 \r
490 \r
491 \r
492 \r
493 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
494 \r
495 (* Definition du resultat du test presente apres l'apprentissage *)\r
496 unit resultat_test : class;\r
497 \r
498   unit elem2 : class;\r
499     var nb_rec : integer,\r
500         forme : arrayof integer;\r
501    begin\r
502        array forme dim (1:9)\r
503   end elem2;\r
504 \r
505   var i:integer,\r
506       tab : arrayof elem2;\r
507 begin\r
508   array tab dim (1:10);\r
509   for i:=1 to 10 do tab(i):=new elem2 od\r
510 end resultat_test;\r
511 \r
512 \r
513 \r
514 \r
515 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
516 \r
517 \r
518 (* Definition de la premiere couche *)\r
519 unit tabcouche1 : class;\r
520 \r
521   unit elem : class;\r
522     (* Matrice des poids du motif du plan considere *)\r
523     var tpoids1 : mat;\r
524 \r
525     (* Valeur d'inhibition du motif *)\r
526     var poidsinhibe1 : real;\r
527     \r
528     (* Sorties de la premiere couche *)\r
529     var sortie1 : arrayof arrayof integer;\r
530   end elem;\r
531 \r
532    \r
533   (* structure de la table des neurones *)\r
534   var plans1 : arrayof elem;\r
535  \r
536   (* Plans d'inhibition *)\r
537   var distance1 : arrayof mat;\r
538   \r
539   (* Fichier contenant les valeurs de pre-initialisation de la matrice des distances *)\r
540   var i,j: integer,\r
541       c : char;\r
542 \r
543 (* initialisation des differentes tables *)          \r
544 begin\r
545 \r
546 \r
547   (* La 1ere couche est constituee de 12 plans (12 motifs differents) *)\r
548   array plans1 dim (1:12);\r
549 \r
550 \r
551   (* initialisation des elements de la table des plans *)\r
552   for i:=1 to 12\r
553   do\r
554     plans1(i):= new elem;\r
555     (* initialisation de la matrice des poids de chacun des 12 plans *)\r
556     plans1(i).tpoids1 := new mat(3);\r
557     \r
558     (* initialisation de la valeur d'inhibition de chaque plan *)\r
559     plans1(i).poidsinhibe1 := 0;               \r
560     \r
561     (* initialisation de la table des neurones de la couche *)\r
562     array plans1(i).sortie1 dim (1:17); \r
563     for j:=1 to 17 do array plans1(i).sortie1(j) dim (1:17) od;\r
564 \r
565   od;  \r
566 \r
567      \r
568   (* Saisie de la matrice des distances , cette matrice est initialisee une fois pour toute .\r
569      On observe une ponderation decroissante du centre vers l'exterieur. \r
570      La matrice des distance est initialisee a des petites valeurs en la normant *)\r
571 \r
572   distance1 := saisie(1,"D");\r
573   call fenetre.cls;\r
574 \r
575   for i:=1 to 3 do\r
576     for j:=1 to 3 do\r
577       distance1(1).tab(i,j) := distance1(1).tab(i,j)/(2*SQRT(17))\r
578     od\r
579   od\r
580   \r
581    \r
582   \r
583 end tabcouche1;\r
584 \r
585 \r
586 \r
587 \r
588 \r
589 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
590 \r
591 (* Fonction de saisie de fichiers texte .\r
592    Pour simplifier la saisie,le nom du fichier sera arrete a 1 seul caractere \r
593  -----------------------------------------------------------------------------*)\r
594  \r
595 unit saisie : function (tail_tab : integer,nom_fic: string) : arrayof mat;\r
596 \r
597   var f:file,\r
598       i,j,k : integer,\r
599       c : char; \r
600 \r
601 \r
602 begin\r
603 \r
604   (* ouverture du fichier contenant les motifs en lecture *)\r
605   open(f,text,unpack(nom_fic));\r
606   (* Positionnement en debut de fichier *)\r
607   call RESET(f);\r
608 \r
609 \r
610   (* Initialisation du tableau des motifs :\r
611      il y a tail_tab motifs differents ... *)\r
612   array result dim (1:tail_tab);\r
613   (* ... et chaque motif est constitue d'un tableau (3*3) de reels *) \r
614   for k:=1 to tail_tab do result(k):=new mat(3) od;\r
615     \r
616   \r
617 \r
618   (* Remplissage de la table des motifs saisis *) \r
619   for k:=1 to tail_tab do\r
620     for i:=1 to 3 do for j:=1 to 3 do \r
621       read(f,c);result(k).tab(i,j):=ord(c)-48\r
622     od  od\r
623   od;\r
624  \r
625   (* Fermeture fichier *)\r
626   kill(f) \r
627 \r
628 end saisie;\r
629 \r
630 \r
631 \r
632 \r
633 \r
634 \r
635 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
636  \r
637 (* En plus d'initialiser la 1ere couche , cette coroutine effectue l'apprentissage des formes qui doivent etre connues . \r
638  -----------------------------------------------------------------------------------------------------------------------*)\r
639 \r
640 unit ajuste_poids_1 : coroutine(nb_cor:integer);\r
641 \r
642   var i,j,k,t : integer,\r
643       total,som_inhib : real,\r
644       c : char,\r
645 \r
646       cor : ajuste_poids_1;\r
647     \r
648 begin\r
649 \r
650    (* initialisation du poids d'inhibition *)\r
651    som_inhib:=0;\r
652    for i:=1 to 3 do  for j:=1 to 3 do \r
653        som_inhib := som_inhib + (motif(nb_cor).tab(i,j)*couche.distance1(1).tab(i,j))\r
654    od  od;\r
655    som_inhib := SQRT(som_inhib);\r
656 \r
657 \r
658    (* Creation de toutes les coroutines ,1 pour l'apprentissage de chacun des 12 motifs *)\r
659    if nb_cor<12 then\r
660 \r
661      (* Creation de la coroutine d'apprentissage du motif (nb_cor + 1) *)\r
662      cor:=new ajuste_poids_1(nb_cor+1);\r
663 \r
664      (* Affichage des motifs *) \r
665      call fenetre.box(50*(nb_cor+1)+5,200,20,40,1);\r
666      call fenetre.box(50*(nb_cor+1)-1,129,32,32,1);\r
667      call fenetre.circles_in_box(1,50*(nb_cor+1),130,3,motif(nb_cor+1));\r
668 \r
669    fi;\r
670 \r
671    return;\r
672 \r
673    t:=239;\r
674    (* Apprentissage du motif nb_cor *)\r
675    for k:=1 to 200 do\r
676     \r
677      (* Impression physique de la coroutine traitee *)\r
678      call fenetre.box(50*nb_cor-3,127,36,36,1);\r
679      (* Impression du pourcentage d'apprentissage *)\r
680      if (k MOD 5)=0 then        \r
681         call fenetre.move(50*nb_cor+5,t);\r
682         call fenetre.draw(50*nb_cor+25,t);\r
683         t:=t-1\r
684      fi;   \r
685   \r
686      (* On attend la fin de l'execution des coroutines suivantes *)\r
687      if nb_cor<12 then\r
688        attach(cor)\r
689      fi;\r
690 \r
691      (* Renforcement des poids du motif etudie *)\r
692      for i:=1 to 3 do\r
693        for j:=1 to 3 do\r
694          couche.plans1(nb_cor).tpoids1.tab(i,j) := couche.plans1(nb_cor).tpoids1.tab(i,j)\r
695                    + ( k_appr*motif(nb_cor).tab(i,j) * couche.distance1(1).tab(i,j) );\r
696        od\r
697      od;\r
698 \r
699      (* calcul du poids d'inhibition *)\r
700      couche.plans1(nb_cor).poidsinhibe1 := couche.plans1(nb_cor).poidsinhibe1 \r
701                                     + k_appr*som_inhib;\r
702 \r
703      call fenetre.box(50*nb_cor-3,127,36,36,0);\r
704      \r
705      \r
706      detach\r
707  \r
708    od\r
709 \r
710 \r
711 \r
712 end ajuste_poids_1;\r
713 \r
714 \r
715 \r
716 \r
717  \r
718 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
719 \r
720 (* Cette coroutine effectue le traitement de la reconnaissance des motifs\r
721    de la 1ere couche .\r
722    Elle effectue 2 traitements : celui du test de fiabilite de la methode\r
723    sur des formes simples , puis la reconnaissance de formes donnees plus\r
724    complexes .\r
725  -------------------------------------------------------------------------*)\r
726 \r
727 unit filtre : coroutine (num_essai,nb_cor,cor_traite,plan : integer);\r
728  \r
729 \r
730   (* Cette fonction calcule la valeur de sortie d'un neurone de la couche *)\r
731   unit calcul_sortie : function(forme : mat , plan_traite : integer):integer;\r
732     var i,j : integer,\r
733         valeur,som,som_inhib: real;\r
734   begin\r
735 \r
736     som,som_inhib := 0;\r
737     for i:=1 to 3 do    for j:=1 to 3 do\r
738         som:= som + forme.tab(i,j)*couche.plans1(plan_traite).tpoids1.tab(i,j);\r
739         som_inhib := som_inhib + forme.tab(i,j)*couche.distance1(1).tab(i,j)     \r
740     od  od;\r
741     som_inhib := couche.plans1(plan_traite).poidsinhibe1*SQRT(som_inhib);\r
742 \r
743 \r
744     (* Valeur de sortie du neurone considere *)\r
745     valeur := (1 + som)/(1 + k_selectivite/(1 + k_selectivite)*som_inhib) - 1;\r
746 \r
747     if valeur>0 then \r
748       result:=1\r
749     fi    \r
750      \r
751   end calcul_sortie;\r
752    \r
753 \r
754  \r
755   var i1,i2,j1,j2 : integer,\r
756       c : char,\r
757 \r
758       mat_traite,bidon : mat,\r
759       cor : filtre;\r
760 \r
761 begin\r
762   \r
763   (* Creation des filtres correspondant au nombre de plans *)\r
764   if (nb_cor>cor_traite) then\r
765      cor := new filtre(num_essai,nb_cor,cor_traite+1,plan+1);\r
766   fi;\r
767 \r
768   return;\r
769 \r
770 \r
771   if (nb_cor>cor_traite) then attach(cor) fi;\r
772 \r
773   mat_traite := new mat(3);\r
774   if nb_cor=12 then\r
775     (* Formes compliquees *)\r
776 \r
777     (* Affichage du motif recherche sur la forme proposee *)\r
778     call fenetre.box(328,180,32,32,1);\r
779     call fenetre.circles_in_box(1,329,181,3,motif(cor_traite));\r
780     \r
781     (* Creation d'une matrice d'entiers bidon de taille 1 afin d'utiliser la fonction 'circle_in_box' *)\r
782     bidon:=new mat(1);\r
783 \r
784     for i1:=1 to 17 do\r
785       for j1:=1 to 17 do\r
786    \r
787         for i2:=1 to 3 do  for j2:=1 to 3 do\r
788             mat_traite.tab(i2,j2) := forme.tab(i1+i2-1,j1+j2-1) \r
789         od  od;\r
790         \r
791         if calcul_sortie(mat_traite,plan)=1 then\r
792           couche.plans1(plan).sortie1(i1,j1) := 1; bidon.tab(1,1):=1;\r
793           for i2:=1 to 3 do  \r
794             call fenetre.circles_in_box(0,83+(j1*10),80+(i1*10),3,mat_traite);\r
795             call fenetre.circles_in_box(1,83+(j1*10),80+(i1*10),3,mat_traite);\r
796           od;\r
797           call fenetre.circles_in_box(1,393+(j1*10),90+(i1*10),1,bidon)\r
798         fi;      \r
799 \r
800       od\r
801     od;\r
802 \r
803     for i1:=1 to 30000 do od;\r
804 \r
805     (* Sauvegarde graphique de la matrice de sortie du plan traite *)\r
806     call fenetre.move(400,97);res_final(cor_traite):=fenetre.getmap(576,285);        \r
807 \r
808     (* Nettoyage graphique de la matrice de sortie du plan 'cor_traite' *)  \r
809     call fenetre.move(400,97); call fenetre.putmap(tab_graph)\r
810 \r
811   else\r
812 \r
813     (* Formes simples du fichier de test *)\r
814     mat_traite := formes_test(plan);\r
815 \r
816     if calcul_sortie(mat_traite,plan)=1 then\r
817       (* Nombre de formes considerees comme proche du 1er motif (celui presente) par le reseau *)\r
818       resultat.tab(num_essai).nb_rec := resultat.tab(num_essai).nb_rec + 1; \r
819       (* Permet de savoir si la forme nb_cor du jeu de test est consideree comme proche du 1er motif *)\r
820       resultat.tab(num_essai).forme(cor_traite):=1\r
821     fi;\r
822 \r
823   fi;\r
824 \r
825   detach\r
826 \r
827 end filtre;\r
828            \r
829   \r
830        \r
831 \r
832 \r
833 \r
834 \r
835 \r
836 \r
837 (*------------------------------------------------------------------------------------------------------------------------------------------------------------------*)\r
838 \r
839 \r
840   var c : char,\r
841       k_selectivite : real,\r
842       i,j,k,k_appr : integer,\r
843 \r
844       tab_result,tab_graph : arrayof integer,\r
845       res_final : arrayof arrayof integer,\r
846       resultat : resultat_test,\r
847       forme : mat,\r
848       motif,formes_test : arrayof mat,\r
849       apprend : ajuste_poids_1,\r
850       verif,chercher : filtre,\r
851       couche : tabcouche1,\r
852       fenetre : ekran;\r
853  \r
854 \r
855 \r
856 \r
857 \r
858 (*------------------------------------------------------------------  Programme principal ---------------------------------------------------------------------------*)\r
859 \r
860 begin\r
861 \r
862     (* les constantes d'apprentissage et de selectivite des formes sont fixees arbitrairement *)\r
863     k_appr := 10;\r
864 \r
865     write(chr(27),"[2J",chr(27),"[H");\r
866   \r
867     (* ouverture d'une fenetre *)\r
868     fenetre := new ekran;\r
869 \r
870     call fenetre.introduction;\r
871 \r
872     (* Saisie de la table des motifs *)                                                                                                                \r
873     motif := saisie(12,"M");\r
874    \r
875     (* Creation de la premiere couche *)\r
876     couche := new tabcouche1;\r
877 \r
878   \r
879 \r
880  (*------------------------------------------- Phases d'initialisation de la 1ere couche et apprentissage des motifs ---------------------------------------------*)\r
881 \r
882     call fenetre.affichage(11); call fenetre.affichage(1);\r
883      \r
884     apprend := new ajuste_poids_1(1);\r
885     for i:=1 to 200 do attach(apprend) od;\r
886 \r
887     call fenetre.affichage(2);\r
888     \r
889 \r
890   (*------------------------------------------------------------------- Filtrage des formes ----------------------------------------------------------------------*) \r
891 \r
892     (*------------------------------------------- D'abord ,on verifie la methode sur des exemples simples -----------------------------------------------------*) \r
893 \r
894    \r
895     call fenetre.affichage(12); call fenetre.affichage(3);   \r
896   \r
897     (* Saisie du fichier contenant les formes simples *)\r
898     formes_test := saisie(9,"T");\r
899 \r
900     call fenetre.affichage(4);\r
901    \r
902 \r
903     (* Verification de la methode et modulation du coefficient de selectivite,\r
904        afin de montrer que plus le coefficient est important et plus les formes reconnus sont proches du motif recherche  *)    \r
905  \r
906     (* Creation de la matrice des resultats *)\r
907     resultat:=new resultat_test; \r
908 \r
909     for j:=1 to 10 do\r
910       k_selectivite:=1+j/8;\r
911       call fenetre.affichage(5);\r
912       verif := new filtre(j,9,1,1);                 \r
913       attach(verif);\r
914 \r
915       (* Presentation du resultat avec ce coefficient de selectivite   k_selectivite *)\r
916       for i:=1 to 9 do \r
917         if resultat.tab(j).forme(i)=1 then\r
918           call fenetre.box( (65*i)-2,198,34,34,1);\r
919           call fenetre.box( (65*i)-3,197,36,36,1)\r
920         fi\r
921       od;\r
922 \r
923       for i:=1 to 30000 do od;\r
924       call fenetre.grintwrite(0,560,256,k_selectivite);\r
925       for i:=1 to 9 do \r
926         if resultat.tab(j).forme(i)=1 then\r
927           call fenetre.box( (65*i)-2,198,34,34,0);\r
928           call fenetre.box( (65*i)-3,197,36,36,0)\r
929         fi\r
930       od\r
931     od;\r
932 \r
933     call fenetre.affichage(7);    \r
934         \r
935     (* Recuperation des resultats dans une table d'entiers *)\r
936     array tab_result dim(1:10);\r
937     for i:=1 to 10 do \r
938       tab_result(i):=resultat.tab(i).nb_rec;\r
939     od;\r
940 \r
941     call fenetre.affichage(8);\r
942 \r
943 \r
944     (*------------------------------------------------ Application a un motif plus complexe ----------------------------------*)\r
945 \r
946     (* Creation de la  retine *)  \r
947     forme := new mat(19);\r
948     \r
949     call fenetre.affichage(13); call fenetre.affichage(9);\r
950 \r
951     (* Creation matrice des resultats pour affichage final *)\r
952     array res_final dim (1:12);\r
953 \r
954     (* Mise en place de la reconnaissance des 12 motifs dans la forme proposee *)\r
955     chercher := new filtre(1,12,1,1);\r
956   \r
957     k_selectivite := 2;\r
958     attach(chercher);\r
959    \r
960     call fenetre.affichage(10);\r
961 \r
962     call fenetre.affichage(14);\r
963 \r
964     (* Fermeture de la fenetre *)\r
965     call fenetre.groff;\r
966 \r
967 end RESNEURONAL;\r
968 \r
969 \r
970 \r
971 \r
972 \r
973 \r
974 \r
975 \r
976 \r
977 \r
978 \r
979 \r
980 \r
981 \r
982 \r
983 \r
984 \r
985 \r
986 \r
987 \r
988 \r
989 \r
990 \r
991 \r
992 \r
993 \r
994 \r
995 \r
996 \r
997 \r
998 \r
999 \r
1000 \r
1001 \r
1002 \r
1003 \r
1004 \r
1005 \r
1006 \r
1007 \r
1008 \r
1009 \r
1010 \r
1011 \r
1012 \r
1013 \r
1014 \r
1015 \r
1016 \r
1017 \r
1018 \r
1019 \r
1020 \r
1021 \r
1022 \r
1023 \r
1024 \r
1025 \r
1026 \r
1027 \r
1028 \r
1029 \r
1030 \r
1031 \r
1032 \r
1033 \r
1034 \r
1035 \r
1036 \r
1037 \r
1038 \r
1039 \r
1040 \r
1041 \r
1042 \r
1043 \r
1044 \r
1045 \r
1046 \r
1047 \r
1048 \r
1049 \r
1050 \r
1051 \r
1052 \r
1053 \r
1054 \r
1055 \r
1056 \r
1057 \r
1058 \r
1059 \r
1060 \r
1061 \r
1062 \r
1063 \r
1064 \r
1065 \r
1066 \r
1067 \r
1068 \r
1069 \r
1070 \r
1071 \r
1072 \r
1073 \r
1074 \r
1075 \r
1076 \r
1077 \r
1078 \r
1079 \r
1080 \r
1081 \r
1082 \r
1083 \r
1084 \r
1085 \1a