Black Box 4/BlackBox.cdr/progbas/qbnws302.arj/HASH.ZIP/HASH.BAS

BASIC Source File | 1992-06-20 | 15.3 KB | 518 lines

' Hashed Access Demonstration Program For The QuickBasic Echo
' By Mike Avery, Started 12-28-91
' Version 1:00.00 - Make it work. 12-28-91
' Version 1:01.00 - Add Disk Functions 12-29-91
' ========================================================================

DECLARE FUNCTION Hash! (TestString$)
DECLARE SUB GetData (Key$, Index%, SeekCount%, SaveIndex%)
DECLARE SUB Waiter ()
DECLARE FUNCTION WhackIt$ (InputString$)

CONST DeletedValue$ = "EXPLETIVE DELETED"
CONST ArraySize% = 531         'Change the size here - the rest adjusts itself
CONST RetryLimit% = 100        'I get bored easily....
CONST ScreenLimit% = 21        'how many lines do we show at once?
CONST True = -1: CONST False = NOT (True)

DIM SHARED A$(ArraySize%, 1)          'our little data base
DIM SHARED SortSpace$(ArraySize%, 1)  'Workspace for sorted lists

PowerMax% = INT((LOG(ArraySize%) / LOG(2)) + 2)
DIM SHARED PowersOfTwo%(PowerMax%)

'build the table - lookup is faster than calculation
FOR I% = 0 TO PowerMax%
    PowersOfTwo%(I%) = 2 ^ I%
NEXT I%

DO WHILE TestName$ <> "STOP"
   CLS
   PRINT "Doofus Phone Book System"
   PRINT
   PRINT
   INPUT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop"; TestName$
   TestName$ = UCASE$(RTRIM$(LTRIM$(TestName$)))

   IF TestName$ = "DUMP" THEN
      GOSUB DumpIt

   ELSEIF TestName$ = "SORT" THEN
      GOSUB SortIt

   ELSEIF TestName$ = "ANALYSE" THEN
      GOSUB Analyse

   ELSEIF TestName$ = "HELP" THEN
      GOSUB Help

   ELSEIF TestName$ = "LOAD" THEN
      GOSUB LoadIt

   ELSEIF TestName$ = "SAVE" THEN
      GOSUB SaveIt

   ELSEIF TestName$ <> "" AND TestName$ <> "STOP" THEN
      CALL GetData(TestName$, Index%, SeekCount%, SaveIndex%)

      ' At this point, one of 3 conditions exists.
      ' 1. We ran out of retries, and it doesn't matter what Index% points to,
      ' 2. Index% points to our data, or
      ' 3. Index% points to an empty record and SaveIndex may or may not
      '    point to a deleted record we can reuse.

      PRINT
      PRINT "It took "; SeekCount%; "tries to determine that..."
      'in a productional program, you'd probably drop that message...

      PRINT

      IF SeekCount% >= RetryLimit% THEN
         PRINT "The data base is full and/or needs to be resized"
         YesOrNo$ = ""
         DO WHILE YesOrNo$ <> "Y" AND YesOrNo$ <> "N"
            INPUT "Do you want to see a data base dump (Y/N)"; YesOrNo$
            IF YesOrNo$ <> "" THEN
               YesOrNo$ = WhackIt$(YesOrNo$)
            END IF
            IF YesOrNo$ = "Y" THEN
               GOSUB DumpIt
            ELSEIF YesOrNo$ <> "N" THEN
               PRINT "Please Enter A Y for Yes or a N for NO."
            END IF
         LOOP

         TestName$ = "STOP"'force a shutdown
         CALL Waiter
         ' save data base here, if converted to a disk based system

      ELSEIF A$(Index%, 0) = TestName$ THEN
         PRINT A$(Index%, 0); "'s Phone Number Is "; A$(Index%, 1); "."
         Action$ = "Dummy"
         DO WHILE Action$ <> "" AND Action$ <> "C" AND Action$ <> "D"
            INPUT "Change the number, Delete The Number, or enter"; Action$

            IF Action$ <> "" THEN
               Action$ = WhackIt$(Action$)

               IF Action$ = "C" THEN
                  'else if we are to change the number
                  INPUT "New phone number please"; PhoneNumber$
                  PhoneNumber$ = UCASE$(RTRIM$(LTRIM$(PhoneNumber$)))

                  IF PhoneNumber$ = "" THEN
                     PRINT "Number not changed"
                  ELSE
                     A$(Index%, 1) = PhoneNumber$
                     PRINT "Phone number has been updated."
                  END IF

               ELSEIF Action$ = "D" THEN
                  A$(Index%, 0) = DeletedValue$
                  PRINT "Entry has been deleted."

               ELSE
                  'an invalid entry was made
                  PRINT "Please enter a D to Delete the number,"
                  PRINT "a C to Change it, or"
                  PRINT "just press Enter to continue."
                  Action$ = "DUMMY"
               END IF
            END IF
         LOOP

      ELSE
         PRINT TestName$; "'s Phone Number Is Not On File.  You May Enter It To Add"
         PRINT "It, Or Just Press "; CHR$(34); "ENTER"; CHR$(34); " To Continue.";
         INPUT PhoneNumber$
         PhoneNumber$ = UCASE$(RTRIM$(LTRIM$(PhoneNumber$)))

         IF PhoneNumber$ <> "" THEN
            IF SaveIndex% <> -1 THEN
               'reuse delete space
               Index% = SaveIndex%
               PRINT "We are reclaiming unused space!  Ain't it great!"
               CALL Waiter
            END IF

            A$(Index%, 0) = TestName$
            A$(Index%, 1) = PhoneNumber$
         END IF
      END IF

   END IF
