Algol 68 Genie

decision-tree.a68

     
   1  COMMENT
   2  
   3  @section Synopsis
   4  
   5  Paradigm for building decision trees in Algol 68.
   6  
   7  We wrote programs like this in the 1980's for ALGOL68C on TOPS-20 and VM/CMS.
   8  
   9  COMMENT
  10  
  11  BEGIN # Little Q&A game #
  12  
  13        CELL library := get answer("give an initial answer");
  14        
  15        WHILE guess object(library);
  16              put question("again")
  17        DO SKIP
  18        OD;
  19  
  20        # Data structure #
  21  
  22        MODE CELL = UNION (STRING, FORK), 
  23             FORK = STRUCT (STRING text, REF CELL has, hasnt);
  24  
  25        OP TEXT  = (FORK d) STRING: text OF d,
  26           HAS   = (FORK d) REF CELL: has OF d,
  27           HASNT = (FORK d) REF CELL: hasnt OF d;
  28  
  29        PROC new fork = (STRING text, CELL has, hasnt) FORK:
  30             (HEAP STRING := text, HEAP CELL := has, HEAP CELL := hasnt);
  31  
  32        # Guessing and extending library #
  33  
  34        PROC guess object = (REF CELL sub lib) VOID: # How to guess an object #
  35             CASE sub lib
  36             IN (STRING s): (put question("is it " + s) | SKIP | sub lib := learn(s)),
  37                (FORK d):   guess object((put question("does it " + TEXT d) | HAS d | HASNT d))
  38             ESAC;
  39  
  40        PROC learn = (STRING guess) CELL: # Introduce new cell in tree #
  41             IF STRING answer = get answer("what is the answer"),
  42                       question = get answer("what distinguishes " + answer);
  43                put question("does '" + question + "' apply to '" + answer + "'")
  44             THEN new fork(question, answer, guess)
  45             ELSE new fork(question, guess, answer)
  46             FI;
  47  
  48        # Interaction #
  49  
  50        PROC put question = (STRING question) BOOL:
  51             IF STRING s = get answer(question);
  52                UPB s > 0
  53             THEN s[1] = "y" ORF s[1] = "Y"
  54             ELSE put question (question)
  55             FI;
  56  
  57        PROC get answer = (STRING prompt) STRING:
  58             BEGIN STRING s; 
  59                   printf(($g"?"l$, prompt)); 
  60                   readf(($gl$, s)); 
  61                   printf(($"> "gl$, s)); 
  62                   s
  63             END;
  64                  
  65        ~
  66  
  67  END
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.