A Program That Learns

George Peter Staplin - Mon Sep 17, 2007 I was pondering how to get the computer to ask me questions, so that it could learn. I rediscovered that learning is a recursive process at times.

Example usage:

 $ tclsh8.5 learn.tcl 
 what?  say hello
 how? puts hello
 what? puts a command
 how? you're too primitive to understand how to eval a command
 what? you're you
 how? it's a word
 what? it's it is
 how? what? a singular, 1
 how? the creators of English
 what? the hmm, next question?
 how? I don't know
 what? I George
 ...

Press Ctrl-d for EOF when you don't know how to answer a question, and it will return to what it was asking before.

When the script is done, it will print the rules that it learned.

 proc what? {{this ""}} {
  puts -nonewline "what? $this "
  flush stdout
  string trim [gets stdin]
 }
 
 proc how? {} {
  puts -nonewline "how? "
  flush stdout
  string trim [gets stdin]
 }
 
 
 proc ask-recurse {word} {
  global rules
  if {[info exists rules($word)]} return
  set rules([what? $word]) [set how [how?]]
  foreach w [split $how] {
   ask-recurse [string trim $w]
  }
 }
 
 proc ask this {
  global rules
  set rules([what? $this]) [set how [how?]]
  foreach word [split $how] {
   ask-recurse $word
  }
 }
 
 proc main {} {
  global rules
  while {![eof stdin]} {
   ask "" 
  }
  parray rules
 }
 main

gold

For various reasons, eTCl and windows have a hard time with stdin and stdout statements on this deck. Rewrote program leaving out stdin and stdout statements. Renamed main procedure "king". Maybe, somebody can add a little more polish.

  # written on Windows XP on eTCL
  # working under TCL version 8.5.6 and eTCL 1.0.1
  # TCL WIKI , 5Aug2010
  # A Program That Learns by George Peter Staplin
  # etcl version
  console show
  set entra "say hello"
  proc call aa {
  global entra
  set entra $aa
   }
  proc what? {{this ""}} {
  global entra
  puts -nonewline "what? $this "
  flush stdout
  string trim $entra
 }

 proc how? { args} {
  global entra
  puts -nonewline "how? "
  what? $args
  string trim $entra
 }

 proc ask-recurse {word} {
  global rules
  if {[info exists rules($word)]} return
  set rules([what? $word]) [set how [how?]]
  foreach w [split $how] {
   ask-recurse [string trim $w]
  }
 }

 proc ask this {
  global rules
  set rules([what? $this]) [set how [how?]]
  foreach word [split $how] {
   ask-recurse $word
  }
 }

 proc king {args} {
  global rules 
 puts [ what? $args ]
  #parray rules
 }
 king hello
 #end

 console session
   what? hello say hello
  1% king say hello
  what? say hello say hello1% king hello
   what? hello say hello
  2% how?
  how? say hello
  3% what? hello say hello
  1% king hello
  what? hello say hello
  2% how?
  how? say hello
  3% what?
  what?  say hello
  2% how?
  how? what?  say hello
  3% how? puts hello
  how? what? puts hello say hello
  end

Hidden Comments Section

Please place any comments here, Thanks.

Category Numerical Analysis

Category String Processing

Category AI

Category Chat