Program that tells apart animals

[tsh73]

So in the tread on Association Memory help Rod said

Jan 23, 2022 18:56:36 GMT Rod said:

I do recall a very early Sinclair Spektrum program that was a question and answer session that lead the program to either tell you what the object was or ask what it was and what differentiated it from similar objects. Thereafter it could always tell you what the object was. Key based segmentation. If it was yellow and a fruit it was always a banana until it wasn’t and it learned the difference between yellow fruit Round, crescent shaped, pear shaped.

Long winded but utterly fascinating at the time because it really felt “intelligently.

And I thought that I've seen that program.

With some googling - I found it

Here is a program to play ‘Pangolins’. You think up an animal, and the computer tries to guess what it is, by asking you questions that can be answered ‘yes’ or ‘no’. If it’s never heard of your animal before, it asks you to give it some question that it can use next time to find out whether someone’s given it your new animal.

it's 4th program on this page
dotneteer.github.io/spectnetide/spectrum/basic-appd

Of course it is Spectrum Basic program and needs translating
Anybody ?

I could say a few things on Spectrum Basic (as I remember)
BUT! this thing IS Spectrum BASIC reference in itself, just use left column menu.
* string arrays include length, so DIM q$(nq,50) is "nq strings of 50 characters each"
* strings are addressed as arrays, so r$(1) is 1st letter of r$, and p$(TO n) is first n letters
* not spectrum basic but obviously IF r$\<\>"N" should be IF r$<>"N" - conditional operators are escaped (probably for HTML)
* GO TO, GO SUB needs space removed to run in JB
* there ought to be errors in listing. Line 30 definitely needs + (or - ?) before last 1
. And I think I changed Zero(0) to Oh(O) in one of GOTO's.
* (now for JB quirks) As we know JB cannot READ into arrays, it should be circumvented.

With this in mind I made it compile in JB. But it keeps asking same question whatever I answer, so I must broke something.
So better start anew.

[Rod]

I just started from scratch, not done a huge amount of debugging. Looking at Spektrum code now it is surprising my interest in computing survived, horrible code!

Decision tree with nodes, alternatively how to capture an experts thinking and create an expert system.

dim node$(100,3) 'question, yes node , no node
node$(1,1)="Does it live in the sea"
node$(1,2)="2"
node$(1,3)="3"
node$(2,1)="Is it a whale"
node$(2,2)="0" 'correct
node$(2,3)="?" 'unknown
node$(3,1)="Is it scaly"
node$(3,2)="4"
node$(3,3)="?"
node$(4,1)="Is it a pangolin"
node$(4,2)="0"
node$(4,3)="?"
node=5
question=1

found=0
print "Think of an animal."
print "I am going to guess the animal you are thinking about."
while found=0
   print node$(question,1);
   input ans$
   if upper$(left$(ans$,1))="Y" then r$=node$(question,2) else r$=node$(question,3)
   if r$="0" then print "I thought as much." : found=1
   if r$="?" then
       print "You beat me, what is the name of your animal"
       input ani$
       ani$="Is it a ";ani$
       print "What does your animal have that makes it different"
       input que$
       que$="Does it have ";que$
       'first replace the ? with a new node pointer
       node$(question,3)=str$(node)
       'now create the new node with the new question
       node$(node,1)=que$
       node$(node,2)=str$(node+1)
       node$(node,3)=str$(node+2)
       'now create the yes node  that has 0 / ? as node pointers
       'ie the answer and termination or a new question
       node$(node+1,1)=ani$
       node$(node+1,2)="0"
       node$(node+1,3)="?"
       node=node+1
       Print "Lets start again."
       question=1
   else
       question=val(r$)
   end if
wend


[tsh73]

Probably not quite right yet.
After I added new animal it asked old one (Is it a pangolin?)
Still surprised how small code is, comparing with Spectrum listing.

[Rod]

Well I think that is how a decision tree is meant to work. Yes it asks the old question but if the answer is no it has a new question and a new answer.

Think of an animal.
I am going to guess the animal you are thinking about.
Does it live in the sea?n
Is it scaly?y
Is it a pangolin?n
You beat me, what is the name of your animal
?snake
What does your animal have that makes it different
?fangs
Lets start again.
Does it live in the sea?n
Is it scaly?y
Is it a pangolin?n
Does it have fangs?y
Is it a snake?y

[Rod]

A tricky issue with this is that nodes need not exist. I use 0 and ? as node pointers that have no node. They are terminators, one terminates success 0 the other terminates in a question ? creating a new node. The code could get smaller yet! But bug hunting first.

