ftp.whtech.com/ftp.whtech.com.tar/ftp.whtech.com/compuserve/Basic/LEARN.SF9

Text File | 2006-10-19 | 12KB | 544 lines

  SF99-WARE
  ---------


  +++++++++++++++++++++++++++++++++++
       SF99-WARE is a new feature  in
  SUBFILE99.   Each  issue  SF99-WARE
  will    feature   a   full - length
  commercial-quality program free  to
  all who subscribe to SF99.
       If you have a program that  you
  think other TI'ers might enjoy, SF99
  will pay you  to  publish  it  here.
  Write to SF99 for more info.
  +++++++++++++++++++++++++++++++++++



  THE TI LEARNING MACHINE
  -----------------------



       Below is a program that actually
  learns  from  the  user! This program
  uses a binary search tree routine  to
  ask  you  questions,  look  into it's
  "memory" for an  answer  and  respond
  accordingly.   It's  a  great program
  for children (they get to "teach" the
  computer,  not the other way around!)
  and it's an excellent example of  the
  use  of  subroutines  and  the binary
  search tree.


       Teaching the Learning Machine
       -----------------------------

       The Learning  Machine  can  only
  learn   by   asking  questions.   The
  firsttime you ever run  The  Learning
  Machine,  you  have  to  give  it the
  first answers.  After that,  Learning
  Machine  will build upon each new bit
  of information you give it.  Below is
  a  sample  session  with The Learning
  Machine:

       1) At the Main Menu  select  <B>
  for Begin Session.

       2)  Answer N to the question "Is
  a file in memory?"

       3) At the next menu select 2  to
  start a new file
       4)  The  Learning Machine learns
  to  recognize  somthing   through   a
  single distinguishing characteristic.
  In this session  we  will  teach  the
  Learning Machine about books.  At the
  first prompt type "A Novel"  for  the
  first characteristic.

       5)  At  the next prompt type the
  answer "Oliver Twist." The machine is
  now   ready  to  start  learning  new
  items.

       6) The Learning Machine will now
  ask  you a question: "Is it a novel?"
  For now answer NO.

       7) Since  the  Learning  Machine
  knows  of no other books, it gives up
  and asks you for the correct  answer.
  This time type "Starting FORTH."

       8)  When  it  asks  you  for the
  distinguishing  characteristic,  type
  "about computers."

       9)  Continue  this process until
  you  have  amassed  a  good  body  of
  questions  (at  present  the Learning
  Machine can only  keep  track  of  50
  answers  - change this in line 450 if
  you wish!).

       10) To end a session just select
  <E>  at  the  Main Menu and save your
  file to disk or cassette.


       Building Knowledge
       ------------------

       Several topics of knowledge base
  are  available through SF99 including
  BOOKS, MUSIC, MOVIES, and  COMPUTERS.
  If you'd like a copy of the disk that
  contains all  of  these  four  files,
  send  an  initialized  SSSD disk with
  self-addressed/stamped envelope to:

       THE LEARNING MACHINE FILES
       c/o SUBFILE99
       POB 533
       Bowling Green, Ohio 43402








