This program LEARNS!
When you first run it, you must choose to "reset data" to create the first question tree. The more you play it, the cleverer it becomes. Also, it's simple to play.
1) The program will understand almost any answer. So answer how you like.
2) Just do what it says!
It will ask you yes/no questions until it knows what animal you are thinking of. If it gets it wrong it will then 'LEARN' that animal as well.
Long version:
sync on : hide mouse
dim question$(1000)
dim position(1000,1)
Print "INSTRUCTIONS:"
print "1) Enter [y] or [n] after each question."
print "2) Do what I say!"
input "Do you want to reset the data?",rst$
if left$(lower$(rst$),1) = "y"
input "Are you sure you want to reset the data?",rst$
if left$(lower$(rst$),1) = "y"
gosub reset
endif
endif
load array "qs.txt",question$(1000)
load array "ps.num",position(1000)
open to read 1,"Total.num"
read long 1,total
close file 1
do
input question$(num),an$
inc pline
oldernum = oldnum
olderans = oldans
oldnum = num
oldans = answer
if left$(lower$(an$),1) = "y"
answer=1
num = position(num,1)
else
answer=0
num = position(num,0)
endif
if num = -1
input "What was your animal? ",newanimal$
inc pline
input "Please enter a question to distinguish between these animals: ",newquestion$
inc pline
input "Will [y] or [n] go to your new animal?",yn$
inc pline
if left$(lower$(yn$),1) = "y"
a = 1
else
a = 0
endif
question$(total+1) = newquestion$+" "
question$(total+2) = "Is it a " + newanimal$ + "? "
position(oldernum,oldans) = total+1
position(total+1,a) = total+2
position(total+1,1-a) = oldnum
position(total+2,1) = -2
position(total+2,0) = -1
inc total,2
delete file "Total.num"
open to write 1,"Total.num"
write long 1,total
close file 1
delete file "qs.txt"
delete file "ps.num"
save array "qs.txt",question$(1000)
save array "ps.num",position(1000)
input "Oh well, I'll win next time! Play again? ",pa$
inc pline
if left$(lower$(pa$),1) = "y"
num = 0
else
print "Goodbye!"
sync
suspend for key
end
endif
cls
pline = 0
else
if num = -2
input "I win! Play again? ",pa$
inc pline
if left$(lower$(pa$),1) = "y"
num = 0
else
print "Goodbye!"
sync
suspend for key
end
endif
cls
pline = 0
endif
endif
sync
if pline > 20
cls
pline = 0
endif
loop
reset:
dim a$(1000)
dim b(1000,1)
a$(0) = "Does it live in the water? "
a$(1) = "Is it a mammal? "
a$(2) = "Is it a whale? "
a$(3) = "Is it a shark? "
a$(4) = "Is it a mammal? "
a$(5) = "Is it a elephant? "
a$(6) = "Is it a pigeon? "
b(0,0) = 4
b(0,1) = 1
b(1,0) = 3
b(1,1) = 2
b(2,0) = -1
b(2,1) = -2
b(3,0) = -1
b(3,1) = -2
b(4,0) = 6
b(4,1) = 5
b(5,0) = -1
b(5,1) = -2
b(6,0) = -1
b(6,1) = -2
total = 6
if file exist("qs.txt") = 1
delete file "qs.txt"
endif
if file exist("ps.num") = 1
delete file "ps.num"
endif
if file exist("Total.num") = 1
delete file "Total.num"
endif
save array "qs.txt",a$(1000)
save array "ps.num",b(1000)
open to write 1,"Total.num"
write long 1,total
close file 1
return
Short version, only 8 lines!
sync on : hide mouse : dim question$(1000) : dim position(1000,1) : Print "INSTRUCTIONS:" : print "1) Enter [y] or [n] after each question." : print "2) Do what I say!" : input "Do you want to reset the data?",rst$ : if left$(lower$(rst$),1) = "y" : input "Are you sure you want to reset the data?",rst$ : if left$(lower$(rst$),1) = "y" : gosub reset : endif : endif : load array "qs.txt",question$(1000) : load array "ps.num",position(1000) : open to read 1,"Total.num" : read long 1,total : close file 1 : do : input question$(num),an$ : inc pline : oldernum = oldnum : olderans = oldans : oldnum = num
oldans = answer : if left$(lower$(an$),1) = "y" : answer=1 : num = position(num,1) : else : answer=0 : num = position(num,0) : endif : if num = -1 : input "What was your animal? ",newanimal$ : inc pline : input "Please enter a question to distinguish between these animals: ",newquestion$ : inc pline : input "Will [y] or [n] go to your new animal?",yn$ : inc pline : if left$(lower$(yn$),1) = "y" : a = 1 : else : a = 0 : endif : question$(total+1) = newquestion$+" " : question$(total+2) = "Is it a " + newanimal$ + "? " : position(oldernum,oldans) = total+1 : position(total+1,a) = total+2 : position(total+1,1-a) = oldnum
position(total+2,1) = -2 : position(total+2,0) = -1 : inc total,2 : delete file "Total.num" : open to write 1,"Total.num" : write long 1,total : close file 1 : delete file "qs.txt" : delete file "ps.num" : save array "qs.txt",question$(1000) : save array "ps.num",position(1000) : input "Oh well, I'll win next time! Play again? ",pa$ : inc pline : if left$(lower$(pa$),1) = "y" : num = 0 : else : print "Goodbye!" : sync : suspend for key : end : endif : cls : pline = 0 : else : if num = -2
input "I win! Play again? ",pa$ : inc pline : if left$(lower$(pa$),1) = "y" : num = 0 : else : print "Goodbye!" : sync : suspend for key : end : endif : cls : pline = 0 : endif : endif : sync : if pline > 20 : cls : pline = 0 : endif : loop
reset:
dim a$(1000) : dim b(1000,1) : a$(0) = "Does it live in the water? " : a$(1) = "Is it a mammal? "
a$(2) = "Is it a whale? " : a$(3) = "Is it a shark? " : a$(4) = "Is it a mammal? " : a$(5) = "Is it a elephant? " : a$(6) = "Is it a pigeon? " : b(0,0) = 4 : b(0,1) = 1 : b(1,0) = 3 : b(1,1) = 2 : b(2,0) = -1 : b(2,1) = -2 : b(3,0) = -1 : b(3,1) = -2 : b(4,0) = 6 : b(4,1) = 5 : b(5,0) = -1 : b(5,1) = -2 : b(6,0) = -1 : b(6,1) = -2 : total = 6 : if file exist("qs.txt") = 1 : delete file "qs.txt" : endif : if file exist("ps.num") = 1 : delete file "ps.num"
endif : if file exist("Total.num") = 1 : delete file "Total.num" : endif : save array "qs.txt",a$(1000) : save array "ps.num",b(1000) : open to write 1,"Total.num" : write long 1,total : close file 1 : return
So, any comments?
There are three types of people, those that can count and those that can't.