[tsh73]

I managed to convert/debug Spectrum code.
It could be prettified a lot but it does work now.
Give it a spin.
It suggets animals only on tree ends (where it has no more questions to ask).
REM Pangolins
nq=100: REM number of questions and animals
DIM q$(nq): DIM a(nq,2): DIM r$(1)
qf=8
FOR n=1 TO qf/2 -1
READ q$:q$(n)=q$: READ a:a(n,1)=a: READ a:a(n,2)=a
print n, q$(n),a(n,1),a(n,2)
NEXT n
FOR n=n TO qf-1
READ q$:q$(n)=q$
print n, q$(n)
NEXT n
100 REM start playing
PRINT "Think of an animal. Press any key to continue."
dummy$=input$(1)
c=1: REM start with 1st question
140 IF a(c,1)=0 THEN GOTO 300
150  p$=q$(c): GOSUB 900
PRINT "?": GOSUB 1000
in=1: IF r$="y" THEN GOTO 210
IF r$="Y" THEN GOTO 210
in=2: IF r$="n" THEN GOTO 210
IF r$<>"N" THEN GOTO 150
210  c=a(c,in): GOTO 140
300 REM animal
PRINT "Are you thinking of"
p$=q$(c): GOSUB 900: PRINT "?"
GOSUB 1000
IF r$="y" THEN GOTO 400
IF r$="Y" THEN GOTO 400
IF r$="n" THEN GOTO 500
IF r$="N" THEN GOTO 500
PRINT "Answer me properly when I'm talking to you.": GOTO 300
400 REM guessed it
PRINT "I thought as much.": GOTO 800
500 REM new animal
IF qf>nq-1 THEN PRINT "I'm sure your animal is very interesting,but I don't have","room for it just now.": GOTO 800
q$(qf)=q$(c): REM move old animal
PRINT "What is it, then?": INPUT q$(qf+1)
PRINT "Tell me a question which distinguishes between "
p$=q$(qf): GOSUB 900: PRINT " and"
p$=q$(qf+1): GOSUB 900: PRINT " "
INPUT s$:  b=LEN(s$)
IF right$(s$,1)="?" THEN  b=b-1
q$(c)=left$(s$,b): REM insert question
600 PRINT "What is the answer for"
p$=q$(qf+1): GOSUB 900: PRINT "?"
GOSUB 1000
in=1:  io=2: REM answers for new and old animals
IF r$="y" THEN GOTO 700
IF r$="Y" THEN GOTO 700
in=2:  io=1
IF r$="n" THEN GOTO 700
IF r$="N" THEN GOTO 700
PRINT "That's no good. ": GOTO 600
700 REM update answers
a(c,in)=qf+1:  a(c,io)=qf
qf=qf+2: REM next free animal space
PRINT "That fooled me."
800 REM again?
PRINT "Do you want another go?": GOSUB 1000
IF r$="y" THEN GOTO 100
IF r$="Y" THEN GOTO 100
STOP
900 REM print without trailing spaces
940 PRINT p$;: RETURN
1000 REM get reply
INPUT r$: IF r$="" THEN RETURN
RETURN
REM initial animals
DATA "Does it live in the sea",4,2
DATA "Is it scaly",3,5
DATA "Does it eat ants",6,7
DATA "a whale", "a blancmange", "a pangolin", "an ant"


[Rod]

Not had a chance to run tsh73’s code yet but sleeping on it I probably need to “replace” the previous node rather than redirect it. Then it might ask the divisional question before it guesses the animal and gets it wrong..

[Rod]

Here is code that seems to run better. It replaces the original node with a new question. Off to run tsh73's version now


dim node$(100,3) 'question, yes node , no node
node$(1,1)="Does it live in the sea"
node$(1,2)="2"
node$(1,3)="3"
node$(2,1)="Is it a whale"
node$(2,2)="0" 'correct
node$(2,3)="?" 'unknown
node$(3,1)="Is it scaly"
node$(3,2)="4"
node$(3,3)="?"
node$(4,1)="Is it a pangolin"
node$(4,2)="0"
node$(4,3)="?"
node=5
question=1


print "Think of an animal, I will guess what it is."