LOOP

ExitRoutine:
SYSTEM

Analyse:
'process all the data elements in A$ to see:
' how full A$ is,
' best and worst case access to A$,
' mean, SD of access count

' Statistics routines "borrowed" in part from
' "Some Common Basic Programs" pg 121-122
' by Lon Poole and Mary Borchers
' Published by Adam Osborne
' Copyright 1977
' pages 121-123
PRINT "Analysis Begins.... Please Wait....."

Best% = 999
Worst% = 0
S = 0 ' we are dealing with a population, not a sample
N = 0 ' count of active elements
M = 0 ' Sum of X^2
P = 0 ' Sum of X

FOR I% = 0 TO ArraySize%
    IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue$ THEN
       CALL GetData(A$(I%, 0), Index%, Tries%, FirstDeleted%)
       N = N + 1              ' Bump entry count
       P = P + Tries%         ' Bump sum of X
       M = M + (Tries% ^ 2)   ' Bump sum of X^2

       IF Tries% < Best% THEN
          Best% = Tries%
          BestOne% = Index%
       END IF

       IF Tries% > Worst% THEN
          Worst% = Tries%
          WorstOne% = Index%
       END IF
    END IF
NEXT I%

IF N > 0 THEN
   PRINT "Access Analysis....."
   R = P / N
   PRINT "Number Of Entries ="; N
   PRINT "Percent Full ="; INT((N / (ArraySize% + 1)) * 100); "%"
   PRINT "Average Access ="; R; "Seeks."
   V = (M - N * R ^ 2) / (N - S)
   SD = SQR(V)
   PRINT "Standard Deviation ="; SD
   PRINT "Best Access ="; Best%; "Seeks On "; A$(BestOne%, 0); "."
   PRINT "Worst Access ="; Worst%; "Seeks On "; A$(WorstOne%, 0); "."
ELSE
   PRINT "No Data To Analyze.  Sorry."
END IF

CALL Waiter
RETURN

DumpIt:
DisplayControl% = 0
FOR I% = 0 TO ArraySize%
    PRINT I%, A$(I%, 0), A$(I%, 1)
    DisplayControl% = DisplayControl% + 1
    IF DisplayControl% > ScreenLimit% THEN
       CALL Waiter
       DisplayControl% = 0
    END IF
NEXT I%

CALL Waiter
RETURN

ErrorHandler:

PRINT "ErrorHandler Sez...."

IF ERR = 53 OR ERR = 76 OR ERR = 68 OR ERR = 52 OR ERR = 64 OR ERR = 75 THEN
   PRINT "A file you wanted to process, "; FileName$
   PRINT "Could not be found/created."
   Found = False
   CALL Waiter
   RESUME NEXT
END IF

IF ERR = 61 THEN
   PRINT "Sorry, the disk is full."
ELSE
   PRINT "You had an Error #"; ERR
END IF

PRINT "Press any key to quit...."
K$ = ""
DO WHILE K$ = ""
   K$ = INKEY$
LOOP
RESUME ExitRoutine

