#! /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 uncollected 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,G,grab) set sc(Mv) -1 ;# penalty -1 for each action set sc(Bu) -10 ;# penalty -10 for bumping into the wall set sc(Sh) -10 ;# penalty -10 for shooting arrow set sc(Di) -1000 ;# penalty -1000 for death set sc(Go) 1000 ;# reward +1000 for getting the gold set sc(RV) 100 ;# reward +100 for each new room visited / explored set sc(QE) 100 ;# reward +100 for quitting back at the entrance (1,1) set sc(KW) 100 ;# reward +100 for killing the wumpus ###################################################################################### # 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, [1-4], initially 1 # map($agent,y) is the y (row) where the agent is, [1-4], initially 1 # 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($agent,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 ###################################################################################### # 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 map(a$count,name) $agent; lappend agents "a$count" } proc putsv {lvl line} { global verbose; if { $verbose >= $lvl } { puts $line } } if { $count == 0 } { usage } proc putsv1 {lvl line} { putsv $lvl $line } ###################################################################################### # 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 show agent { global map set lines ""; set divider "+------+------+------+------+" set xy "$map($agent,x),$map($agent,y)" set status "$map($agent,next) -> $xy" if { $map($agent,dir) == "X" } { set status "DIED" } if { $map($agent,dir) == "Q" } { set status "QUIT" } lappend lines [format %-29.29s "$map($agent,name): $map($agent,score), $status"] foreach y "4 3 2 1" { lappend lines $divider 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($agent,g,$xy)] { set g "G" } append line " $a$w$p$g |" } lappend lines $line } lappend lines $divider lappend lines "" # lappend lines "[format %-13s "score: $map($agent,score)"] perc: $map($agent,perc)" join $lines "\n" } ###################################################################################### proc v args { return 0 } ;# verbosity low proc v args { return 1 } ;# verbosity high proc showAll agents { uplevel { showAllN $agents } } ;# three-up proc showAll agents { uplevel { showAll1 $agents } } ;# one-up proc showAll agents { uplevel { showAll2 $agents } } ;# two-up proc showAll agents { uplevel { showAll3 $agents } } ;# three-up #------------------------------------------------------------------------ # this assumes all block lines are the same length proc showAllN agents { # wide, all on one line uplevel { set output "" foreach id $agents { set output [merge $output [show $id]] } return $output } } proc showAll1 agents { uplevel { set outputAll "" foreach id1 $agents { # one up set outputLine [show $id1] lappend outputAll $outputLine } join $outputAll "\n" } } proc showAll2 agents { uplevel { set outputAll "" foreach {id1 id2} $agents { # three up set outputLine [show $id1] if { $id2 != "" } { set outputLine [merge $outputLine [show $id2]] } lappend outputAll $outputLine } join $outputAll "\n" } } proc showAll3 agents { uplevel { set outputAll "" foreach {id1 id2 id3} $agents { # three up set outputLine [show $id1] if { $id2 != "" } { set outputLine [merge $outputLine [show $id2]] } if { $id3 != "" } { set outputLine [merge $outputLine [show $id3]] } lappend outputAll $outputLine } join $outputAll "\n" } } proc merge {block1 block2} { set output "" set max 0; foreach line1 [split $block1 "\n"] { set len [string length $line1]; if { $len > $max } { set max $len } } foreach line1 [split $block1 "\n"] line2 [split $block2 "\n"] { lappend output "[format %-${max}s $line1] [format %-29.29s $line2]" } join $output "\n" } ###################################################################################### # 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; } ###################################################################################### # main program ###################################################################################### proc main args { global agents map verbose keep sc ###################################################################################### # foreach agent $agents { putsv 0 "agent is $agent" } # agent is either "<" ">" "^" or "V" to show directionality, or "x" if dead 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) "start" } if { [llength $agents] != 1 } { proc putsv1 args { } } ;# only show debug lines if there is exactly one agent ###################################################################################### # 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]; foreach agent $agents { set map($agent,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 ($map($agent,name))" # 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 name $map($agent,name) if ![regexp "/" $name] { set name "./$name" } set keep($agent.pid) [eval spawn $name] 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($agent,g,$xy)] } { append percept "y," } else { append percept "n," } append percept "n,n"; # guaranteed true on first move set map($agent,perc) $percept } puts [showAll $agents] 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 ;# agent died if { $map($agent,dir) == "Q" } continue ;# agent quit incr alive; # count remaining players set spawn_id $keep($agent.sid) set percept $map($agent,perc) putsv1 1 "To $agent: sending percept (stench,breeze,glitter,bump,scream)=($percept)" send "$percept\r" # expect "$percept" ;# we could turn this off with noecho set got "X"; # quit set timeout 1 # watch for crashes. if [catch { expect { -re {^[\r\n]*([^\r\n]+)[\r\n]+} { set got $expect_out(1,string) set got [string toupper $got] # debug lines can be printed "# ... \n" set got [string trim $got] # if [regexp {^#} $got] { # putsv1 1 "Fr $agent: $got" # exp_continue -continue_timer } # putsv 2 "Fr $agent: got ($got)" if ![regexp {^(S|SHOOT|L|LEFT|R|RIGHT|A|FORWARD|Q|QUIT|G|GRAB)$} $got] { putsv1 1 "Fr $agent: $got" exp_continue -continue_timer } set map($agent,next) $got putsv1 1 "Fr $agent: $got" } timeout { putsv 1 "Fr $agent: timeout"; set map($agent,dir) "X" } eof { putsv 1 "Fr $agent: stopped (eof)"; set map($agent,dir) "X" } } } ] { putsv 1 "Fr $agent: died"; set map($agent,dir) "X" } 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 == "GRAB" } { set got "G" } set map($agent,next) $got set x $map($agent,x) set y $map($agent,y) set xy "$x,$y" if ![info exists map($agent,$xy)] { incr map($agent,score) $sc(RV) ;# reward for each new room visited / explored set map($agent,$xy) 1 } ;# visited set dirGot "$map($agent,dir)$got" # we don't count quitting as an action that costs sc(Mv) points if { $got == "Q" } { if { $xy == "1,1" } { incr map($agent,score) $sc(QE) } putsv 1 "## $agent: quitting"; set map($agent,dir) "Q"; continue } incr map($agent,score) $sc(Mv) ;# penalty for each action set killed "n" if { $got == "S" } { if [info exists map($agent,shot)] continue set map($agent,shot) 1 incr map($agent,score) $sc(Sh) ;# penalty for shooting arrow 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; incr map($agent,score) $sc(KW) } ;# reward for killing wumpus } if [info exists map($agent,g,$xy)] { putsv1 1 "## $agent: gold is here. YESSS!" } if { $got == "G" } { # did we get the gold? if [info exists map($agent,g,$xy)] { unset map($agent,g,$xy) ;# can collect only once incr map($agent,score) $sc(Go) } ;# reward for getting the gold } 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 "" } set bump "n" 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 "" } if { $bump == "y" } { incr map($agent,score) $sc(Bu) } ;# penalty for bumping into the wall # 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($agent,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) $sc(Di) ;# penalty for death set map($agent,dir) "X" } # did we fall into a pit? if [info exists map(p,$xy)] { putsv 1 "## $agent: pit is here. AAAAAH!" incr map($agent,score) $sc(Di) ;# penalty for death set map($agent,dir) "X" } } puts [showAll $agents] } 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) - $map($agent,name)" } 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) - $map($agent,name)" } foreach agent $agents { puts "$agent average score [average $keep($agent.scores)] - $map($agent,name)" } # puts [exec ps ux] putsv 0 "Wumpus Driver Terminating"