#!/usr/local/bin/wish8.0

# simulate the monty hall problem
# copyright 1998 Tom Poindexter

global doors			;# array of doors
global mr_confident 		;# sticks with first bet
global mr_bayes     		;# switches bet upon first open doo
global mr_random    		;# switches bet at random upon first open door

set    tries 0
set    wins 0
set    winper "  0.0%"
set    prize "Metcalfe's Volvo"
set    goat  "goat"

set    doors(1) ""
set    doors(2) ""
set    doors(3) ""

# set items behind doors, one grand prize and two booby prizes

proc setItems {} {
  global doors
  global prize goat
  set prizeDoor [expr int((rand()*3)+1)]
  for {set door 1} {$door <= 3} {incr door} {
    if {$prizeDoor == $door} {
      set doors($door) $prize
    } else {
      set doors($door) $goat
    }
  }
}


# open a door that is not the bet and not the prize

proc openDoor {bet} {
  global doors  
  global prize goat
  for {set door 1} {$door <= 3} {incr door} {
    if {$doors($door) != "$prize" && $door != $bet} {
      lappend notDoors $door
    }
  }
  if {[llength $notDoors] == 2} {
    # bet is the prize, so two booby prizes to choose from
    set coinFlip [expr round(rand())]
    set openedDoor [lindex $notDoors $coinFlip]
  } else {
    # bet is a goat, prize is one other door, only one to open
    set openedDoor $notDoors
  }
  set doors($openedDoor) ""
  return $openedDoor
}


# check if winner

proc checkWinner {bet} {
  global doors
  global prize goat
  if {$doors($bet) == "$prize"} {
    return 1
  }
  return 0
}


# switch bets to other closed door 

proc switchBet {bet} {
  global doors
  for {set door 1} {$door <= 3} {incr door} {
    if {$doors($door) != ""} {
      lappend otherDoors $door
    }
  }
  if {$bet == [lindex $otherDoors 0]} {
    return [lindex $otherDoors 1]
  } else {
    return [lindex $otherDoors 0]
  }
}


# check luck of mr_confident

proc mr_confident_game {} {
  global mr_confident
  setItems
  set bet [expr int(rand()*3+1)]
  openDoor $bet
  incr mr_confident [checkWinner $bet]
}


# check luck of mr_bayes

proc mr_bayes_game {} {
  global mr_bayes
  setItems
  set bet [expr int(rand()*3+1)]
  openDoor $bet
  set bet [switchBet $bet]
  incr mr_bayes [checkWinner $bet]
}


# check luck of mr_random

proc mr_random_game {} {
  global mr_random
  setItems
  set bet [expr int(rand()*3+1)]
  openDoor $bet
  set flipCoin [expr round(rand())]
  set bet [expr $flipCoin ?  $bet : [switchBet $bet]]
  incr mr_random [checkWinner $bet]
}


# run several games, accumulating winners

proc run_games {count outcmd} {
  global tries
  global mr_confident mr_bayes mr_random
  set mr_confident 0
  set mr_bayes     0
  set mr_random    0
  for {set i 1} {$i <= $count} {incr i} {
    mr_confident_game
    mr_bayes_game
    mr_random_game
  }
  $outcmd "mr_confident: $mr_confident / $count  \
                         [format %.2f%% [expr (100.0 * $mr_confident)/$count]]"
  $outcmd "mr_bayes    : $mr_bayes / $count  \
                         [format %.2f%% [expr (100.0 * $mr_bayes)/$count]]"
  $outcmd "mr_random   : $mr_random / $count  \
                         [format %.2f%% [expr (100.0 * $mr_random)/$count]]"
}