while 1
   print node$(question,1);
   ans$=""
   while instr("QYN",ans$,1)=0
       input ans$
       ans$=upper$(left$(ans$,1))
   wend
   if ans$="Q" then exit while
   if ans$="Y" then r$=node$(question,2) else r$=node$(question,3)
   if r$="?" then
       print "You beat me, what is the name of your animal"
       input ani$
       ani$="Is it a ";ani$
       print "What does your animal have that makes it different"
       input que$
       newque$="Does it have ";que$
       oldque$=node$(question,1)
       node$(question,1)=newque$
       node$(question,2)=str$(node)
       node$(question,3)=str$(node+1)
       node$(node,1)=ani$
       node$(node,2)="0"
       node$(node,3)="?"
       node$(node+1,1)=oldque$
       node$(node+1,2)="0"
       node$(node+1,3)="?"
       node=node+2
       print "Lets start again."
       r$="1"
   end if
   if r$="0" then
       print "I thought as much."
       print "Think of a new animal or (Q)uit."
       r$="1"
   end if
   question=val(r$)
wend




[plus]

I found a Morristown NJ version of Guess Animals:
10 Print Tab(32); "ANIMAL"
20 Print Tab(15); "CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
30 Print: Print: Print
40 Print "PLAY 'GUESS THE ANIMAL'"
45 Print
50 Print "THINK OF AN ANIMAL AND THE COMPUTER WILL TRY TO GUESS IT."
60 Print
70 Dim A$(200)
80 For I = 0 To 3
   90 Read A$(I)
100 Next I
110 N = Val(A$(0))
120 Rem          MAIN CONTROL SECTION
130 Input "ARE YOU THINKING OF AN ANIMAL"; A$
140 If A$ = "LIST" Then 600
150 If Left$(A$, 1) <> "Y" Then 120
160 K = 1
170 GoSub 390
180 If Len(A$(K)) = 0 Then 999
190 If Left$(A$(K), 2) = "\Q" Then 170
200 Print "IS IT A "; Right$(A$(K), Len(A$(K)) - 2);
210 Input A$
220 A$ = Left$(A$, 1)
230 If Left$(A$, 1) = "Y" Then Print "WHY NOT TRY ANOTHER ANIMAL?": GoTo 120
240 Input "THE ANIMAL YOU WERE THINKING OF WAS A "; V$
250 Print "PLEASE TYPE IN A QUESTION THAT WOULD DISTINGUISH A"
260 Print V$; " FROM A "; Right$(A$(K), Len(A$(K)) - 2)
270 Input X$
280 Print "FOR A "; V$; " THE ANSWER WOULD BE ";
290 Input A$
300 A$ = Left$(A$, 1): If A$ <> "Y" And A$ <> "N" Then 280
310 If A$ = "Y" Then B$ = "N"
320 If A$ = "N" Then B$ = "Y"
330 Z1 = Val(A$(0))
340 A$(0) = Str$(Z1 + 2)
350 A$(Z1) = A$(K)
360 A$(Z1 + 1) = "\A" + V$
370 A$(K) = "\Q" + X$ + "\" + A$ + Str$(Z1 + 1) + "\" + B$ + Str$(Z1) + "\"
380 GoTo 120
390 Rem     SUBROUTINE TO PRINT QUESTIONS
400 Q$ = A$(K)
410 For Z = 3 To Len(Q$)
   415 If Mid$(Q$, Z, 1) <> "\" Then Print Mid$(Q$, Z, 1);
417 Next Z
420 Input C$
430 C$ = Left$(C$, 1)
440 If C$ <> "Y" And C$ <> "N" Then 410
450 T$ = "\" + C$
455 For X = 3 To Len(Q$) - 1
   460 If Mid$(Q$, X, 2) = T$ Then 480
470 Next X
475 Stop
480 For Y = X + 1 To Len(Q$)
   490 If Mid$(Q$, Y, 1) = "\" Then 510
500 Next Y
505 Stop
510 K = Val(Mid$(Q$, X + 2, Y - X - 2))
520 Return
530 Data "4","\QDOES IT SWIM\Y2\N3\","\AFISH","\ABIRD"
600 Print: Print "ANIMALS I ALREADY KNOW ARE:"
605 X = 0
610 For I = 1 To 200
   620 If Left$(A$(I), 2) <> "\A" Then 650
   624 Print Tab(15 * X);
   630 For Z = 3 To Len(A$(I))
       640 If Mid$(A$(I), Z, 1) <> "\" Then Print Mid$(A$(I), Z, 1);
   642 Next Z
   645 X = X + 1: If X = 4 Then X = 0: Print
650 Next I
660 Print
670 Print
680 GoTo 120
999 End



Needs a little fixing for JB. I've a version converted to QB64 that saves animal descriptions and questions to file. I will see if it translates to JB.

