home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / ACE / Prgs / Gfx / HopNet.b < prev    next >
Text File  |  1994-10-03  |  9KB  |  444 lines
  1. ' *** Hopfield Neural Network ***
  2.  
  3. '...  - 7 nodes
  4. '...  - symmetrical connection weights
  5. '...  - alterable weights & node settings  
  6.  
  7. '...see: "Connectionist Ideas & Algorithms",
  8. '...      Communications of the ACM, November 1991
  9.  
  10. '...David J Benn, 7th March-8th March 1991
  11. '...Modified for ACE BASIC on 20th-21st,26th February 1992,
  12. '...                  7th,31st January 1993,
  13. '...                  2nd October 1994
  14.  
  15. DIM wt(7,7),initial.wt(7,7),nodex(7),nodey(7),node(7),flag(7)
  16.  
  17. SUB plot.link(n1,n2)
  18. shared nodex,nodey,node 
  19.   LINE (nodex(n1),nodey(n1))-(nodex(n2),nodey(n2)),2
  20.   '...replot nodes
  21.   IF node(n1) THEN 
  22.     '...activate
  23.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,bf
  24.   else
  25.     '...deactivate
  26.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),1,bf '..erase
  27.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,b  '..outline
  28.   end if 
  29.   IF node(n2) THEN 
  30.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,bf
  31.   else
  32.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),1,bf
  33.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,b
  34.   end if  
  35. END SUB
  36.  
  37. SUB unplot.link(n1,n2)
  38. shared nodex,nodey,node 
  39.   LINE (nodex(n1),nodey(n1))-(nodex(n2),nodey(n2)),1
  40.   '...replot nodes
  41.   IF node(n1) THEN 
  42.     '...activate
  43.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,bf
  44.   else
  45.     '...deactivate
  46.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),1,bf '..erase
  47.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,b  '..outline
  48.   end if 
  49.   IF node(n2) THEN 
  50.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,bf
  51.   else
  52.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),1,bf
  53.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,b
  54.   end if
  55. END SUB
  56.     
  57. SUB plot.weight(i,j,colr%)    
  58. shared wt,initial.wt,nodex,nodey,node
  59.   COLOR colr%,1  
  60.   x%=(nodex(i)+nodex(j)) / 2 
  61.   y%=(nodey(i)+nodey(j)) / 2 
  62.   SETXY x%-8,y%+3
  63.   wt$=STR$(wt(i,j))
  64.   FOR k=1 TO LEN(wt$)
  65.     ch$=MID$(wt$,k,1)
  66.     IF ch$=" " THEN
  67.       sn$="+"
  68.       PRINT sn$; 
  69.     ELSE  
  70.       PRINT ch$;
  71.     END IF
  72.   NEXT  
  73. END SUB              
  74.  
  75. SUB plot.node(n,colr%)
  76. shared nodex,nodey  
  77.   if colr%=2 then
  78.     '...activate
  79.     line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,bf 
  80.   else
  81.     '...deactivate
  82.     line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),1,bf '..erase
  83.     line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,b  '..outline
  84.   end if
  85. END SUB
  86.    
  87. SUB clrline 
  88.     LOCATE 12,50
  89.     PRINT"                               "
  90.     LOCATE 11,50
  91.     PRINT"                               "
  92. END SUB
  93.  
  94. RANDOMIZE TIMER
  95.   
  96. WINDOW 2,"Hopfield Neural Network",(0,0)-(640,200),6
  97. FONT "topaz",8
  98. PENUP    '..don't want SETXY to draw a line!
  99. color 2,1
  100. cls
  101.  
  102. xoff=55
  103. yoff=35
  104.  
  105. FOR i=1 TO 7
  106.   READ nodex(i),nodey(i)
  107.   nodex(i)=nodex(i)+xoff
  108.   nodey(i)=nodey(i)+yoff
  109. NEXT
  110.  
  111. '...node coords
  112.  
  113. DATA 55,5
  114. DATA 155,5
  115.  
  116. DATA 55,55
  117. DATA 155,55
  118.  
  119. DATA 5,105
  120. DATA 105,105
  121. DATA 205,105
  122.  
  123. '...set up connection weight adjacency matrix
  124. FOR i=1 TO 7
  125.   FOR j=1 TO 7
  126.     READ wt(i,j)
  127.     initial.wt(i,j)=wt(i,j)
  128.   NEXT
  129. NEXT
  130.     
  131. '...link data
  132. DATA 0,-1,1,-1,0,0,0
  133. DATA -1,0,0,3,0,0,0
  134. DATA 1,0,0,-1,2,1,0
  135. DATA -1,3,-1,0,0,-2,3
  136. DATA 0,0,2,0,0,1,0
  137. DATA 0,0,1,-2,1,0,-1
  138. DATA 0,0,0,3,0,-1,0
  139.  
  140. GOSUB draw.links  
  141. GOSUB draw.nodes
  142. GOSUB draw.weights
  143. GOSUB node.key
  144. GOSUB weight.matrix
  145.   
  146. '...reset all nodes
  147. FOR i=1 TO 7
  148.   node(i)=0
  149. NEXT
  150.     
  151. '...main loop
  152. WHILE -1
  153.   GOSUB main.menu
  154. WEND
  155.   
  156. main.menu:
  157.   color 2,1
  158.   LOCATE 2,50: PRINT"1. activate a node"
  159.   LOCATE 3,50: PRINT"2. deactivate a node"
  160.   LOCATE 4,50: PRINT"3. deactivate all nodes"
  161.   LOCATE 5,50: PRINT"4. randomize nodes"
  162.   LOCATE 6,50: PRINT"5. change a weight"
  163.   LOCATE 7,50: PRINT"6. reset all weights"
  164.   LOCATE 8,50: PRINT"7. seek a stable state"
  165.   LOCATE 9,50: PRINT"0. quit"
  166.   color 3,1
  167.   LOCATE 10,50:PRINT"   enter 0..7"
  168.   color 2,1
  169.   getitagain:
  170.     k$=""
  171.     WHILE k$=""
  172.       k$=INKEY$
  173.     WEND
  174.     k=VAL(k$)
  175.     IF (k<0 OR k>7) OR NOT(k$>="0" AND k$<="7") THEN getitagain
  176.     IF k=0 THEN
  177.       WINDOW CLOSE 2
  178.       stop
  179.     END IF
  180.     if k=1 then gosub set.node
  181.     if k=2 then gosub reset.node
  182.     if k=3 then gosub reset.all.nodes
  183.     if k=4 then gosub rnd.nodes
  184.     if k=5 then gosub change.weight
  185.     if k=6 then gosub reset.all.weights
  186.     if k=7 then gosub seek
  187.     clrline
  188. RETURN
  189.  
  190. set.node:
  191.   LOCATE 12,50
  192.   PRINT"set which node (1..7)?"
  193.   GOSUB get.node.num
  194.   node(n)=-1
  195.   line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,bf  
  196. RETURN
  197.  
  198. reset.node:
  199.   LOCATE 12,50
  200.   PRINT"reset which node (1..7)?"
  201.   GOSUB get.node.num
  202.   node(n)=0
  203.   line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),1,bf '..erase  
  204.   line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,b  '..outline
  205. RETURN
  206.  
  207. reset.all.nodes:
  208.   LOCATE 12,50
  209.   PRINT"resetting nodes..."
  210.   FOR i=1 TO 7
  211.     node(i)=0
  212.     line (nodex(i)-10,nodey(i)-5)-(nodex(i)+10,nodey(i)+5),1,bf '..erase 
  213.     line (nodex(i)-10,nodey(i)-5)-(nodex(i)+10,nodey(i)+5),2,b  '..outline 
  214.   NEXT
  215. RETURN
  216.  
  217. reset.all.weights:
  218.   LOCATE 12,50
  219.   PRINT"resetting weights..."
  220.   FOR i=1 TO 7
  221.     FOR j=1 TO 7
  222.       wt(i,j)=initial.wt(i,j)
  223.     NEXT
  224.   NEXT
  225.   CLS
  226.   GOSUB draw.links  
  227.   GOSUB draw.nodes
  228.   GOSUB draw.weights
  229.   GOSUB node.key
  230.   GOSUB weight.matrix
  231. RETURN
  232.  
  233. rnd.nodes:
  234.   LOCATE 12,50
  235.   PRINT"randomizing nodes..."
  236.   FOR i=1 TO 7
  237.     r=RND
  238.     IF r<=.5 THEN 
  239.       node(i)=-1
  240.       CALL plot.node(i,2)  '...activate
  241.     ELSE
  242.       node(i)=0
  243.       CALL plot.node(i,3)  '...deactivate
  244.     END IF
  245.   NEXT
  246. RETURN
  247.                             
  248. change.weight:  
  249.  get.n1:
  250.   clrline
  251.   LOCATE 12,50
  252.   PRINT "first node (1..7)"
  253.   GOSUB get.node.num
  254.   n1=n
  255.   clrline
  256.   LOCATE 12,50
  257.   PRINT "second node (1..7)"
  258.   GOSUB get.node.num
  259.   n2=n
  260.   IF n1=n2 THEN get.n1
  261.   clrline
  262.   LOCATE 12,50
  263.   INPUT"enter new weight ",weight
  264.   weight=INT(weight)
  265.   IF weight<>0 THEN 
  266.     '...get rid of old weight
  267.     CALL plot.weight(n1,n2,0)
  268.     '...plot line of no link before
  269.     IF NOT(wt(n1,n2)) THEN CALL plot.link(n1,n2)
  270.     wt(n1,n2)=weight
  271.     wt(n2,n1)=weight
  272.     CALL plot.weight(n1,n2,3)
  273.   ELSE
  274.     '...get rid of weight
  275.     CALL plot.weight(n1,n2,0)
  276.     CALL unplot.link(n1,n2)
  277.     wt(n1,n2)=0
  278.     wt(n2,n1)=0
  279.   END IF
  280.   GOSUB weight.matrix
  281.   GOSUB draw.nodes
  282. RETURN    
  283.                   
  284. get.node.num:
  285.   n=0
  286.   WHILE n<1 OR n>7 
  287.     n=VAL(INKEY$)
  288.   WEND  
  289. RETURN
  290.  
  291. seek:
  292.   LOCATE 12,50
  293.   PRINT "Stop after each pass (y/n)"
  294.   answer$=""
  295.   WHILE answer$<>"Y" AND answer$<>"N"
  296.     answer$=INKEY$
  297.     answer$=UCASE$(answer$)
  298.   WEND  
  299.   IF answer$="Y" THEN pass.pause=-1 ELSE pass.pause=0
  300.   clrline
  301.   COLOR 2,1
  302.   LOCATE 14,40
  303.   PRINT "Node  Sum"
  304.   pass=0
  305.   seek.pass:
  306.     nodes.changing=0
  307.     pass=pass+1
  308.     COLOR 2,1
  309.     LOCATE 11,50
  310.     PRINT"seeking stable state"
  311.     LOCATE 11,71
  312.     PRINT "#";pass
  313.     FOR k=1 TO 7
  314.       flag(k)=0
  315.     NEXT 
  316.     i=1
  317.     WHILE i<=7
  318.      sum=0
  319.      get.node:
  320.       r=INT(RND*7)+1
  321.       IF flag(r) THEN get.node
  322.       flag(r)=-1
  323.       '...is it linked to other nodes & are they active?
  324.       FOR j=1 TO 7
  325.         IF wt(r,j) THEN 
  326.           IF node(j) THEN sum=sum+wt(r,j)
  327.         END IF  
  328.       NEXT
  329.       '...show sum of node's connections
  330.       COLOR 4,1
  331.       LOCATE 15+r,40
  332.       PRINT r;"   ";sum  
  333.       '...if sum is greater than 0 -> activate node
  334.       IF sum>0 THEN
  335.         IF node(r)=0 THEN 
  336.           node(r)=-1
  337.           CALL plot.node(r,2)
  338.           nodes.changing=nodes.changing+1
  339.         END IF  
  340.       ELSE
  341.         IF node(r)<>0 THEN
  342.           node(r)=0
  343.           CALL plot.node(r,3)
  344.           nodes.changing=nodes.changing+1
  345.         END IF          
  346.       END IF
  347.       i=i+1
  348.       IF INKEY$<>"" THEN exit.seek
  349.     WEND
  350.     IF nodes.changing AND pass.pause THEN GOSUB pause.after.pass  
  351.   IF nodes.changing > 0 THEN seek.pass
  352.   exit.seek:
  353.     clrline
  354.     LOCATE 11,50
  355.     PRINT "Network stable."
  356.     GOSUB pause.after.pass  
  357.     '...clear node sums
  358.     FOR i=1 TO 9
  359.       LOCATE 13+i,40
  360.       PRINT "          "
  361.     NEXT  
  362. RETURN
  363.  
  364. pause.after.pass:
  365.   LOCATE 12,50
  366.   PRINT "Hit return to continue."
  367.   WHILE INKEY$<>chr$(13)
  368.   WEND
  369.   LOCATE 12,50
  370.   PRINT "                          "
  371.   clrline    
  372. RETURN  
  373.  
  374. draw.links:   
  375.   bse=1
  376.   FOR i=1 TO 7
  377.     FOR j=bse TO 7
  378.       IF wt(i,j) THEN LINE (nodex(i),nodey(i))-(nodex(j),nodey(j)),2
  379.     NEXT
  380.     bse=bse+1
  381.   NEXT
  382. RETURN
  383.  
  384. draw.nodes:
  385.   FOR i=1 TO 7
  386.     IF NOT node(i) THEN 
  387.       plot.node(i,1)
  388.     ELSE
  389.       plot.node(i,2)
  390.     END IF
  391.   NEXT
  392. RETURN
  393.  
  394. draw.weights:
  395.   COLOR 3,1
  396.   bse=1
  397.   FOR i=1 TO 7       
  398.     FOR j=bse TO 7
  399.       IF wt(i,j) THEN CALL plot.weight(i,j,3)
  400.     NEXT 
  401.     bse=bse+1
  402.   NEXT
  403.   COLOR 2,1
  404. RETURN  
  405.  
  406. node.key:
  407.   COLOR 4,1
  408.   LOCATE 3,39:PRINT"1"
  409.   LOCATE 3,43:PRINT"2"
  410.   LOCATE 5,39:PRINT"3"
  411.   LOCATE 5,43:PRINT"4"
  412.   LOCATE 7,37:PRINT"5"
  413.   LOCATE 7,41:PRINT"6"
  414.   LOCATE 7,45:PRINT"7"
  415.   COLOR 2,1
  416. RETURN  
  417.       
  418. weight.matrix:
  419.   color 4,1 
  420.   locate 12,50
  421.   print "updating weight matrix..."
  422.   COLOR 2,1
  423.   '...column labels
  424.   FOR label.x=1 TO 7
  425.     LOCATE 14,54+(label.x*3)
  426.     PRINT label.x
  427.   NEXT
  428.   '...row labels
  429.   FOR label.y=1 TO 7
  430.     LOCATE 15+label.y,53
  431.     PRINT label.y
  432.   NEXT   
  433.   COLOR 3,1
  434.   '...connection weight matrix
  435.   FOR mat.x=1 TO 7
  436.     FOR mat.y=1 TO 7
  437.       LOCATE 15+mat.x,54+(mat.y*3)
  438.       PRINT wt(mat.x,mat.y);
  439.     NEXT
  440.   NEXT
  441.   locate 12,50
  442.   print "                         " 
  443. RETURN
  444.