Rules: in each round both players (one is the computer) think of a number with four digits without the 0 and without repeated digits. Each player has to guess the other player's number. To each guess the opponent must answer the number of digits guessed correctly in the right place and the number of digits guessed correctly but in the wrong place. For instance if the number is 7583 and the guess is 6537 the answer is: 1 digit in the correct place (5) and 2 digits in the wrong place (3 and 7).

To win the match each player must win a number of rounds fixed answering the first computer's question. 

To play the game, first run Routines and the run newmatch. For a new match run newmatch.

Routines

\(\(\(
\)\(
\)\(generatelist := 
      Module[{a1, a2, a3, a4, \ k2, k3, k4, 
          allstrings}, 
allstrings = {}; 
a1 = Range[9]; 
Do[\ 
          a2 = Drop[
              a1, {i1}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[\ 
            k2 = a2[\([i2]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ a3 = 
              Drop[a2, {i2}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[
              k3 = a3[\([i3]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ a4 = Drop[
                  a3, {i3}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Do[k4 = 
                  a4[\([i4]\)]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ AppendTo[
                  allstrings, {i1, k2, k3, 
                    k4}];
						, {i4, 
                  6}];
					, {i3, 
                7}];
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , {i2, 
              8}];
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , {i1, 
            9}]; 
allstrings
]\)\)\)

stringlist = generatelist;

checkpositions[a_, b_] := 
      Module[{c}, 
c = 
          0; 
        Do[
          If[a[[i]] == b[[i]], c++], {i, 
            4}]; 
c
]

checkstrings[a_, b_] := 
      Module[{c1, c2, br}, 
c1 = 
          checkpositions[a, b]; 
c2 = 
          0; 
br = b; 
Do[
          br = RotateRight[br]; 
    c2 +=  
            checkpositions[a, br], {3}]; 
{c1, 
          c2}
]

currentlist = stringlist;

reducelist[number_, a_] := 
      Module[{newlist}, 
      newlist = {}; 
      Do[    If[
            checkstrings[currentlist[[i]], number] == a, 
            AppendTo[newlist, currentlist[[i]]]], {i, 
            Length[currentlist]}]; 
newlist
]

computeremaining[mychoice_, otherchoice_] := 
      Module[{a, p}, 
a = 
          checkstrings[mychoice, otherchoice]; 
  p = 
          0; 
Do[ 
          If[checkstrings[currentlist[[i]], mychoice] == 
              a, p++], {i,  
            Length[currentlist]}]; 
p
]

computeremaining[currentlist[[1]], currentlist[[6]]]

checkmychoiceagainstall[mychoice_] := 
      Module[{q, qq}, 
qq = 0; 
Do[
          q = computeremaining[mychoice, currentlist[[i]]]; 
          If[q > qq, qq = q], {i, 
            Length[currentlist]}]; 
qq
]

choosenumber := 
      Module[{r, best, pvect, choices}, 
If[
          Length[currentlist] > 30, 
r = 
            Random[Integer, {1, 
                Length[currentlist]}]; 
   currentlist[[r]]
, 
pvect = 
            Table[checkmychoiceagainstall[currentlist[[i]]], {i, 
                Length[currentlist]}]; 
 
          best = Min[pvect]; 
choices = 
            Flatten[Position[pvect, best]]; 
r = 
            Random[Integer, {1, 
                Length[choices]}]; 
currentlist[[choices[[r]]]]
]]

stringtonumber[a_] := 
      a[[1]] 1000 + a[[2]] 100 + a[[3]] 10  +  
        a[[4]]

\(newgame := 
      Module[{endflag, computerguess, a1, a2, mynumber, manguess, 
          mannumberguess, exit}, 
currentlist = 
          stringlist; 
mynumber = 
          choosenumber; 
Print["Think of a number.I have already chosen a number. "]; 
endflag = 
          False; 
While[\ \(! endflag\), 
mannumberguess = \ 
            Input["guess my number     "]; 
If[
            mannumberguess == 
              stringtonumber[
                mynumber]\ 
\ , \ \ \ \ endflag = 
              True; 
\ \ \ \ \ \ \ \ \ \ Print["congratulations! You got my number, but I have one more choice"]; 
\ \ \ \ \ \ \ \ \ \ computerselection = 
              choosenumber; 
\ \ \ \ \ \ \ \ \ Print["this is my guess  ", 
              stringtonumber[
                computerselection]]; 
\ \ \ \ \ \ \ \ \ a1 = Input["How many symbols in the right places?"]; 
\ \ \ \ \ \ \ \ \ \ \ If[a1 == 4, Print["sorry, only a tie !"]; 
              exit = 0, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ a2 = Input["How many symbols in the wrong places?"]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Print["ok your answer is ", {a1, 
                  a2}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ currentlist = reducelist[
                  computerselection, {a1, 
                    a2}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[currentlist == {}, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Print["ah! you tried to cheat me! This round is over!"]; 
                exit = 0, \ \ \ \ \ \ \ Print["the round is yours, congratulations!"]; 
                exit = \(-1\)]]
\ , \ \ \ \ manguess = 
              IntegerDigits[\ 
                mannumberguess]; 
\ \ \ \ \ \ \ \ \ Print["the result of your guess ", mannumberguess, "  is   ", 
              checkstrings[manguess, 
                mynumber]]; 
\ \ \ \ \ \ \ \ computerselection = 
              choosenumber; 
\ \ \ \ \ \ \ \ \ Print["this is my guess  ", 
              stringtonumber[
                computerselection]]; 
\ \ \ \ \ \ \ \ a1 = 
              Input["How many symbols in the right places?"]; 
\ \ \ \ \ \ \ \ While[a1\  > \ \ 4, \ 
              Print["YOU ... PAY ATTENTION TO MY QUESTIONS ! Answer again correctly"]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ a1 = Input["How many symbols in the right places?"];
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]; 
\ \ \ \ \ \ \ endflag = 
              a1 == 4; 
\ \ \ \ \ \ \ If[\ endflag, 
              exit = 1; 
              Print["The round is mine! My number was ", 
                stringtonumber[
                  mynumber]\ \ ]
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ , \ \ a2 = 
                Input["How many symbols in the wrong places?"]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Print["ok your answer is ", {a1, 
                  a2}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ currentlist = 
                reducelist[
                  computerselection, {a1, 
                    a2}]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[currentlist == {}, 
                Print["you tried to cheat me! This round is over!"]; 
                exit = 0; 
                endflag = 
                  True]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[Length[currentlist] == 1, 
                Print["your number MUST be ", 
                  stringtonumber[
                    currentlist[\([1]\)]], \ \ ". You have still one choice, try ... "]; 
\ \ \ \ \ \ \ mannumberguess = \ 
                  Input["final guess "]; 
\ \ \ \ \ \ \ If[mannumberguess == stringtonumber[
                      mynumber]\ , 
\ \ \ \ Print["Ok a tie, you are a good player"]; exit = 0, 
                  exit = 1; 
\ \ \ Print["sorry, I have won the round! My number was ", stringtonumber[mynumber]]]; 
                endflag = 
                  True];
\ \ \ \ \ \ \ \ \ \ \ \ ]
\ \ \ ];

]; 
exit]\)

\(newmatch := 
      Module[{num, myvict, yourvict, exit}, 
\ 
        num = Input["how many rounds to win?"]; 
\ 
        If[num == 0, 
          Print["OK.. looks you don't like playing"], 
\ \ \ \ myvict = 0; 
          yourvict = 0; 
\ \ While[
            Max[myvict, yourvict] < 
              num, 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[
              Max[myvict, yourvict] > 0, 
              Print["The situation is ", myvict, " for me and ", 
                yourvict, " for you"]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ exit = 
              newgame; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Which[exit == \(-1\), \(yourvict++\), exit == 1, \(myvict++\), 
              True, Null]
\ \ \ \ \ \ \ \ \ \ \ ]; 
If[myvict == num, 
            Print["I have won the match! Too hard to beat me! "], 
            Print["I can't believe it! You have won! You must be a computer."]]
]]\)

newmatch