Help:
'Display a primitive help screen
CLS
PRINT "Doofus Phone Book System"
PRINT
PRINT
PRINT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop? HELP"
PRINT
PRINT "The Doofus Phone Book System was written as a demonstration of Hashed"
PRINT "Data Access, rather than as a phone book system.  If it works for you,"
PRINT "fine, but that was not the author's intent."
PRINT
PRINT "At the first prompt "; CHR$(34); "Name/Help/Dump/Sort/Load/Save/Analyse:"; CHR$(34); ","
PRINT "You may enter a name to be added or looked up in the data base by entering"
PRINT "the name."
PRINT "You may ask for help by entering "; CHR$(34); "HELP"; CHR$(34); "."
PRINT "You may see a raw dump of the data array by entering "; CHR$(34); "DUMP"; CHR$(34); "."
PRINT "You may see a sorted data dump of the array by entering "; CHR$(34); "SORT"; CHR$(34); "."
PRINT "You may load or save the data to/from disk with the LOAD and SAVE commands."
PRINT "You may analyse the data set by entering the command "; CHR$(34); "ANALYSE"; CHR$(34); "."
PRINT "You may exit the application by entering the command "; CHR$(34); "STOP"; CHR$(34); "."
CALL Waiter
CLS
PRINT "Doofus Phone Book System"
PRINT
PRINT
PRINT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop? HELP"
PRINT
PRINT "Once you have called up a phone number entry, you may continue by pressing"
PRINT CHR$(34); "ENTER"; CHR$(34); ", or you may change the data by entering a "; CHR$(34); "C"; CHR$(34); ","
PRINT "or you may delete the data by pressing a "; CHR$(34); "D"; CHR$(34); "."
CALL Waiter
CLS
RETURN

LoadIt:
'load the data from a data file

Free% = 0
Empty% = Empty% + 1

FOR I% = 0 TO ArraySize%
    IF A$(I%, 0) = "" THEN
       Free% = Free% + 1
       Empty% = Empty% + 1

    ELSEIF A$(I%, 0) = DeletedValue$ THEN
       Free% = Free% + 1
    END IF
NEXT I%

IF Empty% = 0 THEN
   GOSUB SorryFull

ELSE
   INPUT "File To Load From:"; FileName$
   ON ERROR GOTO ErrorHandler
   Found = True
   OPEN FileName$ FOR INPUT AS 1

   IF Found = True THEN
      DO WHILE NOT EOF(1) AND Free% > 0
         INPUT #1, TestName$, PhoneNumber$
         CALL GetData(TestName$, Index%, Seeks%, SaveIndex%)

         IF SeekCount% >= RetryLimit% THEN
            PRINT "The data base is full and/or needs to be resized"
            YesOrNo$ = ""
            DO WHILE YesOrNo$ <> "Y" AND YesOrNo$ <> "N"
               INPUT "Do you want to see a data base dump (Y/N)"; YesOrNo$
               IF YesOrNo$ <> "" THEN
                  YesOrNo$ = WhackIt$(YesOrNo$)
               END IF
               IF YesOrNo$ = "Y" THEN
                  GOSUB DumpIt
               ELSEIF YesOrNo$ <> "N" THEN
                  PRINT "Please Enter A Y for Yes or a N for NO."
               END IF
            LOOP

            Free% = 0 'force a shutdown
            CALL Waiter

         ELSEIF A$(Index%, 0) = TestName$ THEN
            ' the value is already on file
            ' we'll just replace the old value for now,
            ' and keep on truckin - we could ask the user
            ' what we should do, but not for a test program!
            A$(Index%, 1) = PhoneNumber$
            PRINT A$(Index%, 0); "has been updated!"

         ELSE
            IF SaveIndex% <> -1 THEN
               'reuse deleted space
               Index% = SaveIndex%
               PRINT "We are reclaiming unused space!  Ain't it great!"
            END IF
            A$(Index%, 0) = TestName$
            A$(Index%, 1) = PhoneNumber$
            Free% = Free% - 1
         END IF

         IF Free% < 1 THEN
            PRINT "The data base has been completely filled."
            PRINT "Some data was not loaded from the file you selected."
            PRINT
            GOSUB SorryFull

            CALL Waiter
         END IF
      LOOP
      CLOSE 1
   END IF
   ON ERROR GOTO 0
END IF

RETURN

SaveIt:
'Save data to a selected file

ON ERROR GOTO ErrorHandler

INPUT "Name of file to save data to:"; FileName$

OPEN FileName$ FOR OUTPUT AS 1
FOR I% = 0 TO ArraySize%
    IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue THEN
       PRINT #1, A$(I%, 0); ","; A$(I%, 1)
    END IF
NEXT I%
CLOSE 1
RETURN

SortIt:
' convert, sort, and dump the data base

'convert the hashed A$() into a packed SortSpace$()

