home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Gfx / Kohonen.e < prev    next >
Encoding:
Text File  |  1992-09-02  |  2.7 KB  |  98 lines
  1. /* Kohonen Feature Maps in E, implemented with integers
  2.  
  3. Kohonen feature maps are special types of neural nets, and
  4. this implementation shows graphically how they organise themselves
  5. after a while. Apologies for the primitive gfx display.
  6.  
  7. */
  8.  
  9. CONST ONE=1024*16, KSHIFT=14, KSIZE=7, MAXTIME=500, DELAY=0
  10. CONST KSTEP=ONE/KSIZE, KNODES=KSIZE+1, ARSIZE=KSIZE*KSIZE
  11. CONST XRED=64, YRED=128, XOFF=10, YOFF=20
  12.  
  13. MODULE 'intuition/intuition', 'tools/exceptions'
  14.  
  15. PROC main() HANDLE
  16.   DEF map,t,input,x,y,w=NIL
  17.   IF w:=OpenW(20,11,400,200,$200,$F,'Kohonen Feature Map Simulation',0,1,0)
  18.     map:=kohonen_init(KSIZE,KSIZE,2)
  19.     FOR t:=0 TO MAXTIME-1
  20.       input:=[Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  21.       x,y:=kohonen_BMU(map,input)
  22.       kohonen_plot(map,w,x,y)
  23.       kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  24.     ENDFOR
  25.   ELSE
  26.     Raise("WIN")
  27.   ENDIF
  28.   RefreshWindowFrame(w)
  29.   WaitIMessage(w)
  30. EXCEPT DO
  31.   report_exception()
  32.   IF w THEN CloseW(w)
  33. ENDPROC
  34.  
  35. PROC kohonen_plot(map,wnd:PTR TO window,bx,by)
  36.   DEF x,y,n:PTR TO LONG,cx,cy,i,ii,
  37.       sx[ARSIZE]:ARRAY OF LONG,sy[ARSIZE]:ARRAY OF LONG
  38.   SetRast(wnd.rport,1)
  39.   FOR x:=0 TO KSIZE-1
  40.     FOR y:=0 TO KSIZE-1
  41.       n:=kohonen_node(map,x,y); i:=x*KSIZE+y; ii:=x-1*KSIZE+y
  42.       sx[i]:=cx:=s(n[0]/XRED+XOFF); sy[i]:=cy:=s(n[1]/YRED+YOFF)
  43.       IF x>0 THEN Line(sx[ii],sy[ii],cx,cy,2)
  44.       IF y>0 THEN Line(sx[i-1],sy[i-1],cx,cy,2)
  45.     ENDFOR
  46.   ENDFOR
  47.   n:=kohonen_node(map,bx,by)
  48.   Plot(s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),2)
  49.   Delay(DELAY)
  50. ENDPROC
  51.  
  52. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  53.  
  54. PROC kohonen_BMU(map,i:PTR TO LONG)
  55.   DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  56.   len:=ListLen(i)-1
  57.   FOR x:=0 TO KSIZE-1
  58.     FOR y:=0 TO KSIZE-1
  59.       n:=kohonen_node(map,x,y)
  60.       act:=0
  61.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  62.       IF act<bestact; bestx:=x; besty:=y; bestact:=act; ENDIF
  63.     ENDFOR
  64.   ENDFOR
  65. ENDPROC bestx,besty
  66.  
  67. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  68.   DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  69.   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]
  70.   len:=ListLen(i)-1
  71.   FOR x:=0 TO KSIZE-1
  72.     FOR y:=0 TO KSIZE-1
  73.       n:=kohonen_node(m,x,y)
  74.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  75.       IF d>0
  76.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  77.       ENDIF
  78.     ENDFOR
  79.   ENDFOR
  80. ENDPROC
  81.  
  82. PROC kohonen_node(map:PTR TO LONG,x,y)
  83.   DEF r:PTR TO LONG
  84.   r:=map[x]
  85. ENDPROC r[y]
  86.  
  87. PROC kohonen_init(numx,numy,numw)
  88.   DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  89.   NEW m[numx]
  90.   FOR a:=0 TO numx-1
  91.     m[a]:=NEW r[numy]
  92.     FOR b:=0 TO numy-1
  93.       r[b]:=NEW w[numw]
  94.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  95.     ENDFOR
  96.   ENDFOR
  97. ENDPROC m
  98.