#! /usr/bin/expect -- fconfigure stdin -blocking 1 ###################################################################################### # wumpus driver puts "Welcome to Wumpus Driver by Don Colton" ###################################################################################### proc usage args { puts "" puts "usage 1: wumpDriver wumpClient wumpClient wumpClient ..." puts " shows the map and allows direct competition" puts "usage 2: wumpDriver n wumpClient" puts " runs one client n times and just reports the results." puts "optionally include seed=nnn to seed the random generator." puts ""; exit } ###################################################################################### # agent gets percept: (stench,breeze,glitter,bump,scream) # . example: n,n,n,n,n (comma separated list of five items) # . stench means you can smell the wumpus in an adjacent cell # . breeze means you can tell there is a pit in an adjacent cell # . glitter means there is gold in the current cell # . bump means you tried to move forward but ran into a wall and did not move # . scream means you shot the wumpus and it is now dead and no longer dangerous # agent must reply with one of (S,shoot,L,left,R,right,A,forward,Q,quit) ###################################################################################### # extract the seed if any if [regexp {seed=(\d+)} $argv foo seed] { regsub " seed=$seed " " $argv " " " argv set argv [string trim $argv] } else { set seed "" } ###################################################################################### # give names of the agents on the command line set iter 1; set verbose 1 # puts "argv is ($argv)" if { [llength $argv] == 2 && [regexp {^(\d+) (.*)} $argv foo iter argv] } { set verbose 0; puts "Running in Evaluation mode for $iter iterations." } set count 0; foreach agent $argv { incr count; set a2name(a$count) $agent; lappend agents "a$count" } proc putsv {lvl line} { global verbose; if { $verbose >= $lvl } { puts $line } } if { $count == 0 } { usage } ###################################################################################### # map() contains all game details in the following form # map($agent,$xy) is defined where $agent has visited # map($agent,x) is the x (col) where the agent is # map($agent,y) is the y (row) where the agent is # map($agent,dir) is the direction agent is facing: [^X] (x if dead) # map($agent,killed) is defined if wumpus is dead # map($agent,perc) contains the current percepts # map($agent,score) contains the score for the agent # map($agent,shot) is defined if arrow has been shot # map(b,$xy) is defined where there is a breeze (pit near) # map(g,$xy) is defined where there is gold # map(p,$xy) is defined where there is a pit # map(s,$xy) is defined where there is a stench (wumpus near) # map(w,$xy) is defined where there is a wumpus ###################################################################################### # subroutines ###################################################################################### proc average args { if { [llength $args] == 1 } { set args [lindex $args 0] } set sum 0; set count 0 foreach arg $args { catch { set sum [expr $sum + $arg]; incr count } } if { $count == 0 } { return 0 } expr 1.0 * $sum / $count } #------------------------------------------------------------------------ # modified from expect's mkpasswd by Don Libes proc rand args { set fileId [open /dev/urandom r] binary scan [read $fileId 4] i1 number close $fileId return $number } #------------------------------------------------------------------------ # pseudo-random number generator proc randomSeed seed { global RNDseed version set RNDseed $seed; set version $seed } proc random15 {} { global RNDseed; # 15 bit int: 0..32767 set RNDseed [expr $RNDseed * 1103515245 + 12345]; # overflows at 32 bits expr int ( $RNDseed / 65536 ) % 32768 } proc random {low high} { expr int ( $low + [random15] * ($high - $low + 1) / 32768) } #------------------------------------------------------------------------ # pick one at random proc pick args { if { [llength $args] == 1 } { set args [lindex $args 0] } lindex $args [random 0 [expr [llength $args] - 1]] } #------------------------------------------------------------------------ # permute a list and return it proc permute args { set out ""; if { [llength $args] == 1 } { set args [lindex $args 0] } while { [llength $args] > 0 } { set nexti [random 0 [expr [llength $args] - 1]]; lappend out [lindex $args $nexti]; set args [lreplace $args $nexti $nexti]; }; return $out; } ###################################################################################### # draw the map showing the board configuration and score: # each cell lists agent, wumpus, pit, gold (awpg) # first dot is agent: [^v<>. ]; next wumpus [Ww ]; next pit [P ]; last gold [G ] ###################################################################################### # fred says: A # +----+----+----+----+ +----+----+----+----+ +----+----+----+----+ # |....| | | | | | | | | | | | | | # +----+----+----+----+ +----+----+----+----+ +----+----+----+----+ # | | | | | | | | | | | | | | | # +----+----+----+----+ +----+----+----+----+ +----+----+----+----+ # | | | | | | | | | | | | | | | # +----+----+----+----+ +----+----+----+----+ +----+----+----+----+ # | | | | | | | | | | | | | | | # +----+----+----+----+ +----+----+----+----+ +----+----+----+----+ # percept x,x,x,x,x # score: -1 proc draw0 agent { global drawing map set xy "$map($agent,x),$map($agent,y)" append drawing(n) [format %-31s " $agent ($xy) next action: $map($agent,next)"] append drawing(p) " [format %-13s "score: $map($agent,score)"] perc: $map($agent,perc)" append drawing(0) " +------+------+------+------+" foreach y "1 2 3 4" { set line " |" foreach x "1 2 3 4" { set xy "$x,$y" set a " "; if [info exists map($agent,$xy)] { set a "." } if { "$map($agent,x),$map($agent,y)" == $xy } { set a $map($agent,dir) } set w " "; if [info exists map(w,$xy)] { set w "W"; if [info exists map($agent,killed)] { set w "w" } } set p " "; if [info exists map(p,$xy)] { set p "P" } set g " "; if [info exists map(g,$xy)] { set g "G" } append line " $a$w$p$g |" } append drawing($y) $line } } proc draw1 args { global drawing; putsv 1 [string trim $drawing(n)] putsv 1 [string trim $drawing(0)]; putsv 1 [string trim $drawing(4)] putsv 1 [string trim $drawing(0)]; putsv 1 [string trim $drawing(3)] putsv 1 [string trim $drawing(0)]; putsv 1 [string trim $drawing(2)] putsv 1 [string trim $drawing(0)]; putsv 1 [string trim $drawing(1)] putsv 1 [string trim $drawing(0)]; putsv 1 [string trim $drawing(p)] unset drawing } ###################################################################################### # main program ###################################################################################### proc main args { global agents a2name map verbose keep ###################################################################################### # foreach agent $agents { putsv 0 "agent is $agent" } # agent is either "<" ">" "^" or "V" to show directionality, or "x" if dead catch { unset map } foreach agent $agents { set map($agent,dir) ">" set map($agent,x) 1 set map($agent,y) 1 set map($agent,score) 0 set map($agent,perc) "x,x,x,x,x" set map($agent,next) " " } ###################################################################################### # ask random map or keyed in map # while 1 { # putsv 0 "Specify map type: r=random, k=keyed." # set maptype [string tolower [gets stdin]] # if [regexp {^[qx]$} $maptype] exit # if [regexp {^[rk]$} $maptype] break # putsv 0 "You said \"$maptype\" but I don't understand. Try again." # } ###################################################################################### # if keyed in, accept it using ....\n ..p.\n ....\n ..p.\n notation for the pits # then prompt for the location of the gold and the wumpus set maptype "r"; # stub ###################################################################################### if { $maptype == "r" } { putsv 1 "Generating a Random Map" # randomSeed $randomSeed # set cells "1,2 1,3 1,4 2,1 2,2 2,3 2,4 3,1 3,2 3,3 3,4 4,1 4,2 4,3 4,4" set cells "1,3 1,4 2,3 2,4 3,1 3,2 3,3 3,4 4,1 4,2 4,3 4,4" foreach cell $cells { if { [random15] % 5 != 0 } continue set map(p,$cell) 1 regexp {(.),(.)} $cell foo x y set map(b,$x,$y) 1; # assign breeze set map(b,$x,[expr $y-1]) 1 set map(b,$x,[expr $y+1]) 1 set map(b,[expr $x-1],$y) 1 set map(b,[expr $x+1],$y) 1 } set w [pick $cells]; set map(w,$w) 1; # hide the wumpus regexp {(.),(.)} $w foo x y set map(s,$x,$y) 1; # assign stench set map(s,$x,[expr $y-1]) 1 set map(s,$x,[expr $y+1]) 1 set map(s,[expr $x-1],$y) 1 set map(s,[expr $x+1],$y) 1 set g [pick $cells]; set map(g,$g) 1; # hide the gold } ###################################################################################### # debugging information putsv 2 [lsort [array names map]] log_user 0; # stop spawned process output from appearing on the screen # start each agent foreach agent $agents { putsv 1 "starting $agent ($a2name($agent))" # if it was open, close it so we can reopen it if [info exists keep($agent.sid)] { set spawn_id $keep($agent.sid) # puts "killing $spawn_id $keep($agent.pid)" # exec kill $keep($agent.pid) catch { close } wait -nowait } # catch { set spawn_id $keep($agent.sid); close; wait -nowait } set keep($agent.pid) [eval spawn $a2name($agent)] set keep($agent.sid) $spawn_id # puts "spawning $spawn_id $keep($agent.pid)" # calculate the percept: stench,breeze,glitter,bump,scream set xy "$map($agent,x),$map($agent,y)" set percept "" if { [info exists map(s,$xy)] } { append percept "y," } else { append percept "n," } if { [info exists map(b,$xy)] } { append percept "y," } else { append percept "n," } if { [info exists map(g,$xy)] } { append percept "y," } else { append percept "n," } append percept "n,n"; # guaranteed true on first move set map($agent,perc) $percept draw0 $agent } draw1 while 1 { # wait for dungeonmaster to press enter or type a number and press enter putsv 1 "press ENTER to continue (or enter a number)" if { $verbose > 0 } { set turns [gets stdin] } else { set turns 1 } # take the number of moves entered, default is 1, not less than 1. if ![regexp {^[1-9][0-9]*$} $turns] { set turns 1 } while { $turns > 0 } { incr turns -1 # give each agent a percept and get its move set alive 0 foreach agent $agents { if { $map($agent,dir) == "X" } continue incr alive; # count remaining players set spawn_id $keep($agent.sid) set percept $map($agent,perc) putsv 1 "To $agent: sending percept (stench,breeze,glitter,bump,scream)=($percept)" send "$percept\r" expect "$percept" set got "Q"; # quit expect { -re {^[\r\n]*([^\r\n]+)[\r\n]+} { set got $expect_out(1,string) # debug lines can be printed "# ... \n" set got [string trim $got] if [regexp {^#} $got] { putsv 1 "Fr $agent: $got"; exp_continue -continue_timer } # putsv 2 "Fr $agent: got ($got)" set map($agent,next) $got } timeout { putsv 1 "Fr $agent: timeout" } eof { putsv 1 "Fr $agent: stopped (eof)" } } if { $got == "quit" } { set got "Q" } if { $got == "left" } { set got "L" } if { $got == "right" } { set got "R" } if { $got == "forward" } { set got "A" } if { $got == "shoot" } { set got "S" } if { $got == "Q" } { putsv 1 "## $agent: quitting"; set map($agent,dir) "X"; continue } # score -1 for each action, -10 for using arrow, -1000 for death, and +1000 for finding gold incr map($agent,score) -1 set x $map($agent,x) set y $map($agent,y) set xy "$x,$y" set killed "n" set map($agent,$xy) 1; # visited set dirGot "$map($agent,dir)$got" set bump "n" if { $got == "S" } { if [info exists map($agent,shot)] continue set map($agent,shot) 1 incr map($agent,score) -10 set x $map($agent,x); set y $map($agent,y) if { $dirGot == "= 1 } { if { [info exists map(w,$x,$y)] } { set killed "y"; break }; incr x -1 } } if { $dirGot == ">S" } { while { $x <= 4 } { if { [info exists map(w,$x,$y)] } { set killed "y"; break }; incr x 1 } } if { $dirGot == "^S" } { while { $y <= 4 } { if { [info exists map(w,$x,$y)] } { set killed "y"; break }; incr y 1 } } if { $dirGot == "vS" } { while { $y >= 1 } { if { [info exists map(w,$x,$y)] } { set killed "y"; break }; incr y -1 } } if { $killed == "y" } { set map($agent,killed) 1 } } if { $dirGot == "^L" } { set map($agent,dir) "<"; set dirGot "" } if { $dirGot == ""; set dirGot "" } if { $dirGot == ">L" } { set map($agent,dir) "^"; set dirGot "" } if { $dirGot == "^R" } { set map($agent,dir) ">"; set dirGot "" } if { $dirGot == "R" } { set map($agent,dir) "v"; set dirGot "" } if { $dirGot == "^A" } { if { $y == 4 } { set bump "y" } else { incr map($agent,y) 1 }; set dirGot "" } if { $dirGot == "vA" } { if { $y == 1 } { set bump "y" } else { incr map($agent,y) -1 }; set dirGot "" } if { $dirGot == "A" } { if { $x == 4 } { set bump "y" } else { incr map($agent,x) 1 }; set dirGot "" } # in case we moved just now set x $map($agent,x) set y $map($agent,y) set xy "$x,$y" # calculate the percept: stench,breeze,glitter,bump,scream set xy "$map($agent,x),$map($agent,y)" set percept "" if { [info exists map(s,$xy)] } { set s "y" } else { set s "n" } if { [info exists map(b,$xy)] } { set b "y" } else { set b "n" } if { [info exists map(g,$xy)] } { set g "y" } else { set g "n" } set map($agent,perc) "$s,$b,$g,$bump,$killed" # did we run into a live wumpus? if [info exists map($agent,killed)] { putsv 1 "## $agent: wumpus is dead" } if [info exists map(w,$xy)] { putsv 1 "## $agent: wumpus is here. AAAAAH!" } if { ![info exists map($agent,killed)] && [info exists map(w,$xy)] } { incr map($agent,score) -1000; set map($agent,dir) "X" } # did we fall into a pit? if [info exists map(p,$xy)] { putsv 1 "## $agent: pit is here. AAAAAH!" } if [info exists map(p,$xy)] { incr map($agent,score) -1000; set map($agent,dir) "X" } # did we find the gold? if [info exists map(g,$xy)] { putsv 1 "## $agent: gold is here. YESSS!" } if [info exists map(g,$xy)] { incr map($agent,score) 1000; set map($agent,dir) "X" } } foreach agent $agents { draw0 $agent }; draw1 } if { $alive == 0 } { putsv 1 "All wumpus agents have terminated"; break } } # global version; puts "Map version $version" foreach agent $agents { putsv 1 "$agent score $map($agent,score) - $a2name($agent)" } foreach agent $agents { lappend keep($agent.scores) $map($agent,score) } } foreach agent $agents { set keep($agent.scores) "" } if { $seed == "" } { set seed [rand] } puts "Seed is $seed" randomSeed $seed while { $iter > 0 } { main; incr iter -1 } # foreach agent $agents { puts "$agent score $keep($agent.scores) - $a2name($agent)" } foreach agent $agents { puts "$agent average score [average $keep($agent.scores)] - $a2name($agent)" } # puts [exec ps ux] putsv 0 "Wumpus Driver Terminating"