Download code

Jump to: navigation, search

Back to Chatterbot_(QBASIC)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

QChatt.bas

  1 REM The authors of this work have released all rights to it and placed it
  2 REM in the public domain under the Creative Commons CC0 1.0 waiver
  3 REM (http://creativecommons.org/publicdomain/zero/1.0/).
  4 REM 
  5 REM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  6 REM EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  7 REM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  8 REM IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  9 REM CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 10 REM TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 11 REM SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 12 REM 
 13 REM Retrieved from: http://en.literateprograms.org/Chatterbot_(QBASIC)?oldid=18699
 14 
 15 QChatt:
 16   DEFINT A-Z
 17   GOSUB Initialise
 18   GOSUB LoadData
 19   GOSUB Converse
 20   GOSUB StoreData
 21   SYSTEM
 22 
 23 Initialise:
 24   LET DictionarySize = 1000
 25   DIM Context$(DictionarySize) 'The character sequences that QChatt has already seen
 26   DIM Alternatives$(DictionarySize) 'The characters that QChatt may print after recognising a sequence.
 27   LET EmptyRow = 0
 28   LET EndOfResponseCharacter$ = CHR$(180)
 29   LET ContextLength = 6  'A bigger value makes QChatt more grammatical but slower learning.
 30   LET CurrentContext$ = STRING$(ContextLength, EndOfResponseCharacter$)
 31   LET DictionaryFile$ = "QCHATT.MEM"
 32   RANDOMIZE TIMER
 33   RETURN
 34 Converse:
 35   DO
 36     LINE INPUT "Human: "; Response$
 37     IF Response$ = "" THEN EXIT DO
 38     LET Response$ = Response$ + EndOfResponseCharacter$
 39     GOSUB MemoriseHumanResponse
 40     LET Response$ = ""
 41     GOSUB GenerateComputerResponse
 42     PRINT "Computer: "; Response$
 43   LOOP
 44   RETURN
 45 MemoriseHumanResponse:
 46   DO WHILE Response$ > ""
 47     LET CurrentCharacter$ = LEFT$(Response$, 1)
 48     LET Response$ = MID$(Response$, 2)
 49     GOSUB InsertCharacter
 50     LET CurrentContext$ = MID$(CurrentContext$, 2) + CurrentCharacter$
 51   LOOP
 52   RETURN
 53 GenerateComputerResponse:
 54    DO
 55      GOSUB Lookup
 56      LET CurrentCharacter$ = MID$(Alternatives$(DictionaryIndex), INT(RND * LEN(Alternatives$(DictionaryIndex))) + 1, 1)
 57      IF CurrentCharacter$ = "" THEN
 58        EXIT DO
 59      ELSE
 60        LET CurrentContext$ = MID$(CurrentContext$, 2) + CurrentCharacter$
 61        IF CurrentCharacter$ = EndOfResponseCharacter$ THEN
 62          EXIT DO
 63        ELSE
 64          LET Response$ = Response$ + CurrentCharacter$
 65        END IF
 66      END IF
 67    LOOP
 68    RETURN
 69 InsertCharacter:
 70   GOSUB Lookup
 71   IF INSTR(Alternatives$(DictionaryIndex), CurrentCharacter$) = 0 THEN
 72     LET Alternatives$(DictionaryIndex) = Alternatives$(DictionaryIndex) + CurrentCharacter$
 73   END IF
 74   RETURN
 75 Lookup:
 76   LET Context$(EmptyRow) = CurrentContext$
 77   LET DictionaryIndex = 0
 78   DO WHILE CurrentContext$ <> Context$(DictionaryIndex)
 79     LET DictionaryIndex = DictionaryIndex + 1
 80   LOOP
 81   IF DictionaryIndex = EmptyRow AND DictionaryIndex < DictionarySize THEN
 82     LET Alternatives$(EmptyRow) = ""
 83     LET EmptyRow = DictionaryIndex + 1
 84   END IF
 85   RETURN
 86 LoadData:
 87   OPEN DictionaryFile$ FOR APPEND AS #1
 88   CLOSE #1
 89   OPEN DictionaryFile$ FOR INPUT AS #1
 90   DO WHILE EmptyRow < DictionarySize AND NOT EOF(1)
 91     LINE INPUT #1, Context$(EmptyRow)
 92     LINE INPUT #1, Alternatives$(EmptyRow)
 93     LET EmptyRow = EmptyRow + 1
 94   LOOP
 95   CLOSE #1
 96   RETURN
 97 
 98 StoreData:
 99   OPEN DictionaryFile$ FOR OUTPUT AS #1
100   FOR DictionaryIndex = 0 TO EmptyRow - 1
101     PRINT #1, Context$(DictionaryIndex)
102     PRINT #1, Alternatives$(DictionaryIndex)
103   NEXT
104   CLOSE #1
105   RETURN


hijacker
hijacker
hijacker
hijacker