home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / PERCEPT.ZIP / PERCEP.MAC
Encoding:
Text File  |  1990-11-06  |  8.8 KB  |  214 lines
  1.  
  2.  
  3. '                         Perceptrons &O0Neural Nets
  4.  '             (Two slightly different versions of the program)
  5. '                          January 1987 AI EXPERT
  6.  '                             by Peter Reece
  7. ' Listing 2
  8. CALL TEXTFONT(4): REM monospaced font for Macintosh
  9. CALL TEXTSIZE(9)
  10. 10 ' Simulation of a Simple Neural Net 
  11. 20 ' IMAGE      = the sensory grid array
  12. 30 ' NEURALNET  = the associative net - neural interconnections
  13. 40 ' SIZE^2     = number of cells in the sensory grid
  14. 50 ' SCAN       = number of cells required to construct an 8-bit address
  15. 60 '              into the array NEURALNET()
  16. 70 ' LSCAN      = the number of iterations for scanning the sensory
  17. 80 '              grid - i.e. we look at scan cells at random 
  18. 90 '              loopscan times
  19. 100 DEFINT A-Z:SIZE=16:SCAN=8:LSCAN=(SIZE^2)/SCAN
  20. 120 DIM IMAGE(SIZE,SIZE),NEURALNET(LSCAN*(SIZE^2),2)
  21. 130 GOSUB 6000:'                                   Intro message
  22. 140 '
  23. 150 '************ Training session. ************
  24. 155 RANDOMIZE 5:'                                  Init random
  25. 160 CLS: LOCATE 10,50:PRINT"===    TRAINING SESSION    ===="
  26. 161 LOCATE 12,50:'                                 Put up a prompt
  27. 162 Q$="Automatic training"
  28. 163 GOSUB 3000:'                                   Select Training
  29. 164 IF Q$<>"Y" THEN 170:'                          Manual Training
  30. 165 GOSUB 4000:GOTO 400:'                          Automatic Training
  31. 166 '
  32. 170 LOCATE 11,50
  33. 175 INPUT"Draw class 1 or 2";CLASS:'               Select a class
  34. 180 IF CLASS>2 THEN CLASS=2:'                      for this object
  35. 190 IF CLASS<2 THEN CLASS=1:'                      within range
  36. 200 GOSUB 1000:'                                   Draw an object 
  37. 210 FOR I=1 TO LSCAN:'                             Calculate 
  38. 220   GOSUB 2000:'                                 indicies into
  39. 230   NEURALNET(INDEX,CLASS)=1:'                   neuralnet
  40. 240 NEXT:'                                         for this class
  41. 250 LOCATE 2,5
  42. 260 Q$="Want to conduct more training":'           loop through more
  43. 270 GOSUB 3000:IF Q$="Y" THEN 160:'                training 
  44. 271 '
  45. 272 '
  46. 273 '
  47. 400 ' *********** Classification Session ************
  48. 420 CLS:LOCATE 10,50:PRINT"=== CLASSIFICATION SESSION ===="
  49. 430 '
  50. 431 RANDOMIZE 5:'                                  Init random
  51. 440 GOSUB 1000:'                                   Draw an object
  52. 450 MEMBER=0:NONMEMBER=0:'                         Init member count
  53. 500 FOR I=1 TO LSCAN:'                             Calculate 
  54. 510   GOSUB 2000:'                                 indicies 
  55. 540   IF NEURALNET(INDEX,1)=1 THEN MEMBER=MEMBER+1
  56. 550   IF NEURALNET(INDEX,2)=1 THEN NONMEMBER=NONMEMBER+1
  57. 551   IF NEURALNET(INDEX,1)=0 AND NEURALNET(INDEX,2)=0 THEN 553
  58. 552   GOTO 560
  59. 553   I=I-1:'                                       Null class found
  60. 560 NEXT
  61. 571 LOCATE 23,2:PRINT SPC(78)
  62. 573 LOCATE 12,50: PRINT"Ratio is ";MEMBER;"/";NONMEMBER
  63. 574 LOCATE 13,50: PRINT " favouring class ";
  64. 576 IF MEMBER<NONMEMBER THEN 580
  65. 577 PRINT"Two.";:GOTO 588
  66. 580 PRINT"One.";
  67. 588 IF ABS(MEMBER-NONMEMBER)>1 THEN 590
  68. 589 LOCATE 9,50:PRINT" * Ratios is close. *"
  69. 590 LOCATE 14,50:Q$="Classify another object":GOSUB 3000
  70. 600 IF Q$="Y" THEN 400
  71. 601 '
  72. 610 CLS:PRINT:PRINT:PRINT:PRINT:Q$="Want to see NEURALNET":GOSUB 3000
  73. 620 IF Q$="Y" THEN GOSUB 7000
  74. 670 PRINT"Emptying Neural Network..."
  75. 671 FOR I=1 TO LSCAN*SIZE*SIZE
  76. 680   FOR J=1 TO 2
  77. 690   NEURALNET(I,J)=0
  78. 691   NEXT J
  79. 692 NEXT I
  80. 693 GOTO 150
  81. 998 '
  82. 999 '
  83. 1000 ' *********** Interactive Object drawing ***********
  84. 1002 FOR I=1 TO SIZE:FOR J=1 TO SIZE:IMAGE(I,J)=0:NEXT:NEXT
  85. 1005 RR=5:CC=20:ROW=1:CLM=1
  86. 1006 LOCATE 23,2
  87. 1010 PRINT"[D],[U],[L],[R] to move. [.] to plot, [ ] to erase, [S] to stop."
  88. 1061 FOR I=1 TO SIZE+1
  89. 1062   LOCATE RR+I,CC:PRINT "|";:LOCATE RR+I,CC+17:PRINT "|";
  90. 1063   LOCATE RR,CC+I:PRINT "-";:LOCATE RR+17,CC+I:PRINT"-";
  91. 1064 NEXT
  92. 1070 LOCATE ROW+RR,CLM+CC
  93. 1080 A$=INKEY$:IF A$="" THEN 1080
  94. 1090 IF A$="U" THEN ROW=ROW-1
  95. 1100 IF A$="D" THEN ROW=ROW+1
  96. 1110 IF A$="L" THEN CLM=CLM-1
  97. 1120 IF A$="R" THEN CLM=CLM+1
  98. 1130 IF CLM > SIZE THEN CLM=SIZE
  99. 1140 IF CLM < 1 THEN CLM=1
  100. 1160 IF ROW < 1 THEN ROW=1
  101. 1170 IF ROW > SIZE THEN ROW=SIZE
  102. 1171 LOCATE 5,5:PRINT "ROW=";ROW;" CLM=";CLM;
  103. 1190 LOCATE ROW+RR,CLM+CC
  104. 1191 IF A$="." THEN PRINT CHR$(219):LOCATE ROW+RR,CLM+CC:IMAGE(CLM,ROW)=1
  105. 1194 IF A$=" " THEN PRINT" ":LOCATE ROW+RR,CLM+CC:IMAGE(CLM,ROW)=0
  106. 1196 IF A$="S" THEN LOCATE 10,1:PRINT"Object completed":GOTO 1210
  107. 1205 GOTO 1080
  108. 1210 PRINT "ONE MOMENT...":RETURN
  109. 1998 '
  110. 1999 '
  111. 2000 ' Calculate a SCAN digit address into NEURALNET()
  112. 2001 ' by scanning any SCAN cells of IMAGE() at random
  113. 2002 ' If a cell has an active pixel, it is considered on,
  114. 2003 ' else it is considered off. Hence a SCAN digit binary address.
  115. 2004 ' Resultant index is in the range 0 and up in size^2 
  116. 2005 ' blocks. The address within a block is determined by 
  117. 2006 ' the image(a,b) as a power of 2 (line 2040).
  118. 2009 INDEX=(SIZE^2)*(I-1)
  119. 2010 FOR J=0 TO SCAN-1
  120. 2020   FIRST=INT(RND*SIZE)+1:SECOND=INT(RND*SIZE)+1
  121. 2040   INDEX=INDEX+IMAGE(FIRST,SECOND)*2^J
  122. 2050 NEXT:RETURN
  123. 2999 '
  124. 3000 ' Issue a prompt using q$, and return q$=Y/N
  125. 3001 PRINT Q$;:INPUT Q$
  126. 3010 Q$=LEFT$(Q$,1):
  127. 3050 RETURN
  128. 3099 '
  129. 4000 ' Train the neural net on vertical vs. horizontal lines
  130. 4001 PRINT"Note: It takes a while to scan each object, but more "
  131. 4002 PRINT"      ojects mean more accurate classification."
  132. 4003 CLASS=1:RANDOMIZE 5
  133. 4004 INPUT"How many objects of Class One ";KNT
  134. 4010     FOR KLOOP=1 TO KNT:CLS: LOCATE 10,30:PRINT KLOOP;" of ";KNT
  135. 4011     FOR I=1 TO SIZE+1
  136. 4012       LOCATE I,SIZE:PRINT"|";:LOCATE SIZE,I:PRINT "-";
  137. 4013     NEXT
  138. 4014     PRINT"Object Class One";
  139. 4015 '     Create one horizontal line of length k
  140. 4019       FOR I=1 TO SIZE:FOR J=1 TO SIZE:IMAGE(I,J)=0:NEXT:NEXT
  141. 4020       KLEN=INT(RND*SIZE+1):IF KLEN<2 THEN 4020
  142. 4021       MPOS=INT(RND*SIZE)+1:NPOS=INT(RND*SIZE)+1
  143. 4022       IF NPOS+KLEN>SIZE THEN 4020
  144. 4023       REM IF NPOS>=KLEN THEN 4020
  145. 4025       FOR A=NPOS TO KLEN+NPOS-1
  146. 4026          IMAGE(A,MPOS)=1:LOCATE MPOS,A:PRINT CHR$(223);
  147. 4027       NEXT
  148. 4029       'Now place this image into neural net
  149. 4030       LOCATE 11,30:PRINT"Scanning object"
  150. 4032       LOCATE 12,30:PRINT"Len=";KLEN;" Start=";NPOS;",";MPOS;
  151. 4090       FOR I=1 TO LSCAN:GOSUB 2000
  152. 4091           NEURALNET(INDEX,CLASS)=1
  153. 4092       NEXT
  154. 4094     NEXT:CLS
  155. 4100 INPUT"How many objects of Class Two ";KNT
  156. 4105 CLASS=2:RANDOMIZE 5
  157. 4110      FOR KLOOP=1 TO KNT:CLS:LOCATE 10,30:PRINT KLOOP;" of ";KNT
  158. 4111     FOR I=1 TO SIZE+1
  159. 4112       LOCATE I,SIZE:PRINT"|";:LOCATE SIZE,I:PRINT "-";
  160. 4113     NEXT
  161. 4114     PRINT"Object Class Two";
  162. 4120       FOR I=1 TO SIZE:FOR J=1 TO SIZE:IMAGE(I,J)=0:NEXT:NEXT
  163. 4130       KLEN=INT(RND*SIZE+1):IF KLEN<2 THEN 4130
  164. 4135       MPOS=INT(RND*SIZE)+1:NPOS=INT(RND*SIZE)+1
  165. 4140       IF NPOS+KLEN>SIZE THEN 4130
  166. 4141       REM IF NPOS>=KLEN THEN 4130
  167. 4145       FOR A=NPOS TO KLEN+NPOS-1
  168. 4150          IMAGE(MPOS,A)=1:LOCATE A,MPOS:PRINT CHR$(219);
  169. 4153       NEXT
  170. 4154       'Now place this image into nerualnet
  171. 4155       LOCATE 11,30:PRINT"Scanning object"
  172. 4156       LOCATE 12,30:PRINT"Len=";KLEN;" Start=";NPOS;",";MPOS;
  173. 4160       FOR I=1 TO LSCAN:GOSUB 2000
  174. 4170           NEURALNET(INDEX,CLASS)=1
  175. 4180       NEXT
  176. 4190     NEXT:CLS
  177. 4200 RETURN
  178. 4998 '
  179. 4999 '
  180. 6000 ' Put up an intro message
  181. 6010 CLS:PRINT"  This program demonstrates how a very simple"
  182. 6040 PRINT"pecpeptron is capable of analysing visual information."
  183. 6045 PRINT:PRINT:PRINT
  184. 6050 PRINT"  Proceed as follows: "
  185. 6051 PRINT:PRINT
  186. 6060 PRINT" 1) Draw an object and decide if that object is a member of"
  187. 6070 PRINT"    a ojbect class one or two. Try vertical versus"
  188. 6080 PRINT"    horizontal lines to start."
  189. 6081 PRINT" 2) Train the neural net to recognize objects"
  190. 6082 PRINT"    of a particular class by drawing various objects"
  191. 6083 PRINT"    from both classes. (This may be done automatically)."
  192. 6084 PRINT" 3) Present various objects to the net, (some"
  193. 6085 PRINT"    old objects may be used, as well as those that it"
  194. 6086 PRINT"    has never seen before), and see how successfully it"
  195. 6087 PRINT"    classifies new ojects as belonging to the correct class."
  196. 6088 PRINT"    This simple simulation will make mistakes, but should"
  197. 6089 PRINT"    perform better or even much better than at random."
  198. 6090 PRINT:PRINT
  199. 6091 Q$="Ready.":GOSUB 3000:CLS
  200. 6100 RETURN
  201. 6999 '
  202. 7000 ' Display the contents of the neural network
  203. 7030 K=0:KK=0:KZ=0
  204. 7031 FOR I=1 TO LSCAN*SIZE^2
  205. 7040   FOR J=1 TO 2
  206. 7050     A=NEURALNET(I,J):IF A=1 THEN PRINT"*"; ELSE PRINT".";
  207. 7060     K=K+1:IF K>SIZE THEN K=0:KZ=KZ+1:PRINT"  ";
  208. 7061     IF KZ>3 THEN KZ=0:PRINT:KK=KK+1
  209. 7062     IF KK>SIZE THEN KK=0:PRINT
  210. 7065   NEXT
  211. 7066 NEXT
  212. 7070 RETURN
  213.