Adding and deleting NAMES

The browser program named BROWSE.NAMES has demonstrated how it is possible to sort and search an existing data file (in this case, the NAMES file) once a B-tree has been created for it. Because the BUILD program created three B-trees that sort NAMES by ZIP code, company, and last names, the BROWSE.NAMES browser program is able to display the NAMES file sorted those three different ways. However, if the GET.NAMES program is now used to add, change, or delete any names or addresses, the B-tree won't be updated to reflect the change. Therefore, it is necessary for GET.NAMES to adjust the B-TREE file any time an item in the NAMES file is edited.

To add new items to the B-tree, GET.NAMES must call the BTPINS subroutine any time a new item is added to the NAMES file. Similarly, GET.NAMES must call the BTPDEL subroutine whenever an item is dropped from the NAMES file and must be deleted from the B-tree. BTPDEL is the final subroutine in the B-TREE-P package, and like BTPINS, BTPFIND, and BTPSEQ, it never needs to be modified to work with any file:

    BTPDEL
001 SUBROUTINE BTPDEL(ROOT,SIZE,BFILE,DFILE,ID,ITEM)
002 CALL BTPKEY(ROOT, ID, ITEM, FK)
003 READ NID FROM BFILE, ROOT ELSE STOP "BTP15"
004 F = 0
005 100 READ N FROM BFILE, NID ELSE STOP "BTP16"
006 L = 0 ; R = N<1>+1
007 IF (R = 1) OR F THEN NXP = 1 ; PS = 1 ELSE
008   LOOP
009     PS = INT((L+R)/2)
010     SID = N<2, PS>
011     IF SID = ID THEN
012      F = 1 ; UID = NID ; UP = PS
013      R = L ; NXP = PS+1
014      END ELSE
015       NXP = PS
016       READ IT FROM DFILE,SID ELSE STOP "BTP17"
017       CALL BTPKEY(ROOT, SID, IT, KEY)
018       IG = (FK > KEY)
019       IF IG THEN L = PS ELSE R = PS
020       END
021   UNTIL (R-L) <= 1 DO REPEAT
022     IF NOT(F) THEN
023       IF IG THEN PS = R ; NXP = PS
024       END
025   END
026 NNID = N<3, NXP>
027 IF NNID # "" THEN
028   NID = NNID
029   GO TO 100
030   END
031 IF NOT(F) THEN CRT "Already deleted!" ; RETURN
032 IF N<2, PS> # ID THEN
033   READ UN FROM BFILE, UID ELSE STOP "BTP18"
034   UN<2, UP> = N<2, 1>
035   WRITE UN ON BFILE, UID
036   PS = 1
037   END
038 N = DELETE(N, 2, PS, 0)
039 N<1> = N<1> - 1
040 200 IF (N<1> < SIZE) AND (N<4> # "") THEN
041   PID = N<4>
042   READ P FROM BFILE, PID ELSE STOP "BTP19"
043   LOCATE(NID, P, 3; PS) ELSE STOP "BTP20"
044   NBID = P<3, PS+1> ; PP = PS
045   NBL = (NBID="")
046   IF NBL THEN NBID = P<3, PS-1> ; PP=PS-1
047   READ NB FROM BFILE, NBID ELSE STOP "BTP21"
048   TK = N<1> + NB<1>
049   IF TK >= (2*SIZE) THEN
050     MC = INT((NB<1>-N<1>)/2)
051     FOR I = 1 TO MC
052       IF NBL THEN
053         NBP = NB<1>
054         NP = 1
055         NBPP = NBP+1
056         NPP = NP
057         END ELSE
058             NP = N<1> + 1
059             NBP = 1
060             NPP = NP + 1
061             NBPP = NBP
062             END
063       N = INSERT(N, 2, NP, 0, P<2, PP>)
064       N<1> = N<1>+1
065       P<2, PP> = NB<2, NBP>
066       NB = DELETE(NB, 2, NBP, 0)
067       NB<1> = NB<1>-1
068       CID = NB<3, NBPP>
069       IF CID # "" THEN
070         N = INSERT(N, 3, NPP, 0, CID)
071         NB = DELETE(NB, 3, NBPP, 0)
072         READ C FROM BFILE, CID ELSE STOP "BTP22"
073         C<4> = NID
074         WRITE C ON BFILE, CID
075         END
076     NEXT I
077     WRITE NB ON BFILE, NBID
078     WRITE P ON BFILE, PID
079     WRITE N ON BFILE, NID
080     END ELSE
081         IF NBL THEN
082           IP = NB<1>+1
083           IPP = IP+1
084           GP = 1
085           END ELSE
086               IP = 1
087               IPP = 1
088               GP = N<1>+1
089               END
090         NB = INSERT(NB, 2, IP, 0, P<2, PP>)
091         NL = (NB<3,1> # "")
092         IF NL THEN
093           CID = N<3, GP>
094           NB = INSERT(NB, 3, IPP, 0, CID)
095           READ C FROM BFILE, CID ELSE STOP "BTP23"
096           C<4> = NBID
097           WRITE C ON BFILE, CID
098           END
099         IF NBL THEN
100           IP = IP+1 ; IPP = IPP+1
101           END
102         FOR I = N<1> TO 1 STEP -1
103           NB = INSERT(NB, 2, IP, 0, N<2, I>)
104           IF NL THEN
105             IF NBL THEN
106               NPP = I+1
107               END ELSE NPP = I
108             CID = N<3, NPP>
109             NB = INSERT(NB, 3, IPP, 0, CID)
110             READ C FROM BFILE, CID ELSE STOP "BTP24"
111             C<4> = NBID
112             WRITE C ON BFILE, CID
113             END
114         NEXT I
115         NB<1> = NB<1> + N<1> + 1
116         WRITE NB ON BFILE, NBID
117         DELETE BFILE, NID
118         P = DELETE(P, 2, PP, 0)
119         P = DELETE(P, 3, PS, 0)
120         P<1> = P<1>-1
121         IF P<1> <= 0 THEN
122           DELETE BFILE, PID
123           WRITE NBID ON BFILE, ROOT
124           NB<4> = ""
125           WRITE NB ON BFILE, NBID
126           END ELSE
127               WRITE P ON BFILE, PID
128               N = P
129               NID = PID
130               GO TO 200
131               END
132         END
133   END ELSE WRITE N ON BFILE, NID
134 RETURN
135 END

Note that BTPDEL uses a LOCATE in line 043 to make an unsorted search for NID in the third attribute of P, setting PS accordingly. The syntax of the LOCATE statement may have to be slightly different for your compiler.

Use the Editor to type in the above code for the BTPDEL subroutine, then compile and catalog the program.

Now use the Editor to modify the GET.NAMES program as shown below (new or changed lines have numbers in [square brackets]), so that it calls BTPINS and BTPDEL any time an item is added, changed, or deleted in the NAMES file:

      GET.NAMES
[001]OPEN "B-TREE" TO BFILE ELSE STOP
 002 OPEN "NAMES" TO NFILE ELSE STOP
 003 LOOP
 004   CRT "ID NUMBER":
 005   INPUT ID
 006 UNTIL ID = "" DO
[007]  ON.FILE = 1
[008]  READU ITEM FROM NFILE,ID ELSE ON.FILE=0;ITEM=""
[009]  OLD.ITEM = ITEM
 010   AMC = 1 ; LABEL = "FIRST NAME" ; GOSUB 100
 011   AMC = 2 ; LABEL = "LAST NAME" ; GOSUB 100
 012   AMC = 3 ; LABEL = "COMPANY" ; GOSUB 100
 013   AMC = 4 ; LABEL = "ADDRESS" ; GOSUB 100
 014   AMC = 5 ; LABEL = "CITY ST" ; GOSUB 100
 015   AMC = 6 ; LABEL = "ZIP CODE" ; GOSUB 100
 016   CRT "EXIT, FILE, OR DROP":
 017   INPUT COMMAND
[018]  LOCK 1 ; BREAK OFF
 019   BEGIN CASE
 020   CASE COMMAND = "FILE"
[021]    IF ON.FILE THEN
[022]      CALL BTPDEL("ZIP",5,BFILE,NFILE,ID,OLD.ITEM)
[023]      CALL BTPDEL("COMP",5,BFILE,NFILE,ID,OLD.ITEM)
[024]      CALL BTPDEL("LNAME",5,BFILE,NFILE,ID,OLD.ITEM)
[025]      END
[026]    CALL BTPINS("ZIP",5,BFILE,NFILE,ID,ITEM)
[027]    CALL BTPINS("COMP",5,BFILE,NFILE,ID,ITEM)
[028]    CALL BTPINS("LNAME",5,BFILE,NFILE,ID,ITEM)
 029     WRITE ITEM ON NFILE, ID
 030   CASE COMMAND = "DROP"
[031]    IF ON.FILE THEN
[032]      CALL BTPDEL("ZIP",5,BFILE,NFILE,ID,OLD.ITEM)
[033]      CALL BTPDEL("COMP",5,BFILE,NFILE,ID,OLD.ITEM)
[034]      CALL BTPDEL("LNAME",5,BFILE,NFILE,ID,OLD.ITEM)
[035]      END
 036     DELETE NFILE, ID
 037   CASE 1
[038]    CRT "EXITING" ; RELEASE
 039   END CASE
[040]  BREAK ON ; UNLOCK 1
 041 REPEAT
 042 STOP

Compile and catalog the new version of GET.NAMES and then execute it to add some new names and addresses to the NAMES file, and to change or delete some existing items. Then use BROWSE.NAMES to examine the NAMES file and the items you edited. Use the Z, C, and L commands in BROWSE.NAMES to verify that all items are still displayed in the correct sort order: by ZIP, by company, and by last name.