home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Gfx / Kohonen.e < prev    next >
Encoding:
Text File  |  1994-12-02  |  2.7 KB  |  99 lines
  1. /* Kohonen Feature Maps en E, implémenté avec des entiers
  2.  
  3.  
  4. Kohonen feature maps sont des types spéciaux de réseau de neurones, et
  5. cette implémentation montre graphiquement comment ils s'organisent
  6. peu à peu. Veuillez me pardonner mon affichage primitif.
  7.  
  8. */
  9.  
  10. CONST ONE=1024*16, KSHIFT=14, KSIZE=7, MAXTIME=500, DELAY=0
  11. CONST KSTEP=ONE/KSIZE, KNODES=KSIZE+1, ARSIZE=KSIZE*KSIZE
  12. CONST XRED=64, YRED=128, XOFF=10, YOFF=20
  13.  
  14. MODULE 'intuition/intuition'
  15.  
  16. PROC main() HANDLE
  17.   DEF map,t,input,x,y,w=NIL
  18.   IF w:=OpenW(20,11,400,200,$200,$F,'Similation des cartes de Kohonen',0,1,0)
  19.     map:=kohonen_init(KSIZE,KSIZE,2)
  20.     FOR t:=0 TO MAXTIME-1
  21.       input:=[Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  22.       x,y:=kohonen_BMU(map,input)
  23.       kohonen_plot(map,w,x,y)
  24.       kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  25.     ENDFOR
  26.   ELSE
  27.     Raise("WIN")
  28.   ENDIF
  29.   RefreshWindowFrame(w)
  30.   WaitIMessage(w)
  31. EXCEPT DO
  32.   IF exception THEN WriteF('err = \s\n',[exception,0]+1)
  33.   IF w THEN CloseW(w)
  34. ENDPROC
  35.  
  36. PROC kohonen_plot(map,wnd:PTR TO window,bx,by)
  37.   DEF x,y,n:PTR TO LONG,cx,cy,i,ii,
  38.       sx[ARSIZE]:ARRAY OF LONG,sy[ARSIZE]:ARRAY OF LONG
  39.   SetRast(wnd.rport,1)
  40.   FOR x:=0 TO KSIZE-1
  41.     FOR y:=0 TO KSIZE-1
  42.       n:=kohonen_node(map,x,y); i:=x*KSIZE+y; ii:=x-1*KSIZE+y
  43.       sx[i]:=cx:=s(n[0]/XRED+XOFF); sy[i]:=cy:=s(n[1]/YRED+YOFF)
  44.       IF x>0 THEN Line(sx[ii],sy[ii],cx,cy,2)
  45.       IF y>0 THEN Line(sx[i-1],sy[i-1],cx,cy,2)
  46.     ENDFOR
  47.   ENDFOR
  48.   n:=kohonen_node(map,bx,by)
  49.   Plot(s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),2)
  50.   Delay(DELAY)
  51. ENDPROC
  52.  
  53. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  54.  
  55. PROC kohonen_BMU(map,i:PTR TO LONG)
  56.   DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  57.   len:=ListLen(i)-1
  58.   FOR x:=0 TO KSIZE-1
  59.     FOR y:=0 TO KSIZE-1
  60.       n:=kohonen_node(map,x,y)
  61.       act:=0
  62.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  63.       IF act<bestact; bestx:=x; besty:=y; bestact:=act; ENDIF
  64.     ENDFOR
  65.   ENDFOR
  66. ENDPROC bestx,besty
  67.  
  68. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  69.   DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  70.   bell:=[50,49,47,40,25,13,10,8,6,5,4,3,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  71.   len:=ListLen(i)-1
  72.   FOR x:=0 TO KSIZE-1
  73.     FOR y:=0 TO KSIZE-1
  74.       n:=kohonen_node(m,x,y)
  75.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  76.       IF d>0
  77.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  78.       ENDIF
  79.     ENDFOR
  80.   ENDFOR
  81. ENDPROC
  82.  
  83. PROC kohonen_node(map:PTR TO LONG,x,y)
  84.   DEF r:PTR TO LONG
  85.   r:=map[x]
  86. ENDPROC r[y]
  87.  
  88. PROC kohonen_init(numx,numy,numw)
  89.   DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  90.   NEW m[numx]
  91.   FOR a:=0 TO numx-1
  92.     m[a]:=NEW r[numy]
  93.     FOR b:=0 TO numy-1
  94.       r[b]:=NEW w[numw]
  95.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  96.     ENDFOR
  97.   ENDFOR
  98. ENDPROC m
  99.