100 REM  *******************
110 REM  *                 *
120 REM  *      T H E      *
130 REM  *                 *
140 REM  * L E A R N I N G *
150 REM  *                 *
160 REM  *  M A C H I N E  *
170 REM  *                 *
180 REM  *******************
190 REM
200 REM       TI-BASIC
210 REM
220 REM      M AMUNDSEN
230 REM      TOLEDO, OH
240 REM        7/8/84
250 REM
260 REM      ***********
270 REM      *VARIABLES*
280 REM      ***********
290 REM
300 REM   A$-ANSWER
310 REM   C$-CHARACTERISTIC
320 REM  Q1$-QUEST HEADER
330 REM  Q2$-QUEST TAIL
340 REM  T1$-TEMP$
350 REM  T2$ TEMP$
360 REM   LL-LEFT  LINK
370 REM   RL-RIGHT LINK
380 REM    P-ARRAY POINTER
390 REM    N-# OF ITEMS
400 REM
410 DEF TABR=29-LEN(M$)
420 DEF TABC=(28-LEN(M$))/2
430 Q1$="IS IT "
440 Q2$="?(Y/N)"
450 DIM C$(50),A$(50),LL(50),RL(50)
460 REM
470 CALL CLEAR
480 CALL SCREEN(6)
490 FOR L=1 TO 12
500 CALL COLOR(L,16,1)
510 NEXT L
520 REM
530 REM  *LOGO*
540 REM
550 FOR X=133 TO 143
560 READ X$
570 CALL CHAR(X,X$)
580 LOGO$=LOGO$&CHR$(X)
590 NEXT X
600 DATA 3C4299A1A199423C,6324242320202473,0C92928C9292920C,1010505078101038,,
6094F79494949090
610 DATA 0000679494170404,00001C91911C,0304E21111E10106,000039444438,
4088DC8888888804
620 REM
630 REM   **************
640 REM   *TITLE SCREEN*
650 REM   **************
660 REM
670 REM
680 FOR L=1 TO 14
690 READ M$
700 PRINT TAB(TABC);M$
710 NEXT L
720 DATA T H E,,L E A R N I N G,,M A C H I N E,,,,,,,,,
730 REM
740 CALL HCHAR(8,7,42,19)
750 CALL HCHAR(16,7,42,19)
760 CALL VCHAR(9,7,42,7)
770 CALL VCHAR(9,25,42,7)
780 M$=LOGO$
790 PRINT TAB(TABC);M$:::
800 GOSUB 3800
810 REM
820 REM  *****************
830 REM  *MAIN SUPERVISOR*
840 REM  *****************
850 REM
860 CALL CLEAR
870 PRINT "SELECT ONE:"::::
880 PRINT TAB(7);"<B>EGIN SESSION":::TAB(7);"<L>IST ITEMS":::TAB(7);
"<I>NSPECT FILE":::TAB(7);"<E>ND SESSION"::::
890 XR$="BLIE"
900 GOSUB 3710
910 ON XR GOSUB 960,1120,1230,1340
920 GOTO 860
930 REM
940 REM  *BEGIN SESSION*
950 REM
960 CALL CLEAR
970 PRINT "IS A FILE IN MEMORY?(Y/N)":::
980 GOSUB 3960
990 IF XR=1 THEN 1070
1000 PRINT "SELECT ONE:"::::TAB(5);"1 - OPEN  OLD FILE":::TAB(5);
"2 - START NEW FILE":::::
1010 XT=2
1020 GOSUB 3880
1030 IF XK=1 THEN 1060
1040 GOSUB 3490
1050 GOTO 1070
1060 GOSUB 2900
1070 GOSUB 1480
1080 RETURN
1090 REM
1100 REM  *LIST ITEMS*
1110 REM
1120 CALL CLEAR
1130 PRINT "USE FILE IN MEMORY?(Y/N)":::
1140 GOSUB 3960
1150 IF XR=1 THEN 1180
1160 GOSUB 3170
1170 GOSUB 2900
1180 GOSUB 2290
1190 RETURN
1200 REM
1210 REM  *INSPECT FILE*
1220 REM
1230 CALL CLEAR
1240 PRINT "USE FILE IN MEMORY?(Y/N)":::
1250 GOSUB 3960
1260 IF XR=1 THEN 1290
1270 GOSUB 3170
1280 GOSUB 2900
1290 GOSUB 2570
1300 RETURN
1310 REM
1320 REM  *END SESSION*
1330 REM
1340 GOSUB 3170
1350 PRINT ::"CONTINUE THE SESSION?(Y/N)":::
1360 GOSUB 3960
1370 IF XR=1 THEN 860
1380 REM
1390 PRINT :::"PROGRAM TERMINATED":::
1400 FOR L=1 TO 500
1410 NEXT L
1420 CALL CLEAR
1430 END
1440 REM  **************
1450 REM  *TAKE A GUESS*
1460 REM  **************
1470 REM
1480 P=1
1490 CALL CLEAR
1500 PRINT "LEARNING SESSION":"===============":::
1510 REM
1520 REM  CHARACTERISTIC
1530 REM
1540 M$=Q1$&C$(P)&Q2$
1550 GOSUB 4080
1560 GOSUB 3960
1570 IF XR=1 THEN 1750
1580 REM
1590 REM      WRONG
1600 REM
1610 IF RL(P)=999 THEN 1680
1620 P=RL(P)
1630 PRINT ::
1640 GOTO 1540
1650 REM
1660 REM   I GIVE UP!
1670 REM
1680 GOSUB 2060
1690 RL(P)=N+1
1700 GOSUB 2180
1710 GOTO 2000
1720 REM
1730 REM  ACTUAL ITEM
1740 REM
1750 PRINT :::
1760 M$=Q1$&A$(P)&Q2$
1770 GOSUB 4080
1780 GOSUB 3960
1790 IF XR=1 THEN 1970
1800 REM
1810 REM     WRONG
1820 REM
1830 IF P=LL(P)THEN 1900
1840 P=LL(P)
1850 PRINT ::
1860 GOTO 1540
1870 REM
1880 REM   I GIVE UP!
1890 REM
1900 GOSUB 2060
1910 LL(P)=N+1
1920 GOSUB 2180
1930 GOTO 2000
1940 REM
1950 REM    CORRECT!
1960 REM
1970 PRINT ::::". . . I THOUGHT SO!"::::
1980 FOR L=1 TO 500
1990 NEXT L
2000 RETURN
2010 REM
2020 REM  ****************
2030 REM  *LEARN NEW ITEM*
2040 REM  ****************
2050 REM
2060 CALL CLEAR
2070 PRINT "I GIVE UP!":"==========":::
2080 PRINT "WHAT IS THE ANSWER?"::
2090 INPUT T1$
2100 PRINT ::"I SEE...":::"WHAT'S DISTINGUISHES"::T1$::"FROM"::A$(P);"?":::
2110 INPUT T2$
2120 RETURN
2130 REM
2140 REM  **************
2150 REM  *UPDATE LINKS*
2160 REM  **************
2170 REM
2180 N=N+1
2190 C$(N)=T2$
2200 A$(N)=T1$
2210 LL(N)=N
2220 RL(N)=999
2230 RETURN
2240 REM
2250 REM  ************
2260 REM  *LIST ITEMS*
2270 REM  ************
2280 REM
2290 CALL CLEAR
2300 PRINT "LIST FILE":"=========":::
2310 PRINT "WANT A PRINTOUT?(Y/N)"::
2320 GOSUB 3960
2330 IF XR=0 THEN 2380
2340 PRINT "ENTER DEVICENAME:"::
2350 INPUT DN$
2360 DN=1
2370 OPEN #DN:DN$
2380 FOR L=0 TO DN
2390 PRINT #L:"THE FOLLOWING ITEMS ARE IN":"THE FILE: ";FN$::
2400 NEXT L
2410 FOR L=1 TO N
2420 FOR L2=0 TO DN
2430 PRINT #L2:A$(L)
2440 NEXT L2
2450 NEXT L
2460 IF DN=0 THEN 2490
2470 CLOSE #DN
2480 DN=0
2490 PRINT :::
2500 GOSUB 3800
2510 RETURN
2520 REM
2530 REM  **************
2540 REM  *INSPECT FILE*
2550 REM  **************
2560 REM
2570 CALL CLEAR
2580 PRINT "INSPECT FILE":"============"::::
2590 PRINT "WANT A PRINTOUT?(Y/N)"::
2600 GOSUB 3960
2610 IF XR=0 THEN 2660
2620 PRINT "ENTER DEVICENAME:"::
2630 INPUT DN$
2640 DN=1
2650 OPEN #DN:DN$
2660 FOR L=0 TO DN
2670 PRINT #L:"THE FOLLOWING ITEMS ARE IN":"THE FILE: ";FN$::
2680 NEXT L
2690 FOR L=1 TO N
2700 FOR L2=0 TO DN
2710 PRINT #L2:"   L -";L
2720 PRINT #L2:"C$(L)-";C$(L)
2730 PRINT #L2:"A$(L)-";A$(L)
2740 PRINT #L2:"  LL -";LL(L)
2750 PRINT #L2:"  RL -";RL(L)
2760 PRINT #L2:
2770 NEXT L2
2780 NEXT L
2790 IF DN=0 THEN 2820
2800 CLOSE #DN
2810 DN=0
2820 PRINT ::
2830 GOSUB 3800
2840 RETURN
2850 REM
2860 REM   ***********
2870 REM   *OPEN FILE*
2880 REM   ***********
2890 REM
2900 CALL CLEAR
2910 PRINT "LOAD FROM:"::::TAB(5);"1 - DISK":::TAB(5);"2 - CASSETTE"::::::
2920 XT=2
2930 GOSUB 3880
2940 IF XK=2 THEN 2980
2950 INPUT "FILENAME: DSK":FN$
2960 FN$="DSK"&FN$
2970 GOTO 2990
2980 FN$="CS1"
2990 OPEN #1:FN$,SEQUENTIAL,INPUT ,INTERNAL,FIXED 192
3000 PRINT :::TAB(7);"LOADING FILE..."
3010 REM
3020 REM  GET DATA
3030 REM
3040 INPUT #1:N
3050 FOR L=1 TO N
3060 INPUT #1:C$(L),LL(L),A$(L),RL(L)
3070 NEXT L
3080 CLOSE #1
3090 PRINT ::"THERE ARE";N:"RECORDS ON FILE.":::
3100 FOR L=1 TO 500
3110 NEXT L
3120 RETURN
3130 REM   ************
3140 REM   *SAVE  FILE*
3150 REM   ************
3160 REM
3170 CALL CLEAR
3180 PRINT "SAVE THIS FILE?(Y/N)":::::
3190 GOSUB 3960
3200 IF XR=1 THEN 3220
3210 GOTO 3430
3220 PRINT "SAVE TO:"::::TAB(5);"1 - DISK":::TAB(5);"2 - CASSETTE"::::::
3230 XT=2
3240 GOSUB 3880
3250 IF XK=2 THEN 3290
3260 INPUT "FILENAME: DSK":FN$
3270 FN$="DSK"&FN$
3280 GOTO 3300
3290 FN$="CS1"
3300 OPEN #1:FN$,SEQUENTIAL,INTERNAL,OUTPUT,FIXED 192
3310 PRINT :::TAB(7);"SAVING FILE..."
3320 REM
3330 REM  SAVE DATA
3340 REM
3350 PRINT #1:N
3360 FOR L=1 TO N
3370 PRINT #1:C$(L),LL(L),A$(L),RL(L)
3380 NEXT L
3390 CLOSE #1
3400 PRINT :::"THERE ARE NOW";N:"RECORDS ON FILE.":::
3410 FOR L=1 TO 500
3420 NEXT L
3430 RETURN
3440 REM
3450 REM  ****************
3460 REM  *START NEW FILE*
3470 REM  ****************
3480 REM
3490 CALL CLEAR
3500 PRINT "START NEW FILE":"=============="::::
3510 PRINT "ENTER FIRST CHARACTERISTIC:"::
3520 INPUT C$(1)
3530 PRINT :"ENTER THE FIRST ANSWER:"::
3540 INPUT A$(1)
3550 LL(1)=1
3560 RL(1)=999
3570 N=1
3580 PRINT :::
3590 GOSUB 3800
3600 RETURN
3610 REM
3620 REM  *****************
3630 REM  *               *
3640 REM  *  SUBROUTINES  *
3650 REM  *               *
3660 REM  *****************
3670 REM
3680 REM
3690 REM   *KEY-LET/B*
3700 REM
3710 CALL SOUND(150,1400,0)
3720 CALL KEY(0,XK,XS)
3730 IF XS=0 THEN 3720
3740 XR=POS(XR$,CHR$(XK),1)
3750 IF XR=0 THEN 3720
3760 RETURN
3770 REM
3780 REM   *KEY-CON/B*
3790 REM
3800 PRINT " PRESS ANY KEY TO CONTINUE "
3810 CALL SOUND(150,600,5)
3820 CALL KEY(3,XK,XS)
3830 IF XS=0 THEN 3820
3840 RETURN
3850 REM
3860 REM   *KEY-NUM/B*
3870 REM
3880 CALL SOUND(150,1000,0)
3890 CALL KEY(3,XK,XS)
3900 IF (XK<49)+(XK>XT+48)+(XS=0)THEN 3890
3910 XK=XK-48
3920 RETURN
3930 REM
3940 REM   *KEY-ANS/B*
3950 REM
3960 CALL SOUND(150,800,0)
3970 CALL KEY(3,XK,XS)
3980 IF XS=0 THEN 3970
3990 IF XK<>89 THEN 4020
4000 XR=1
4010 GOTO 4040
4020 IF XK<>78 THEN 3970
4030 XR=0
4040 RETURN
4050 REM
4060 REM  *WRAP/B*
4070 REM
4080 X1=0
4090 M$=M$&" "
4100 X2=POS(M$," ",X1+1)
4110 PRINT SEG$(M$,X1+1,X2-X1);
4120 IF X2=LEN(M$)THEN 4150
4130 X1=X2
4140 GOTO 4100
4150 RETURN