Here is what the external Animal.DAT file looks like when it starts learning new Animals:

"22"
"\QDoes it live in water\Y2\N3\"
"\QIs it the largest mammal on earth\Y17\N16\"
"\QDoes it fly\N5\Y4\"
"\QIs it a mammal\Y11\N10\"
"\QDoes it purr\Y7\N6\"
"\QDoes it hibernate in winter\Y9\N8\"
"\Acat"
"\QDoes it bark\Y13\N12\"
"\Abear"
"\QIs it an insect\Y19\N18\"
"\Abat"
"\QDoes it cry crocodile tears\Y15\N14\"
"\Adog"
"\QIs it known for building dams\Y21\N20\"
"\Ahuman"
"\Afish"
"\Awhale"
"\Abird"
"\Abutterfly"
"\Arabbit"
"\Abeaver"
""
""

[plus]

OK here is a translation to JB of my makeover of that Morristown Code:

'"Guess Animal - QB64 Conversion of Morristown Version"
' b+ Translated to Just Basic 2022-02-17

ReDim A$(200)
L$ = Chr$(10) ' L is for line or next line
Print L$ + Space$(35) + "Guess Animal" + L$ + L$ + Space$(11) + "Originally from: CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY" + L$ + L$ + L$
Print " Think of an animal and the computer will try and guess it." + L$

open "ANIMAL.DAT" for Append as #1 'this prevents error if file doesn't exit
close #1