proc setUpGame {} {
  setItems
  frame .doorFrame
  label .door1 -text " Door # 1 "
  label .door2 -text " Door # 2 "
  label .door3 -text " Door # 3 "
  pack .door1 .door2 .door3 -in .doorFrame -side left -padx 20 -pady 10
  frame .chooseDoor
  button .choose1 -text "1" -command "set bet 1;doOpenDoor;askSwitch"
  button .choose2 -text "2" -command "set bet 2;doOpenDoor;askSwitch"
  button .choose3 -text "3" -command "set bet 3;doOpenDoor;askSwitch"
  pack .choose1 .choose2 .choose3 -in .chooseDoor -side left -padx 20
  frame .peekFrame
  label .peek1 -text ""
  label .peek2 -text ""
  label .peek3 -text ""
  pack .peek1 .peek2 .peek3 -in .peekFrame -side left -padx 20
  frame .betFrame
  label .betTxt -text "Your bet: "
  label .betChoice -text "" -textvariable bet
  pack .betTxt .betChoice -in .betFrame -side left -expand 1
  frame .switchFrame
  label .switchTxt -text "Switch bet? "
  button .switchYes -text Yes -command {set bet [switchBet $bet];showWinner}
  button .switchNo  -text No  -command {showWinner}
  pack .switchTxt .switchYes .switchNo -in .switchFrame -side left
  frame .winFrame
  label .winTxt -text " Number of wins / tries: "
  label .winsCount -text 0 -textvariable wins
  label .winsTxt1 -text /
  label .winsTrys -text 0 -textvariable tries
  label .winPer  -textvariable winper
  pack .winTxt .winsCount .winsTxt1 .winsTrys .winPer -in .winFrame -side left
  frame .cmdFrame
  label .quitTxt -text "   Had enough? "
  button .quitYes -text " Yes, quit " -command "destroy ."
  button .quitNo  -text " No, let me try again! "  -command resetGame
  pack .quitTxt .quitYes .quitNo -in .cmdFrame -side left
  frame .auxFrame
  button .reset  -text " Reset Score " -command {set tries 0; set wins 0; set winper "  0.0%"; newGame; takeBet}
  button .peek -text " Peek " -command doPeek
  button .simRun -text " Run Simulation " -command runSim
  pack .simRun .reset .peek -side left -in .auxFrame

  pack .doorFrame .peekFrame .chooseDoor .betFrame .switchFrame .switchFrame .winFrame .cmdFrame .auxFrame -side top -pady 4
   
  takeBet
}

proc takeBet {} {
  .choose1 config -state normal
  .choose2 config -state normal
  .choose3 config -state normal
  .betTxt  config -fg black
  .switchYes config -state disabled
  .switchNo  config -state disabled
  .switchTxt config -fg grey50
}

proc askSwitch {} {
  .choose1 config -state disabled
  .choose2 config -state disabled
  .choose3 config -state disabled
  .betTxt  config -fg black
  .switchYes config -state normal
  .switchNo  config -state normal
  .switchTxt config -fg black
}

proc doPeek {} {
  global doors goat
  foreach d {1 2 3} {
    set txt $doors($d)
    if {"$txt" == ""} {set txt $goat}
    .peek$d config -text $txt -fg yellow
  }
  update
  after 2000
  foreach d {1 2 3} {
    .peek$d config -text "" -fg black
  }
  update
}

proc doOpenDoor {} {
  global doors
  global bet
  global goat
  set openedDoor [openDoor $bet]
  .door$openedDoor config -text " $goat " -fg red
}

proc newGame {} {
  global bet
  set bet ""
  .door1 config -text " Door # 1 " -fg black
  .door2 config -text " Door # 2 " -fg black
  .door3 config -text " Door # 3 " -fg black
}

proc runSim {} {
  catch {destroy .simFrame}
  frame .simFrame
  listbox .simFrame.l -width 45 -height 8
  button .simFrame.closeTop -text " Close " -command "pack forget .simFrame;destroy .simFrame"
  pack .simFrame.l -expand 1 -fill both
  pack .simFrame.closeTop 
  pack .simFrame -in . -side top
  update
  insSim "mr_confident always holds his bet"
  insSim "mr_bayes always switches his bet"
  insSim "mr_random flips a coin to switch or not"
  insSim "running 1000 games..."
  update 
  run_games 1000 insSim
}

proc insSim {line} {
  .simFrame.l insert end $line
}

proc showWinner {} {
  global doors
  global bet
  global prize goat
  global wins tries winper
  incr wins [checkWinner $bet]
  incr tries
  set winper [format "  %.2f%%" [expr (100.0 * $wins) / $tries]]
  foreach d {1 2 3} {
    if {$doors($d) == ""} {
      set doors($d) $goat
    }
    .door$d config -text $doors($d)
    if {"$doors($d)" == "$prize"} {
      .door$d config -fg blue
    } else {
      .door$d config -fg red
    }
  }
  .switchYes config -state disabled
  .switchNo  config -state disabled
  .switchTxt config -fg grey50
}

proc resetGame {} {
  setItems
  newGame
  takeBet
}

setUpGame