home *** CD-ROM | disk | FTP | other *** search
/ Aminet 18 / aminetcdnumber181997.iso / Aminet / dev / misc / gms_dev.lha / GMS / Source / E / Demos / Kohonen.e < prev    next >
Encoding:
Text File  |  1997-01-29  |  3.7 KB  |  142 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.
  6. **
  7. ** [This demo from the AmigaE archives has been converted to work with GMS.
  8. ** It is at about 33% faster than the original intuition version.]
  9. */
  10.  
  11. CONST ONE=1024*16, KSHIFT=14, KSIZE=7, MAXTIME=500, DELAY=0
  12. CONST KSTEP=ONE/KSIZE, KNODES=KSIZE+1, ARSIZE=KSIZE*KSIZE
  13. CONST XRED=64, YRED=128, XOFF=10, YOFF=20
  14.  
  15. MODULE 'games','games/games'
  16.  
  17. /*=========================================================================*/
  18.  
  19. PROC main()
  20. DEF screen:PTR TO gamescreen,map,t,input,x,y
  21.  
  22.  IF gmsbase := OpenLibrary('games.library',0)
  23.   SetUserPrefs('Kohenen')
  24.   IF (screen := AddScreen([TAGS,0,
  25.      GSA_PALETTE,[$000,$fff]:INT,
  26.      GSA_SCRWIDTH,320,
  27.      GSA_SCRHEIGHT,256,
  28.      GSA_PLANES,2,
  29.      GSA_SCRATTRIB,DBLBUFFER OR CENTRE,
  30.      GSA_SCRMODE,HIRES OR COL12BIT,
  31.      GSA_SCRTYPE,ILBM,
  32.      TAGEND]))
  33.  
  34.    ShowScreen(screen)
  35.  
  36.    map:=kohonen_init(KSIZE,KSIZE,2)
  37.  
  38.    FOR t:=0 TO MAXTIME-1
  39.      input := [Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  40.      x,y := kohonen_BMU(map,input)
  41.      kohonen_plot(map,screen,x,y)
  42.      kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  43.    ENDFOR
  44.  
  45.    WaitLMB()
  46.    DeleteScreen(screen)        
  47.       ENDIF
  48.    CloseLibrary(gmsbase)
  49.    ENDIF
  50. ENDPROC
  51.  
  52. /*=========================================================================*/
  53.  
  54. PROC kohonen_plot(map,screen:PTR TO gamescreen,bx,by)
  55. DEF x,y,n:PTR TO LONG,cx,cy,i,ii,sx[ARSIZE]:ARRAY OF LONG
  56. DEF sy[ARSIZE]:ARRAY OF LONG
  57.  
  58.   ClrScreen(screen,BUFFER2)
  59.   FOR x:=0 TO KSIZE-1
  60.     FOR y:=0 TO KSIZE-1
  61.       n := kohonen_node(map,x,y)
  62.       i := x*KSIZE+y
  63.       ii := x-1*KSIZE+y
  64.       sx[i] := cx := s(n[0]/XRED+XOFF)
  65.       sy[i] := cy := s(n[1]/YRED+YOFF)
  66.       IF x>0 THEN DrawLine(screen,BUFFER2,sx[ii],sy[ii],cx,cy,1)
  67.       IF y>0 THEN DrawLine(screen,BUFFER2,sx[i-1],sy[i-1],cx,cy,1)
  68.     ENDFOR
  69.   ENDFOR
  70.  
  71.   n:=kohonen_node(map,bx,by)
  72.   DrawPixel(screen,BUFFER2,s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),1)
  73.   WaitSVBL()
  74.   SwapBuffers(screen)
  75. ENDPROC
  76.  
  77. /*=========================================================================*/
  78.  
  79. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  80.  
  81. /*=========================================================================*/
  82.  
  83. PROC kohonen_BMU(map,i:PTR TO LONG)
  84. DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  85.  
  86.   len:=ListLen(i)-1
  87.   FOR x:=0 TO KSIZE-1
  88.     FOR y:=0 TO KSIZE-1
  89.       n:=kohonen_node(map,x,y)
  90.       act:=0
  91.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  92.       IF act<bestact
  93.          bestx := x
  94.          besty := y
  95.          bestact := act
  96.       ENDIF
  97.     ENDFOR
  98.   ENDFOR
  99.  
  100. ENDPROC bestx,besty
  101.  
  102. /*=========================================================================*/
  103.  
  104. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  105. DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  106.  
  107.   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]
  108.   len:=ListLen(i)-1
  109.  
  110.   FOR x:=0 TO KSIZE-1
  111.     FOR y:=0 TO KSIZE-1
  112.       n:=kohonen_node(m,x,y)
  113.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  114.       IF d>0
  115.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  116.       ENDIF
  117.     ENDFOR
  118.   ENDFOR
  119. ENDPROC
  120.  
  121. /*=========================================================================*/
  122.  
  123. PROC kohonen_node(map:PTR TO LONG,x,y)
  124.   DEF r:PTR TO LONG
  125.   r:=map[x]
  126. ENDPROC r[y]
  127.  
  128. /*=========================================================================*/
  129.  
  130. PROC kohonen_init(numx,numy,numw)
  131. DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  132.   NEW m[numx]
  133.   FOR a:=0 TO numx-1
  134.     m[a]:=NEW r[numy]
  135.     FOR b:=0 TO numy-1
  136.       r[b]:=NEW w[numw]
  137.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  138.     ENDFOR
  139.   ENDFOR
  140. ENDPROC m
  141.  
  142.