Open "ANIMAL.DAT" For Input As #3
if eof(#3) = 0 then
   Input #3, s$
   If Val(s$) > 0 Then ' then this is probably a good file?
       A$(0) = s$
       For I = 1 To 200
           Input #3, A$(I)
       Next
       Close #3
   end if
Else
   Close #3
   For I = 0 To 3
       Read s$  ' this wont read right into the array??? ie, Read A$(I)
       A$(I) = s$
   Next I
End If
N = Val(A$(0))
Do
   Scan
   Do
       Scan
       A$ = Lower$(npt$(L$ + " Are you thinking of an animal (yes/quit/list)"))
       If left$(A$,1) = "l" Then
           Print L$ + " Animals I already know are:" ' listing computers aimals
           For I = 1 To 200
               If Left$(A$(I), 2) = "\A" Then Print "   " + Mid$(A$(I), 3)
           Next I
           Print L$ + L$
       End If
   Loop Until Left$(A$, 1) = "y" Or Left$(A$, 1) = "q"
   If Left$(A$, 1) = "q" Then
       print " Goodbye!"
       Exit Do 'bug out main DO doesn't want to play
   end if
   K = 1
   While Left$(A$(K), 2) = "\Q"
       Scan
       Q$ = A$(K)
       Do 'parse question and use as prompt to get c$
           C$ = Upper$(Left$(npt$(" " + Mid$(Q$, 3, InStr(Q$, "\", 3) - 3)), 1))
       Loop Until C$ = "Y" Or C$ = "N"
       X = InStr(Left$(Q$, Len(Q$) - 1), "\" + C$, 3)
       Y = InStr(Q$, "\", X + 1)
       K = Val(Mid$(Q$, X + 2, Y - X - 2))
       If Len(A$(K)) = 0 Then GoTo [done] ' bug out of main DO loop, out of questions
   Wend
   A$ = Upper$(npt$(" Is it a " + Right$(A$(K), Len(A$(K)) - 2)))
   If Left$(A$, 1) = "Y" Then Print " Why not try another animal?": GoTo [Continue]
   V$ = Lower$(npt$(" The animal you were thinking of is a "))
   X$ = npt$(" Please type a question that would distinguish a " + V$ + " from a " + Right$(A$(K), Len(A$(K)) - 2))
   Do
       Scan
       A$ = Upper$(Left$(npt$(" For a " + V$ + " the answer would be "), 1))
   Loop Until A$ = "Y" Or A$ = "N"
   If A$ = "Y" Then B$ = "N" Else B$ = "Y"
   Z1 = Val(A$(0))
   A$(0) = _Trim$(Str$(Z1 + 2))
   A$(Z1) = A$(K)
   A$(Z1 + 1) = "\A" + V$
   A$(K) = "\Q" + X$ + "\" + A$ + _Trim$(Str$(Z1 + 1)) + "\" + B$ + _Trim$(Str$(Z1)) + "\"
   [Continue]
Loop Until always
[done] ' save data
Open "ANIMAL.DAT" For Output As #2
For I = 0 To 200
   Print #2, A$(I)
Next I
Close #2
Data "4","\QDoes it live in water\Y2\N3\","\Afish","\Abird"
Function npt$ (prompt$) ' nice way to get more variable data into the prompt!
   Print prompt$;
   Input "? ";npt$
End Function



Output sample:

Guess Animal

Originally from: CREATIVE COMPUTING MORRISTOWN, NEW JERSEY


Think of an animal and the computer will try and guess it.

Are you thinking of an animal (yes/quit/list)? l

Animals I already know are:
manatee
bear
cat
squirrel
dog
sea turtle
crab
whale
walrus
bird
bat
fish
eel



Are you thinking of an animal (yes/quit/list)? y
Does it live in water? y
Is it a mammal? n
It has a hard shell? n
It is snake like? y
Is it a eel? y
Why not try another animal?

Are you thinking of an animal (yes/quit/list)? q
Goodbye!

ANIMAL.DAT (started while testing JB translation)

26
\QDoes it live in water\Y2\N3\
\QIs it a mammal\Y5\N4\
\QNo wings\Y9\N8\
\QIt has a hard shell\Y17\N16\
\QIs it sometimes mistaken for a mermaid\Y7\N6\
\QIt has a blow hole for breathing\N21\Y20\
\Amanatee
\QIt is a mammal\Y23\N22\
\QIt hibernates in winter\Y11\N10\
\QIt meows when hungry\Y13\N12\
\Abear
\Qit barks\Y15\N14\
\Acat
\Asquirrel
\Adog
\QIt is snake like\Y25\N24\
\Qdoes it have claws\Y19\N18\
\Asea turtle
\Acrab
\Awhale
\Awalrus
\Abird
\Abat
\Afish
\Aeel

[Rod]

Ha, Creative Computing 1978 - Sinclair Spectrum 1982 - Rod and B+ 2022, there is little new in computing, it has all been done before. But it is still fun.

[plus]

Yeah a few gems from way back! Eliza was another that I happened upon when I first came back to Basic in 2014. What luck, I picked that as first project to translate to modern Basic wo line numbers with Else and Else If and Select Case and Subs and Functions!

Eliza taught me how to do many-to-one dictionary or data base sorta. I think that takes us right back to how this thread got started from associative memory subject. Eliza had a slew of optional responses given certain keyword triggers. I wanted to allow a growing/editable base saved to file. I could create more characters than Eliza, just by characteristic responses to keywords.

[tsh73]

Finally have a look at B+ program.
Obviously Spectrum version has same algorithm
but stores things differently, likely simpler.
(it has q$(c) for text - question or answer - and a(c,1) a(c,2) for y/n links to next question)
In fact it is binary tree, have a look:
(on same level upper line is for 'Y')

  Does it live in the sea
    Does it have 8 legs
      an octopus
      Is it orange
        clownfish
        a whale
    Is it scaly
      Does it eat ants
        a pangolin
        an ant
      a blancmange

I made three-line recursive sub to show it
REM Pangolins
'translation from ZX Spectrum code

nq=100: REM number of questions and animals
DIM q$(nq): DIM a(nq,2): DIM r$(1)
qf=8
FOR n=1 TO qf/2 -1
READ q$:q$(n)=q$: READ a:a(n,1)=a: READ a:a(n,2)=a
'print n, q$(n),a(n,1),a(n,2)
'print using("##",n), q$(n),a(n,1),a(n,2)
NEXT n
FOR n=n TO qf-1
READ q$:q$(n)=q$
'print n, q$(n)
NEXT n

call printTree 1,1
]
wait

REM initial animals
DATA "Does it live in the sea",4,2
DATA "Is it scaly",3,5
DATA "Does it eat ants",6,7
DATA "a whale", "a blancmange", "a pangolin", "an ant"

sub printTree n,lvl
print space$(lvl*2);q$(n)
if a(n,1) then call printTree a(n,1),lvl+1
if a(n,2) then call printTree a(n,2),lvl+1
end sub


[carlgundel]

This is fun, and I remember a more sophisticated program where you actually teach it to distinguish between different animals by giving it input about unique features.

[plus]

Feb 21, 2022 13:17:57 GMT carlgundel said:

This is fun, and I remember a more sophisticated program where you actually teach it to distinguish between different animals by giving it input about unique features.

Yes you can teach these apps new animals. In my translation, if it guesses a wrong animal, it will ask:
1. the name of the new animal
2. a yes/no question to distinguish your new animal from the one last guessed
3. the answer, Y or N, to the question that applies to the new animal.