PRINT "Converting the data into a linear array...."
NextEntry% = 0
FOR I% = 0 TO ArraySize%
    IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue$ THEN
       SortSpace$(NextEntry%, 0) = A$(I%, 0)
       SortSpace$(NextEntry%, 1) = STR$(I%)
       'track the location of the data, not the data....
       NextEntry% = NextEntry% + 1
    END IF
NEXT I%

IF NextEntry% <= 0 THEN
   PRINT "No Data Was Found To Display."

ELSE
'now that all the data has been moved from A$() to SortSpace$(), we
'need to sort it.  How about an exchange sort?
   LastItem% = NextEntry% - 1
   IF LastItem% > 1 THEN
      PRINT "Sorting"; LastItem% + 1; "items.  Please Wait....."
      FOR I% = 0 TO LastItem% - 1
          Lowest% = I%
          FOR J% = I% + 1 TO LastItem%
              CompareCount! = CompareCount! + 1
              IF SortSpace$(J%, 0) < SortSpace$(Lowest%, 0) THEN
                 Lowest% = J%
              END IF
          NEXT J%
          IF Lowest% <> I% THEN
             SWAP SortSpace$(I%, 0), SortSpace$(Lowest%, 0)
             SWAP SortSpace$(I%, 1), SortSpace$(Lowest%, 1)
          END IF
      NEXT I%
   ELSE
      PRINT "1 item found, the sort will be skipped this time...."
   END IF

   'Now the keys are sorted, so let's display the data....
   PRINT "Order", "Name", "Phone #", "Place in A$"

   DisplayCount% = 0
   FOR I% = 0 TO LastItem%
       Pointer% = VAL(SortSpace$(I%, 1))
       PRINT I%, A$(Pointer%, 0), A$(Pointer%, 1), Pointer%
       DisplayCount% = DisplayCount% + 1
       IF DisplayCount% > ScreenLimit% THEN
          CALL Waiter
          DisplayCount% = 0
       END IF
   NEXT I%
END IF
CALL Waiter
RETURN

SorryFull:
PRINT "Sorry, but there is no space available in the array."
PRINT "Try saving your data, stopping this program, resizing"; CHR$(34); "ArraySize%"; CHR$(34); ","
PRINT "reloading the saved data, and then retry this load."
RETURN

SUB GetData (Key$, Index%, SeekCount%, SaveIndex%)
' Try to get the index to the record that that contains Key$ as it's key
' Key$ - the value are looking for
' Found% - did we find Key$ - True/False returned
' Index% - a pointer to where Key$ was found
' SeekCount% - how many tries it took us to fing Key$
' SaveIndex% - the pointer to the first deleted value we found, if any

Index% = Hash(Key$) 'start the search
SaveIndex% = -1
SeekCount% = 1

IF A$(Index%, 0) <> "" AND A$(Index%, 0) <> Key$ THEN
   'if data in entry, and not a match, do a retry
   ReHashCount% = 0

   DO WHILE SeekCount% < RetryLimit% AND A$(Index%, 0) <> "" AND A$(Index%, 0) <> Key$
      IF A$(Index%, 0) = DeletedValue$ AND SaveIndex% = -1 THEN
        'if this is the first deleted value, save it for data insertion
        SaveIndex% = Index%
      END IF

      Index% = Index% + PowersOfTwo%(ReHashCount%)
      DO WHILE Index% > ArraySize%
         Index% = Index% - ArraySize%
      LOOP

      ReHashCount% = ReHashCount% + 1
      IF ReHashCount% > PowerMax% THEN
         ReHashCount% = 0
      END IF

      SeekCount% = SeekCount% + 1

   LOOP
END IF

END SUB

FUNCTION Hash (TestString$)
' turn TestString into a number in the range of 0 - ArraySize%
' the function can be tailored to suit the users needs

Trial = 0

FOR I% = 1 TO LEN(TestString$)
    Trial = Trial + ASC(MID$(TestString$, I%, 1))
NEXT I%

Hash = (Trial * Trial) MOD ArraySize%

END FUNCTION

SUB Waiter
' wait for a keypress, then return to caller
PRINT "Press (almost) any key to continue..."
K$ = ""
DO WHILE K$ = ""
   K$ = INKEY$
LOOP
END SUB

FUNCTION WhackIt$ (InputString$)
'whack the input string -
' strip leading and trailing spaces,
' make the remainder upper case, and
' make it a single letter response.
TestString$ = UCASE$(RTRIM$(LTRIM$(InputString$)))
IF LEN(TestString$) > 1 THEN
   TestString$ = LEFT$(TestString$, 1)
END IF
WhackIt$ = TestString$
END FUNCTION