home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 001_100 / disk0004 / insert.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1982-11-06  |  8.3 KB  |  288 lines
  1. 10  REM------------------------------------------------------
  2. 20  REM
  3. 30  REM                   insert.bas
  4. 40  REM      Add to the contents of a data file thru its index
  5. 50  REM
  6. 60  REM-------------------------------------------------------
  7. 70  CLS:KEY OFF
  8. 80  S0%=20:DIM STACK%(S0%):GOTO 2220
  9. 90  REM
  10. 100  REM       Subroutines used:
  11. 110  REM         100,150:read, write a node of b-tree
  12. 120  REM         200,250:save, restore copy of b-tree node
  13. 130  REM         300,350,395:push, pop, init the stack
  14. 140  REM         400 :shift items in node for splitting node
  15. 150  REM         500: search down b-tree
  16. 160  REM         600: allocate more space for b-tree
  17. 170  REM         700: split b-tree node to root node
  18. 180  REM         800: overflow b-tree node to root node
  19. 190  REM         900: insert a new item into b-tree
  20. 200  REM        1000: close all files and finish up
  21. 210  REM
  22. 220  REM
  23. 230  REM
  24. 240  REM
  25. 250  REM-----------------------------------------------------------
  26. 260  REM
  27. 270  REM                          READ.BAS
  28. 280  REM      INPUT A B-TREE NODE FROM DISK FILE #1
  29. 290  REM------------------------------------------------------------
  30. 300  GET 1, P%:LSET REC$=R$
  31. 310  FOR INDEX%=1 TO N%
  32. 320    CH%=SIZE%*(INDEX%-1)
  33. 330    FLAG$=MID$(REC$,CH%+1,1)
  34. 340     IF FLAG$="E" THEN FLAG%(INDEX%)=0
  35. 350     IF FLAG$="F" THEN FLAG%(INDEX%)=1
  36. 360     IF FLAG$="D" THEN FLAG%(INDEX%)=2
  37. 370    KEYS$(INDEX%)=MID$(REC$,CH%+2,SIZE%-3)
  38. 380    ARC%(INDEX%)=CVI(MID$(REC$,CH%+SIZE%-1,2))
  39. 390  NEXT INDEX%
  40. 400  ARC%(N%+1)=CVI(MID$(REC$,126,2))
  41. 410  RETURN
  42. 420  REM------------------------------------------------------------
  43. 430  REM                      WRITE.BAS
  44. 440  REM     Output a b-tree node to file #1
  45. 450  REM-------------------------------------------------------------
  46. 460  REC$=STRING$(127, " " )
  47. 470  FOR INDEX%=1 TO N%
  48. 480    CH%=SIZE%*(INDEX%-1)
  49. 490    FLAG$=MID$(REC$,CH%+1,1)
  50. 500      FLAG$="E" :GOTO 530
  51. 510      FLAG$="F":GOTO 530
  52. 520      FLAG$="D"
  53. 530    MID$(REC$,CH%+1,1)=FLAG$
  54. 540    MID$(REC$,CH%+2,SIZE%-3)=KEYS$(INDEX%)
  55. 550    MID$(REC$,CH%+SIZE%-1,2)=MKI$(ARC%(INDEX%))
  56. 560  NEXT INDEX%
  57. 570  MID$(REC$,126,2)=MKI$(ARC%(N%+1))
  58. 580  LSET R$=REC$:PUT 1, P%
  59. 590  RETURN
  60. 600  REM-------------------------------------
  61. 610  REM       SAVE A B-TREE NODE
  62. 620  REM-------------------------------------
  63. 630  FOR INDEX%=1 TO N%+1
  64. 640      SFLAG%(INDEX%)=FLAG%(INDEX%)
  65. 650      SKEYS$(INDEX%)=KEYS$(INDEX%)
  66. 660      SARC%(INDEX%)=ARC%(INDEX%)
  67. 670  NEXT INDEX%
  68. 680  RETURN
  69. 690  REM------------------------------------------
  70. 700  REM       RESTORE A B-TREE NODE
  71. 710  REM------------------------------------------
  72. 720  FOR INDEX%=1 TO N%+1
  73. 730      FLAG%(INDEX%)=SFLAG%(INDEX%)
  74. 740      KEYS$(INDEX%)=SKEYS$(INDEX%)
  75. 750      ARC%(INDEX%)=SARC%(INDEX%)
  76. 760  NEXT INDEX%
  77. 770  RETURN
  78. 780  REM------------------------
  79. 790  REM       PUSH
  80. 800  REM------------------------
  81. 810  IF TS%<=S0% THEN 840
  82. 820     D$="Stack overflow"
  83. 830     RETURN
  84. 840  STACK%(TS%)=A%:TS%=TS%+1
  85. 850  D$= "" :RETURN
  86. 860  REM---------------------
  87. 870  REM     pop
  88. 880  REM----------------------
  89. 890  TS%=TS%-1
  90. 900  IF TS%>0 THEN 930
  91. 910     D$="Stack underflow"
  92. 920     RETURN
  93. 930  A%=STACK%(TS%)
  94. 940  D$= "" :RETURN
  95. 950  REM--------------------------
  96. 960  REM   Initialize stack
  97. 970  REM--------------------------
  98. 980  TS%=1:RETURN
  99. 990  REM--------------------------------
  100. 1000  REM   Shift b-tree node
  101. 1010  REM--------------------------------
  102. 1020  SPLIT%=INT((N%+1)/2)
  103. 1030  I%=1
  104. 1040  IF SPLIT%+I%<=N% THEN 1050 ELSE 1100
  105. 1050    ARC%(I%)=ARC%(SPLIT%+I%)
  106. 1060    KEYS$(I%)=KEYS$(SPLIT%+I%)
  107. 1070    FLAG%(I%)=FLAG%(SPLIT%+I%)
  108. 1080    I%=I%+1
  109. 1090    GOTO 1040
  110. 1100  ARC%(I%)=TEMP%
  111. 1110  KEYS$(I%)=ZERO$
  112. 1120  FLAG%(I%)=0
  113. 1130  REM---------------------------------------
  114. 1140  REM   Zero out remaining items in node
  115. 1150  REM---------------------------------------
  116. 1160  FOR I%=I%+1 TO N%
  117. 1170   ARC%(I%)=0
  118. 1180   KEYS$(I%)=ZERO$
  119. 1190   FLAG%(I%)=0
  120. 1200  NEXT I%
  121. 1210  GOSUB 1420   'allocate disk space at p2%
  122. 1220  SWAP P%,P2%
  123. 1230  GOSUB 420    'write right son to disk
  124. 1240  SWAP P%,P2%
  125. 1250  RETURN
  126. 1260  REM------------------------------------
  127. 1270  REM       search b-tree for k$
  128. 1280  REM-------------------------------------
  129. 1290  D$= ""                   'message
  130. 1300  GOSUB 950                'initialize stack
  131. 1310  P%=ROOT%
  132. 1320  REM repeat until found or not-in-file
  133. 1330   I%=1
  134. 1340   GOSUB 250
  135. 1350   IF KEYS$(I%)=ZERO$ THEN 1380
  136. 1360   IF KEYS$(I%)<K$ THEN 1370 ELSE 1380
  137. 1370      I%=I%+1:GOTO 1350
  138. 1380   A%=P%:GOSUB 780    'push node number
  139. 1390   A%=I%:GOSUB 780    'push item number
  140. 1400  P%=ARC%(I%):IF P%<=0 THEN RETURN
  141. 1410  GOTO 1320
  142. 1420  REM----------------------------------------------------
  143. 1430  REM    Allocate more disk space for b-tree
  144. 1440  REM----------------------------------------------------
  145. 1450  D$= "" :LNF%=LNF%+1
  146. 1460  P2%=LNF%
  147. 1470  RETURN
  148. 1480  REM------------------------------------------------------
  149. 1490  REM   Split a b-tree node into lf and rt nodes
  150. 1500  REM------------------------------------------------------
  151. 1510  GOSUB 600
  152. 1520  GOSUB 990
  153. 1530  GOSUB 690
  154. 1540  K$=KEYS$(SPLIT%)
  155. 1550  FOR I%=SPLIT%+1 TO N%
  156. 1560   KEYS$(I%)=ZERO$
  157. 1570   FLAG%(I%)=0
  158. 1580   ARC%(I%)=0
  159. 1590  NEXT I%
  160. 1600  ARC%(N%+1)=P2%
  161. 1610  GOSUB 420
  162. 1620  RETURN
  163. 1630  REM----------------------
  164. 1640  REM   Overflow
  165. 1650  REM----------------------
  166. 1660  GOSUB 1480:P0%=P%
  167. 1670  GOSUB 860:ITEM%=A%
  168. 1680  GOSUB 860:P%=A%
  169. 1690  IF D$="Stack underflow" THEN 1700 ELSE 1810
  170. 1700     FLAG%(1)=1:KEYS$(1)=K$:ARC%(1)=P0%
  171. 1710     FLAG%(2)=0:KEYS$(2)=ZERO$:ARC%(2)=P2%
  172. 1720     FOR I%=3 TO N%
  173. 1730         FLAG%(I%)=0
  174. 1740         KEYS$(I%)=ZERO$
  175. 1750         ARC%(I%)=0
  176. 1760    NEXT I%
  177. 1770    ARC%(N%+1)=0
  178. 1780  GOSUB 1420:P%=P2%
  179. 1790  GOSUB 420:ROOT%=P%
  180. 1800    D$="Done":RETURN
  181. 1810  REM--------------------------------
  182. 1820  GOSUB 250     'read parent node
  183. 1830  ARC%(ITEM%)=P2%
  184. 1840  D$="Not done"
  185. 1850  RETURN
  186. 1860  REM-----------------------------------------
  187. 1870  REM       Insert new item in b-tree
  188. 1880  REM-----------------------------------------
  189. 1890  GOSUB 1260    'SEARCH
  190. 1900  GOSUB 860:ITEM%=A%      'POP
  191. 1910  GOSUB 860:P%=A%        'POP
  192. 1920  IF K$=KEYS$(ITEM%) THEN 1930 ELSE 1960
  193. 1930    D$="Found":PRINT"Alreay indexed"
  194. 1940    LINE INPUT"Strike return to continue";Y$
  195. 1950    RETURN
  196. 1960  REM--------------------------------
  197. 1970  TEMP%=ARC%(N%)
  198. 1980  FOR I%=N% TO ITEM%+1 STEP (-1)
  199. 1990    ARC%(I%)=ARC%(I%-1)
  200. 2000    KEYS$(I%)=KEYS$(I%-1)
  201. 2010    FLAG%(I%)=FLAG%(I%-1)
  202. 2020  NEXT I%
  203. 2030  ARC%(ITEM%)=P0%
  204. 2040  KEYS$(ITEM%)=K$
  205. 2050  FLAG%(ITEM%)=1
  206. 2060  REM----------------------- Insert done ----------------------
  207. 2070  IF KEYS$(N%)=ZERO$ THEN 2080 ELSE 2090
  208. 2080    GOSUB 420:RETURN                    're-write node
  209. 2090  GOSUB 1630:IF D$<>"Done" THEN 1960      'ascend b-tree?
  210. 2100  RETURN
  211. 2110  REM----------------------------
  212. 2120  REM       Finish up
  213. 2130  REM-----------------------------
  214. 2140  FOR I%=1 TO 24
  215. 2150  PRINT
  216. 2160  NEXT I%        'clear screen
  217. 2170  CLOSE 1,2
  218. 2180  OPEN "o",2,"HEADER.DAT"
  219. 2190  PRINT #2,FSCREEN$;",";ROOT%;LNG%;LNF%;AN%;LINS%;N%;SIZE%;INDEX$;",";MAST$
  220. 2200  CLOSE 2
  221. 2210  RETURN
  222. 2220  REM--------------------------------------------
  223. 2230  REM Capture data from screen form
  224. 2240  REM--------------------------------------------
  225. 2241  PRINT :PRINT:PRINT "As each line of your screen form appears, type in the requested"
  226. 2242  PRINT " information.":PRINT:PRINT
  227. 2250  FOR I%=1 TO  3:PRINT:NEXT I%
  228. 2260  OPEN "I",2,"HEADER.DAT"
  229. 2270  INPUT #2,FSCREEN$,    ROOT%,LNG%,LNF%,AN%,LINS%,N%,SIZE%,INDEX$,    MAST$
  230. 2280  CLOSE 2
  231. 2290  N0%=N%+1:DIM FLAG%(N0%),KEYS$(N0%),ARC%(N0%)
  232. 2300           DIM SFLAG%(N0%),SKEYS$ (N0%),SARC%(N0%)
  233. 2310  OPEN "I",2,FSCREEN$
  234. 2320    FOR L%=1 TO LINS%:INPUT #2,RW$(L%):NEXT L%
  235. 2330  CLOSE 2
  236. 2340  OPEN "R",1,INDEX$
  237. 2350  FIELD 1,127 AS R$
  238. 2360  REC$=SPACE$(128):ZERO$=SPACE$(SIZE%-3):LSET ZERO$="0"
  239. 2370  K$=SPACE$(SIZE%-3)
  240. 2380  OPEN "R",2,MAST$
  241. 2390   FIELD 2, 127 AS MR$
  242. 2400  REM --------------------FORMS INPUT----------------------
  243. 2410  DIM AN$(AN%)             'ANSWERS IN AN$
  244. 2420  K%=0
  245. 2430  FOR L%=1 TO LINS%
  246. 2440    SRW$=RW$(L%)                    'SAVE FORM PROMPT
  247. 2450    PRINT USING "##";L%;:PRINT ".";
  248. 2460    IF INSTR(LEFT$(RW$(L%),1),"-")=1 THEN 2480
  249. 2470    IF INSTR(LEFT$(RW$(L%),1)," ")=0 THEN 2500
  250. 2480     RW$(L%)=RIGHT$(RW$(L%),LEN(RW$(L%))-1)
  251. 2490     GOTO 2460
  252. 2500     STAR%=INSTR(RW$(L%), "*")
  253. 2510     J%=INSTR(RW$(L%), ":")
  254. 2520     IF STAR%=0 THEN 2540
  255. 2530     IF STAR%<J% THEN 2590
  256. 2540     IF J%=0 THEN 2590
  257. 2550       PRINT "  ";LEFT$(RW$(L%),J%);
  258. 2560       K%=K%+1:RW$(L%)=RIGHT$(RW$(L%),LEN(RW$(L%))-J%)
  259. 2570       LINE INPUT AN$(K%)
  260. 2580       GOTO 2460
  261. 2590     J%=INSTR(RW$(L%), "*")
  262. 2600     IF J%=0 THEN 2680
  263. 2610       PRINT "  ";LEFT$(RW$(L%),J%);
  264. 2620       K%=K%+1:RW$(L%)=RIGHT$(RW$(L%),LEN(RW$(L%))-J%)
  265. 2630       LINE INPUT AN$(K%):K$= ""
  266. 2640     K$=LEFT$(AN$(K%),SIZE%-3)
  267. 2650     LNG%=LNG%+1:P0%=-LNG%
  268. 2660     PRINT "INDEXING BY ";K$
  269. 2670     GOSUB 1860:GOTO 2460             'INSERT K$,P0% INTO B-TREE
  270. 2680     RW$(L%)=SRW$
  271. 2690     IF D$="Found" THEN 2450              'try again
  272. 2700  NEXT L%
  273. 2710  TR$=STRING$(127, ":"):I1%=1
  274. 2720  FOR I%=1 TO AN%
  275. 2730    I2%=I1%+LEN(AN$(I%))-1
  276. 2740    MID$(TR$,I1%,I2%)=AN$(I%)
  277. 2750    I1%=I2%+2
  278. 2760  NEXT I%                       'pack answers into tr$
  279. 2770  LSET MR$=TR$
  280. 2780  PUT 2, LNG%                    'write random record
  281. 2790   PRINT"Inputs stored in file: ";MAST$
  282. 2800   REM--------------------DO IT AGAIN ?---------------------
  283. 2810  LINE INPUT"Do you want to enter more (Y/N) ? ";Y$
  284. 2820   IF Y$="Y" OR Y$="y" THEN 2420
  285. 2830  GOSUB 2110
  286. 2840  RUN"dbmenu"
  287. 2850  END
  288.