Mastermind solver

[Trond]

This is a mastermind solver. You select the answer (left/right mouse button) and let the computer guess. Then give the computer feedback with red and white pegs. After a while it guesses your code! It's like magic!

Red peg = correct colour at the correct position
White peg = correct colour at the wrong position

The detailed rules are at wikipedia: http://en.wikipedia.org/wiki/Mastermind_(board_game)

Update: it now alerts you if you give the wrong feedback.

Code: Select all

Enumeration
  #c_Red
  #c_Green
  #c_Blue
  #c_Black
  #c_White
  #c_Yellow
  #c_Pink
  #c_Orange
  #c_None
  #c_Max
EndEnumeration

Global Dim ColorsRGB(#c_Max)
ColorsRGB(#c_None) = RGB(192, 192, 192)
ColorsRGB(#c_Red) = RGB(255, 0, 0)
ColorsRGB(#c_Green) = RGB(10, 245, 10)
ColorsRGB(#c_Blue) = RGB(10, 10, 245)
ColorsRGB(#c_Black) = RGB(0, 0, 0)
ColorsRGB(#c_White) = RGB(255, 255, 255)
ColorsRGB(#c_Yellow) = RGB(230, 230, 20)
ColorsRGB(#c_Pink) = RGB(255, 10,  230)
ColorsRGB(#c_Orange) = RGB(255, 110,  0)

Global Dim ColorsTxt.s(#c_Max)
ColorsTxt(#c_Red)   = "Red"
ColorsTxt(#c_Green) = "Green"
ColorsTxt(#c_Blue)  = "Blue"
ColorsTxt(#c_Black) = "Black"
ColorsTxt(#c_White) = "White"
ColorsTxt(#c_Yellow) = "Yellow"
ColorsTxt(#c_Pink)  = "Pink"
ColorsTxt(#c_Orange) = "Orange"

Global GameRunning = 0

Global Dim Board(12, 3)
Global Dim Pins(12, 1)
Global BoardPos = 0
Global Dim Answer(3)
Global Dim AnswerXY(3, 1)

Procedure NewAnswer()
  For I = 0 To 3
    Answer(i) = Random(#c_None-1)
  Next
EndProcedure

Procedure ClearBoard()
  For I = 0 To 12
    For J = 0 To 3
      Board(I, J) = #c_None
    Next
    Pins(I, 0) = 0
    Pins(I, 1) = 0
  Next
EndProcedure

Procedure PointDistance(x1, y1, x2, y2)
  xoff = x2-x1
  yoff = y2-y1
  ProcedureReturn Abs(Sqr(xoff*xoff + yoff*yoff))
EndProcedure

Procedure DrawColors()
  r = 10
  StartDrawing(ImageOutput(0))
    Box(0, 0, ImageWidth(0), ImageHeight(0), #White)
    For i = 0 To #c_Max-2
      y = 50+ i*r*2.6
      Circle(25, y, r+1, 0)
      Circle(25, y, r, ColorsRGB(i))
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawText(25+r*1.6, y-r/2-1, ColorsTxt(i), 0)
      DrawText(25+r*1.6-1, y-r/2-2, ColorsTxt(i), ColorsRGB(i))
    Next
  StopDrawing()
EndProcedure

Procedure DrawBoard()
  r = 9
  xi = 125
  StartDrawing(ImageOutput(0))
    Box(110, 0, 200, ImageHeight(0), RGB(244, 244, 44))
    For i = 0 To 12-1
      y = 30+ i*r*3.7
      x = xi
      For n = 0 To 3
        x + r*3
        Circle(x, y, r+1, 0)
        Circle(x, y, r, ColorsRGB(Board(i, n)))
      Next
      
      x + r*2
      c = #Red
      For n = 0 To Pins(i, 0) + Pins(i, 1)-1
        If n = Pins(i, 0)
          c = #White
        EndIf
        x + 10
        DrawingMode(#PB_2DDrawing_Outlined)
        Circle(x, y, 4, RGB(32, 32, 32))
        DrawingMode(#PB_2DDrawing_Default)
        Circle(x, y, 3, c)
      Next
    Next
    
    x = xi
    y = y+20
    
    Box(x, y, 150, 3, RGB(70, 40, 40))
    
    y + r*2.5
    
    For I = 0 To 3
      x + r*3
      Circle(x, y, r+1, 0)
      Circle(x, y, r, ColorsRGB(Answer(i)))
      AnswerXY(i, 0) = x
      AnswerXY(i, 1) = y
    Next
    
  StopDrawing()
EndProcedure

Procedure RedrawBoard()
  DrawBoard()
  SetGadgetState(0, ImageID(0))
EndProcedure

Procedure LogicOk(Array Guess(1), Row)
  Protected Pos
  Protected Col
  Protected Dim Copy(3)
  Protected Dim GuessCopy(3)
  For i = 0 To 3
    Copy(i) = Board(Row, i)
  Next
  For i = 0 To 3
    GuessCopy(i) = Guess(i)
  Next
  ; Check for same position
  For i = 0 To 3
    If GuessCopy(i) = Copy(i)
      Pos + 1
      Copy(i) = #c_None ; used later when checking for colors at wrong positions
      GuessCopy(i) = #c_Max
    EndIf
  Next
  If Pos <> Pins(Row, 0)
    ProcedureReturn 0
  EndIf
  ; Check for colors at other positions
  For i = 0 To 3
    For j = 0 To 3
      If GuessCopy(i) = Copy(j)
        Col + 1
        Copy(j) = #c_None
        Break 1
      EndIf
    Next
  Next
  If Col <> Pins(Row, 1)
    ProcedureReturn 0
  EndIf
  ProcedureReturn 1
EndProcedure

Procedure RandomGuess(Array Guess(1))
  Static Combo = -1
  If Combo = -1
    Combo = Random(4095)
  EndIf
  
  Guess(0) = Combo % 8
  Guess(1) = (Combo / 8) % 8
  Guess(2) = (Combo / (8*8)) % 8
  Guess(3) = (Combo / (8*8*8)) % 8
  
  Combo + 1
  Combo % 4096
EndProcedure

Procedure RandomEngineGuess()
  Dim Guess(3)
  Repeat
    RandomGuess(Guess())
    Ok = 1
    For i = 0 To BoardPos-1
      If LogicOk(Guess(), i) = 0
        Ok = 0
        Break
      EndIf
    Next
    If Iter > 10000
      MessageRequester("", "I can't solve it! I bet you gave me the wrong peg count somewhere.")
      Break
    EndIf
    Iter + 1
  Until Ok
  
  
  For i = 0 To 3
    Board(BoardPos, i) = Guess(I)
  Next
EndProcedure

Procedure MakeGuess()
  RandomEngineGuess()
EndProcedure

Procedure EnterPinsOk(Red, White)
  Protected Dim Guess(3)
  Protected Dim AnswerCp(3)
  Protected RightRed
  Protected RightWhite
  For I = 0 To 3
    AnswerCp(I) = Answer(I)
  Next
  For I = 0 To 3
    Guess(I) = Board(BoardPos, I)
  Next
  ; Check red
  For I = 0 To 3
    If Guess(I) = AnswerCp(I)
      Guess(I) = #c_None
      AnswerCp(I) = #c_Max
      RightRed + 1
    EndIf
  Next
  ; Check white
  For i = 0 To 3
    For j = 0 To 3
      If Guess(i) = AnswerCp(j)
        RightWhite + 1
        AnswerCp(j) = #c_Max
        Break 1
      EndIf
    Next
  Next
  ; Ok?
  Protected Message.s
  If RightRed <> Red 
    Message = "That should be " + Str(RightRed) + " red pegs"
  EndIf
  If RightWhite <> White
    If Message
      Message + " and "
    Else
      Message = "That should be "
    EndIf
    Message + Str(RightWhite) + " white pegs."
  Else
    If Message
      Message + "."
    EndIf
  EndIf
  If Message
    MessageRequester("Mastermind", "Don't cheat! " + Message)
    ProcedureReturn 0
  EndIf
  ProcedureReturn 1
EndProcedure

Procedure EnterPins(Red, White)
  If EnterPinsOk(Red, White)
    Pins(BoardPos, 0) = Red
    Pins(BoardPos, 1) = White
    If Red = 4
      ProcedureReturn 2
    EndIf
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure OnImageClick(x, y, mod)
  If GameRunning
    ProcedureReturn 0
  EndIf
  
  For I = 0 To 3
    If PointDistance(x, y, AnswerXY(i, 0), AnswerXY(i, 1)) < 10
      Answer(i) + mod
      Answer(i) % #c_None
      If Answer(i) < 0
        Answer(i) + #c_None
      EndIf
      RedrawBoard()
      Break
    EndIf
  Next
EndProcedure

CreateImage(0, 340, 480)
ClearBoard()
NewAnswer()
DrawColors()
DrawBoard()

OpenWindow(0, 0, 0, 640, 480, "Mastermind", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
ImageGadget(0, 0, 0, 0, 0, ImageID(0))
ContainerGadget(20, 350, 30, 200, 200)

TextGadget(1, 0, 3, 80, 22, "Red pegs:", #PB_Text_Right)
TextGadget(2, 0, 33, 80, 22, "White pegs:", #PB_Text_Right)
SpinGadget(3, 85, 0, 40, 22, 0, 4, #PB_Spin_Numeric)
SpinGadget(4, 85, 30, 40, 22, 0, 4, #PB_Spin_Numeric)
SetGadgetState(3, 0)
SetGadgetState(4, 0)
ButtonGadget(5, 135, 0, 52, 52, "Ok")

CloseGadgetList()
HideGadget(20, 1)

ButtonGadget(6, 350, 30, 200, 60, "Start")

ContainerGadget(21, 350, 30, 200, 200)
TextGadget(7, 0, 3, 80, 22, "Game solved.")
ButtonGadget(8, 0, 33, 200, 60, "Play again")
HideGadget(21, 1)


Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 5 ; enter peg
          PegEnter = EnterPins(GetGadgetState(3), GetGadgetState(4))
          Select PegEnter
            Case 0
            Case 1
              BoardPos + 1
              MakeGuess()
              RedrawBoard()
            Case 2
              RedrawBoard()
              HideGadget(20, 1)
              HideGadget(21, 0)
          EndSelect
        Case 6 ; start game
          GameRunning = 1
          MakeGuess()
          RedrawBoard()
          HideGadget(6, 1)
          HideGadget(20, 0)
        Case 8 ; restart game
          HideGadget(21, 1)
          HideGadget(6, 0)
          GameRunning = 0
          BoardPos = 0
          ClearBoard()
          NewAnswer()
          RedrawBoard()
        Case 0 ; image
          Select EventType()
            Case #PB_EventType_LeftClick, #PB_EventType_LeftDoubleClick
              OnImageClick(WindowMouseX(0), WindowMouseY(0), 1)
            Case #PB_EventType_RightClick, #PB_EventType_RightDoubleClick
              OnImageClick(WindowMouseX(0), WindowMouseY(0), -1)
          EndSelect
      EndSelect
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

[citystate]

first attempt - I win with Yellow Black Green Green - it gave up after 5 tries

[SFSxOI]

Interesting. Thank You

[Demivec]

It fails repeatedly for me also. I'm guessing it can't handle guesses properly that include an extra duplicate color. Here is a screenshot where I've snipped the unused guesses:



Are the peg responses given here correct?

[Kuron]

Very interesting and very cool, Trond!!!!

[Trond]

first attempt - I win with Yellow Black Green Green - it gave up after 5 tries

For me too. After looking closely, I found that I gave it the wrong feedback.

Are the peg responses given here correct?

They are not.
In the first row, there should be one red (for the pink) and one white (for the green).
In the fifth row, there should be three red and no white.

See here: http://en.wikipedia.org/wiki/Mastermind_(board_game)

Maybe I should make an auto-feedback?

[Trond]

If it fails and you're sure you gave the correct feedback, please say which colours it used in its first guess (or post a screenshot). That way I can debug it.

[citystate]

target: Yel Blk Grn Grn

guess 1: Wht Grn Yel Blk (www)
guess 2: Grn Blk Red Wht (rw)
guess 3: Yel Blu Grn Wht (rr)
guess 4: Yel Wht Blk Wht (rw)
guess 5: Yel Blk Grn Yel (rrw)
guess 6: Orn Wht Orn Pnk (gives up)

[Trond]

You're giving wrong feedback at step 5.

[BillNee]

Hi - Great game
Any way to reset the red and white pegs to "0" at the start of a new game?
When it got stumped in the old version you had to close and restart. Haven't stumped it yet in the new version so don't know it it's still that way.
Good job
Bill Nee

[Trond]

Theoretically it cannot fail any more, so it shouldn't be a problem. It refuses to accept wrong red/white peg entries. Theoretically it doesn't even need user input.