home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / ace-2.0.lha / ACE-2.0 / prgs / Misc / hopnet.b < prev    next >
Encoding:
Text File  |  1994-01-10  |  9.2 KB  |  445 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.  
  14. DIM wt(7,7),initial.wt(7,7),nodex(7),nodey(7),node(7),flag(7)
  15. LIBRARY graphics
  16. declare function Move library graphics
  17. declare function Text library graphics
  18.  
  19. SUB plot.link(n1,n2)
  20. shared nodex,nodey,node 
  21.   LINE (nodex(n1),nodey(n1))-(nodex(n2),nodey(n2)),2
  22.   '...replot nodes
  23.   IF node(n1) THEN 
  24.     '...activate
  25.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,bf
  26.   else
  27.     '...deactivate
  28.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),1,bf '..erase
  29.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,b  '..outline
  30.   end if 
  31.   IF node(n2) THEN 
  32.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,bf
  33.   else
  34.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),1,bf
  35.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,b
  36.   end if  
  37. END SUB
  38.  
  39. SUB unplot.link(n1,n2)
  40. shared nodex,nodey,node 
  41.   LINE (nodex(n1),nodey(n1))-(nodex(n2),nodey(n2)),1
  42.   '...replot nodes
  43.   IF node(n1) THEN 
  44.     '...activate
  45.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,bf
  46.   else
  47.     '...deactivate
  48.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),1,bf '..erase
  49.     line (nodex(n1)-10,nodey(n1)-5)-(nodex(n1)+10,nodey(n1)+5),2,b  '..outline
  50.   end if 
  51.   IF node(n2) THEN 
  52.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,bf
  53.   else
  54.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),1,bf
  55.     line (nodex(n2)-10,nodey(n2)-5)-(nodex(n2)+10,nodey(n2)+5),2,b
  56.   end if
  57. END SUB
  58.     
  59. SUB plot.weight(i,j,colr%)    
  60. shared wt,initial.wt,nodex,nodey,node
  61.   COLOR colr%,1  
  62.   x%=(nodex(i)+nodex(j)) / 2 
  63.   y%=(nodey(i)+nodey(j)) / 2 
  64.   Move(WINDOW(8),x%-8,y%+3)
  65.   wt$=STR$(wt(i,j))
  66.   FOR k=1 TO LEN(wt$)
  67.     ch$=MID$(wt$,k,1)
  68.     IF ch$=" " THEN
  69.       sn$="+" 
  70.       Text(window(8),varptr(sn$),1)
  71.     ELSE  
  72.       Text(window(8),varptr(ch$),1)
  73.     END IF
  74.   NEXT  
  75. END SUB              
  76.  
  77. SUB plot.node(n,colr%)
  78. shared nodex,nodey  
  79.   if colr%=2 then
  80.     '...activate
  81.     line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,bf 
  82.   else
  83.     '...deactivate
  84.     line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),1,bf '..erase
  85.     line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,b  '..outline
  86.   end if
  87. END SUB
  88.    
  89. SUB clrline 
  90.     LOCATE 12,50
  91.     PRINT"                               "
  92.     LOCATE 11,50
  93.     PRINT"                               "
  94. END SUB
  95.  
  96. RANDOMIZE TIMER
  97.   
  98. WINDOW 2,"Hopfield Neural Network",(0,0)-(640,200)
  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.       LIBRARY close graphics
  179.       stop
  180.     END IF
  181.     if k=1 then gosub set.node
  182.     if k=2 then gosub reset.node
  183.     if k=3 then gosub reset.all.nodes
  184.     if k=4 then gosub rnd.nodes
  185.     if k=5 then gosub change.weight
  186.     if k=6 then gosub reset.all.weights
  187.     if k=7 then gosub seek
  188.     clrline
  189. RETURN
  190.  
  191. set.node:
  192.   LOCATE 12,50
  193.   PRINT"set which node (1..7)?"
  194.   GOSUB get.node.num
  195.   node(n)=-1
  196.   line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,bf  
  197. RETURN
  198.  
  199. reset.node:
  200.   LOCATE 12,50
  201.   PRINT"reset which node (1..7)?"
  202.   GOSUB get.node.num
  203.   node(n)=0
  204.   line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),1,bf '..erase  
  205.   line (nodex(n)-10,nodey(n)-5)-(nodex(n)+10,nodey(n)+5),2,b  '..outline
  206. RETURN
  207.  
  208. reset.all.nodes:
  209.   LOCATE 12,50
  210.   PRINT"resetting nodes..."
  211.   FOR i=1 TO 7
  212.     node(i)=0
  213.     line (nodex(i)-10,nodey(i)-5)-(nodex(i)+10,nodey(i)+5),1,bf '..erase 
  214.     line (nodex(i)-10,nodey(i)-5)-(nodex(i)+10,nodey(i)+5),2,b  '..outline 
  215.   NEXT
  216. RETURN
  217.  
  218. reset.all.weights:
  219.   LOCATE 12,50
  220.   PRINT"resetting weights..."
  221.   FOR i=1 TO 7
  222.     FOR j=1 TO 7
  223.       wt(i,j)=initial.wt(i,j)
  224.     NEXT
  225.   NEXT
  226.   CLS
  227.   GOSUB draw.links  
  228.   GOSUB draw.nodes
  229.   GOSUB draw.weights
  230.   GOSUB node.key
  231.   GOSUB weight.matrix
  232. RETURN
  233.  
  234. rnd.nodes:
  235.   LOCATE 12,50
  236.   PRINT"randomizing nodes..."
  237.   FOR i=1 TO 7
  238.     r=RND
  239.     IF r<=.5 THEN 
  240.       node(i)=-1
  241.       CALL plot.node(i,2)  '...activate
  242.     ELSE
  243.       node(i)=0
  244.       CALL plot.node(i,3)  '...deactivate
  245.     END IF
  246.   NEXT
  247. RETURN
  248.                             
  249. change.weight:  
  250.  get.n1:
  251.   clrline
  252.   LOCATE 12,50
  253.   PRINT "first node (1..7)"
  254.   GOSUB get.node.num
  255.   n1=n
  256.   clrline
  257.   LOCATE 12,50
  258.   PRINT "second node (1..7)"
  259.   GOSUB get.node.num
  260.   n2=n
  261.   IF n1=n2 THEN get.n1
  262.   clrline
  263.   LOCATE 12,50
  264.   INPUT"enter new weight ",weight
  265.   weight=INT(weight)
  266.   IF weight<>0 THEN 
  267.     '...get rid of old weight
  268.     CALL plot.weight(n1,n2,0)
  269.     '...plot line of no link before
  270.     IF NOT(wt(n1,n2)) THEN CALL plot.link(n1,n2)
  271.     wt(n1,n2)=weight
  272.     wt(n2,n1)=weight
  273.     CALL plot.weight(n1,n2,3)
  274.   ELSE
  275.     '...get rid of weight
  276.     CALL plot.weight(n1,n2,0)
  277.     CALL unplot.link(n1,n2)
  278.     wt(n1,n2)=0
  279.     wt(n2,n1)=0
  280.   END IF
  281.   GOSUB weight.matrix
  282.   GOSUB draw.nodes
  283. RETURN    
  284.                   
  285. get.node.num:
  286.   n=0
  287.   WHILE n<1 OR n>7 
  288.     n=VAL(INKEY$)
  289.   WEND  
  290. RETURN
  291.  
  292. seek:
  293.   LOCATE 12,50
  294.   PRINT "Stop after each pass (y/n)"
  295.   answer$=""
  296.   WHILE answer$<>"Y" AND answer$<>"N"
  297.     answer$=INKEY$
  298.     answer$=UCASE$(answer$)
  299.   WEND  
  300.   IF answer$="Y" THEN pass.pause=-1 ELSE pass.pause=0
  301.   clrline
  302.   COLOR 2,1
  303.   LOCATE 14,40
  304.   PRINT "Node  Sum"
  305.   pass=0
  306.   seek.pass:
  307.     nodes.changing=0
  308.     pass=pass+1
  309.     COLOR 2,1
  310.     LOCATE 11,50
  311.     PRINT"seeking stable state"
  312.     LOCATE 11,71
  313.     PRINT "#";pass
  314.     FOR k=1 TO 7
  315.       flag(k)=0
  316.     NEXT 
  317.     i=1
  318.     WHILE i<=7
  319.      sum=0
  320.      get.node:
  321.       r=INT(RND*7)+1
  322.       IF flag(r) THEN get.node
  323.       flag(r)=-1
  324.       '...is it linked to other nodes & are they active?
  325.       FOR j=1 TO 7
  326.         IF wt(r,j) THEN 
  327.           IF node(j) THEN sum=sum+wt(r,j)
  328.         END IF  
  329.       NEXT
  330.       '...show sum of node's connections
  331.       COLOR 4,1
  332.       LOCATE 15+r,40
  333.       PRINT r;"   ";sum  
  334.       '...if sum is greater than 0 -> activate node
  335.       IF sum>0 THEN
  336.         IF node(r)=0 THEN 
  337.           node(r)=-1
  338.           CALL plot.node(r,2)
  339.           nodes.changing=nodes.changing+1
  340.         END IF  
  341.       ELSE
  342.         IF node(r)<>0 THEN
  343.           node(r)=0
  344.           CALL plot.node(r,3)
  345.           nodes.changing=nodes.changing+1
  346.         END IF          
  347.       END IF
  348.       i=i+1
  349.       IF INKEY$<>"" THEN exit.seek
  350.     WEND
  351.     IF nodes.changing AND pass.pause THEN GOSUB pause.after.pass  
  352.   IF nodes.changing > 0 THEN seek.pass
  353.   exit.seek:
  354.     clrline
  355.     LOCATE 11,50
  356.     PRINT "Network stable."
  357.     GOSUB pause.after.pass  
  358.     '...clear node sums
  359.     FOR i=1 TO 9
  360.       LOCATE 13+i,40
  361.       PRINT "          "
  362.     NEXT  
  363. RETURN
  364.  
  365. pause.after.pass:
  366.   LOCATE 12,50
  367.   PRINT "Hit return to continue."
  368.   WHILE INKEY$<>chr$(13)
  369.   WEND
  370.   LOCATE 12,50
  371.   PRINT "                          "
  372.   clrline    
  373. RETURN  
  374.  
  375. draw.links:   
  376.   bse=1
  377.   FOR i=1 TO 7
  378.     FOR j=bse TO 7
  379.       IF wt(i,j) THEN LINE (nodex(i),nodey(i))-(nodex(j),nodey(j)),2
  380.     NEXT
  381.     bse=bse+1
  382.   NEXT
  383. RETURN
  384.  
  385. draw.nodes:
  386.   FOR i=1 TO 7
  387.     IF NOT node(i) THEN 
  388.       plot.node(i,1)
  389.     ELSE
  390.       plot.node(i,2)
  391.     END IF
  392.   NEXT
  393. RETURN
  394.  
  395. draw.weights:
  396.   COLOR 3,1
  397.   bse=1
  398.   FOR i=1 TO 7       
  399.     FOR j=bse TO 7
  400.       IF wt(i,j) THEN CALL plot.weight(i,j,3)
  401.     NEXT 
  402.     bse=bse+1
  403.   NEXT
  404.   COLOR 2,1
  405. RETURN  
  406.  
  407. node.key:
  408.   COLOR 4,1
  409.   LOCATE 3,39:PRINT"1"
  410.   LOCATE 3,43:PRINT"2"
  411.   LOCATE 5,39:PRINT"3"
  412.   LOCATE 5,43:PRINT"4"
  413.   LOCATE 7,37:PRINT"5"
  414.   LOCATE 7,41:PRINT"6"
  415.   LOCATE 7,45:PRINT"7"
  416.   COLOR 2,1
  417. RETURN  
  418.       
  419. weight.matrix:
  420.   color 4,1 
  421.   locate 12,50
  422.   print "updating weight matrix..."
  423.   COLOR 2,1
  424.   '...column labels
  425.   FOR label.x=1 TO 7
  426.     LOCATE 14,54+(label.x*3)
  427.     PRINT label.x
  428.   NEXT
  429.   '...row labels
  430.   FOR label.y=1 TO 7
  431.     LOCATE 15+label.y,53
  432.     PRINT label.y
  433.   NEXT   
  434.   COLOR 3,1
  435.   '...connection weight matrix
  436.   FOR mat.x=1 TO 7
  437.     FOR mat.y=1 TO 7
  438.       LOCATE 15+mat.x,54+(mat.y*3)
  439.       PRINT wt(mat.x,mat.y);
  440.     NEXT
  441.   NEXT
  442.   locate 12,50
  443.   print "                         " 
  444. RETURN
  445.