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
