Bulls and Cows


Task

Create a four digit random number from the digits   1   to   9,   without duplication.

The program should:

   ask for guesses to this number
   reject guesses that are malformed
   print the score for the guess


The score is computed as:

 The player wins if the guess is the same as the randomly chosen number, and the program ends.
 A score of one bull is accumulated for each digit in the guess that equals the corresponding digit in the randomly chosen initial number.
 A score of one cow is accumulated for each digit in the guess that also appears in the randomly chosen number, but in the wrong position.


Related tasks

   Bulls and cows/Player
   Guess the number
   Guess the number/With Feedback
   Mastermind


proc main {} {
    fconfigure stdout -buffering none
    set length 4
 
    puts "I have chosen a number from $length unique digits from 1 to 9 arranged in a random order.
You need to input a $length digit, unique digit number as a guess at what I have chosen
    "
 
    while true {
        set word [generateWord $length]
        set count 1
        while {[set guess [getGuess $length]] ne $word} {
            printScore $length $word $guess
            incr count
        }
        puts "You guessed correctly in $count tries."
        if {[yn "Play again?"] eq "n"} break
    }
}
 
proc generateWord {length} {
    set chars 123456789
    for {set i 1} {$i <= $length} {incr i} {
        set idx [expr {int(rand() * [string length $chars])}]
        append word [string index $chars $idx]
        set chars [string replace $chars $idx $idx]
    }
    return $word
 
    # here's another way to generate word with no duplications
    set word ""
    while {[string length $word] < $length} {
        set char [expr {int(1 + 9*rand())}]
        if {[string first $char $word] == -1} {
            append word $char
        }
    }
}
 
proc getGuess {length} {
    puts -nonewline "Enter your guess: "
    while true {
        gets stdin guess
        if {[string match [string repeat {[1-9]} $length] $guess]} {
            return $guess
        }
        if {[string tolower [string trim $guess]] eq "quit"} {
            puts Bye
            exit
        }
        puts "The word must be $length digits between 1 and 9 inclusive.  Try again."
    }
}
 
proc printScore {length word guess} {
    set bulls 0
    set cows 0
    for {set i 0} {$i < $length} {incr i} {
        if {[string index $word $i] eq [string index $guess $i]} {
            incr bulls
            set word [string replace $word $i $i +]
        }
    }
    puts "  $bulls bulls"
    for {set i 0} {$i < $length} {incr i} {
        if {[set j [string first [string index $guess $i] $word]] != -1} {
            incr cows
            set word [string replace $word $j $j -]
        }
    }
    puts "  $cows cows"
}
 
proc yn {msg} {
    while true {
        puts -nonewline "$msg \[y/n] "
        gets stdin ans
        set char [string tolower [string index [string trim $ans] 0]]
        if {$char eq "y" || $char eq "n"} {
            return $char
        }
    }
}
 
main