LiveEvolutionTicTac.fsx

#I "../NeuralFish"
#load "NeuralFish_dev.fsx"

open NeuralFish.Types
open NeuralFish.Core
open NeuralFish.EvolutionChamber
open NeuralFish.Exporter

type SquareId = int

type PlayerId = int

type CheckSquare =
  | Zero
  | One
  | Two
  | Three
  | Four
  | Five
  | Six
  | Seven
  | Eight
  | IDontKnow

type TicTacBoard = Map<SquareId, int>

type TicTacGameStatus =
  | GameOver of PlayerId
  | ContinueGame

type TicTacMsg =
  | ReceiveMove of PlayerId*CheckSquare*AsyncReplyChannel<unit>
  | GetGameStatusAndBoard of AsyncReplyChannel<TicTacGameStatus*TicTacBoard>
  | GetLastMove of PlayerId*AsyncReplyChannel<CheckSquare>
  | GetGameBoard of AsyncReplyChannel<TicTacBoard>
  | ClearGame of AsyncReplyChannel<unit>
  | KillGame

type TicTacInstance = MailboxProcessor<TicTacMsg>

type MoveBuffer = Map<PlayerId, CheckSquare>

let winPatterns =
  let row1 = [0; 1; 2]
  let row2 = [3; 4; 5]
  let row3 = [6; 7; 8]
  let column1 = [0; 3; 6]
  let column2 = [1; 4; 7]
  let column3 = [2; 5; 8]
  let backSlash = [0; 4; 8]
  let forwardSlash = [2; 4; 6]
  [
   row1
   row2
   row3
   column1
   column2
   column3
   backSlash
   forwardSlash
  ]

let ticTacInstance =
  let checkForWin (gameBoard : TicTacBoard) =
    let checkWinPattern playerId winPattern =
      let checkIfPlayerOccupiesSquare playerId squareId =
        match gameBoard |> Map.tryFind squareId with
        | None -> false
        | Some playerIdThatOccupiesSquare ->
            (playerIdThatOccupiesSquare = playerId)
      winPattern |> List.forall (checkIfPlayerOccupiesSquare playerId)
    let didPlayer1Win =
      let checkWinFunction = checkWinPattern 1
      winPatterns |> List.exists checkWinFunction
    let didPlayer2Win =
      let checkWinFunction = checkWinPattern 2
      winPatterns |> List.exists checkWinFunction
    if didPlayer1Win then
      printfn "Player 1 Wins!"
      GameOver 1
    else if didPlayer2Win then
      printfn "Player 2 Wins!"
      GameOver 2
    else ContinueGame
  let printGameBoard (gameBoard : TicTacBoard) =
   let printSquare squareId =
     let squareContents =
       match gameBoard |> Map.tryFind squareId with
         | None -> 0
         | Some playerId -> playerId
     if [2; 5; 8] |> List.contains squareId then
       printfn "| %i |" squareContents
     else
       printf "| %i " squareContents
   printfn "------------------------------------"
   [0..8]
   |> Seq.iter printSquare
   printfn "------------------------------------"
  TicTacInstance.Start(fun inbox ->
    let rec loop (gameBoard : TicTacBoard)
                   (lastMoveBuffer : MoveBuffer)
                     (gameStatus : TicTacGameStatus)=
      async {
        let! msg = inbox.Receive ()
        match msg with
        | ReceiveMove (playerId, checkSquareCommand, replyChannel) ->
          let updatedGameBoard, boardGameStatus =
            if (gameBoard |> Map.toSeq |> Seq.length) >= 9 then
              gameBoard, GameOver 0
            else
              let gameBoardAfterMove =
                let rec processMove squareNumber =
                  if squareNumber > 8 then
                    processMove 0
                  else
                    match gameBoard |> Map.tryFind squareNumber with
                    | None ->
                      gameBoard
                      |> Map.add squareNumber playerId
                    | Some _ -> processMove (squareNumber+1)
                match checkSquareCommand with
                | Zero -> processMove 0
                | One -> processMove 1
                | Two -> processMove 2
                | Three -> processMove 3
                | Four -> processMove 4
                | Five -> processMove 5
                | Six -> processMove 6
                | Seven -> processMove 7
                | Eight -> processMove 8
                | IDontKnow -> processMove 0
              gameBoardAfterMove, ContinueGame
          let updatedMoveBuffer =
            lastMoveBuffer
            |> Map.add playerId checkSquareCommand
          let updatedGameStatus =
            match updatedGameBoard |> checkForWin with
            | GameOver winner -> GameOver winner
            | ContinueGame -> boardGameStatus
          replyChannel.Reply ()
          printGameBoard updatedGameBoard
          return! loop updatedGameBoard updatedMoveBuffer updatedGameStatus
        | GetGameBoard replyChannel ->
          async {
            gameBoard
            |> replyChannel.Reply
          } |> Async.Start
          return! loop gameBoard lastMoveBuffer gameStatus
        | GetLastMove (playerId, replyChannel) ->
          async {
            let lastMove =
              match lastMoveBuffer |> Map.tryFind playerId with
              | None -> IDontKnow
              | Some move -> move
            lastMove
            |> replyChannel.Reply
          } |> Async.Start
          return! loop gameBoard lastMoveBuffer gameStatus
        | GetGameStatusAndBoard replyChannel ->
          (gameStatus, gameBoard)
          |> replyChannel.Reply
          return! loop gameBoard lastMoveBuffer gameStatus
        | ClearGame replyChannel ->
          printfn "New TicTacToe Game"
          printGameBoard Map.empty
          replyChannel.Reply()
          return! loop Map.empty Map.empty ContinueGame
        | KillGame ->
          ()
      }
    loop Map.empty Map.empty ContinueGame
  )

let gameActionOutputHookId = 0

let getOutputHook playerId : OutputHookFunction =
  (fun neuralOutput ->
   let interpretedAnswer =
     match neuralOutput |> round with
     | 0.0 -> Zero
     | 1.0 -> One
     | 2.0 -> Two
     | 3.0 -> Three
     | 4.0 -> Four
     | 5.0 -> Five
     | 6.0 -> Six
     | 7.0 -> Seven
     | 8.0 -> Eight
     | _ -> IDontKnow
   (fun r -> ReceiveMove(playerId, interpretedAnswer, r))
   |> ticTacInstance.PostAndReply
  )

let getFitnessFunction playerId : LiveFitnessFunction =
  (fun _ ->
   let lastMove =
     (fun r -> GetLastMove(playerId, r))
     |> ticTacInstance.PostAndReply
   let gameStatus, gameBoard =
     GetGameStatusAndBoard
     |> ticTacInstance.PostAndReply
   match gameStatus with
   | GameOver winner ->
     if (winner = playerId) then
       10.0, EndThinkCycle
     else
       0.0, EndThinkCycle
   | ContinueGame ->
     let maybeAnswerSquareId =
       match lastMove with
       | Zero -> Some 0
       | One -> Some 1
       | Two -> Some 2
       | Three -> Some 3
       | Four -> Some 4
       | Five -> Some 5
       | Six -> Some 6
       | Seven -> Some 7
       | Eight -> Some 8
       | IDontKnow -> None
     match maybeAnswerSquareId with
     | None -> -4.0, ContinueThinkCycle
     | Some answerSquareId ->
       if (gameBoard |> Map.find answerSquareId) = playerId then
         0.0, ContinueThinkCycle
       else
         -2.0, ContinueThinkCycle
  )

let getSyncFunction playerId : SyncFunction =
  (fun () ->
   let constructDataVector (recordedMovesOnBoard : TicTacBoard) =
     let getRecordedMove squareId =
       match recordedMovesOnBoard |> Map.tryFind squareId with
       | None -> 0.0
       | Some playerId -> playerId |> float
     [0..8]
     |> Seq.map getRecordedMove
   GetGameBoard
   |> ticTacInstance.PostAndReply
   |> constructDataVector
  )

let selectFitPopulation : FitPopulationSelectionFunction =
  (fun scoredNodeRecords ->
   let dividedLength =
     let length = (scoredNodeRecords |> Array.length) / 5
     if (length < 2) then
       2
     else
       length
   scoredNodeRecords
   |> Array.sortByDescending(fun (_,(score,_)) -> score)
   |> Array.chunkBySize dividedLength
   |> Array.head
   |> Array.Parallel.map (fun (key,(_,value)) -> key, value)
   |> Map.ofArray
  )
let infoLog = (fun _ -> ())

let player1AI =
  let playerId = 1
  let activationFunctions =
    Map.empty
    |> Map.add 0 sigmoid
  let outputHookFunctionIds : OutputHookFunctionIds =
    [gameActionOutputHookId]
    |> List.toSeq
  let learningAlgorithm = Hebbian 0.7
  let startingRecords : GenerationRecords =
    let nodeRecords =
      getDefaultNodeRecords activationFunctions outputHookFunctionIds 0 learningAlgorithm infoLog
    Map.empty
    |> Map.add 0 nodeRecords
  let outputHooks : OutputHookFunctions =
    let outputHook = getOutputHook playerId
    Map.empty
    |> Map.add gameActionOutputHookId outputHook
  let syncFunctions : SyncFunctions =
    let syncFunction = getSyncFunction playerId
    Map.empty
    |> Map.add 0 syncFunction
  let fitnessFunction = getFitnessFunction playerId
  {
      StarterRecords = startingRecords
      MutationSequence = minimalMutationSequence
      MaximumMindsPerGeneration = 10
      MaximumThinkCycles = None
      FitnessFunction = fitnessFunction
      FitPopulationSelectionFunction = selectFitPopulation
      ActivationFunctions = activationFunctions
      SyncFunctions = syncFunctions
      OutputHookFunctions = outputHooks
      EndOfGenerationFunctionOption = None
      NeuronLearningAlgorithm = learningAlgorithm
      InfoLog = infoLog
  } |> getLiveEvolutionInstance

let player2AI =
  let playerId = 2
  let activationFunctions =
    Map.empty
    |> Map.add 0 sigmoid
  let outputHookFunctionIds : OutputHookFunctionIds =
    [gameActionOutputHookId]
    |> List.toSeq
  let learningAlgorithm = Hebbian 0.7
  let startingRecords : GenerationRecords =
    let nodeRecords =
      getDefaultNodeRecords activationFunctions outputHookFunctionIds 0 learningAlgorithm infoLog
    Map.empty
    |> Map.add 0 nodeRecords
  let outputHooks : OutputHookFunctions =
    let outputHook = getOutputHook playerId
    Map.empty
    |> Map.add gameActionOutputHookId outputHook
  let syncFunctions : SyncFunctions =
    let syncFunction = getSyncFunction playerId
    Map.empty
    |> Map.add 0 syncFunction
  let fitnessFunction = getFitnessFunction playerId
  {
      StarterRecords = startingRecords
      MutationSequence = minimalMutationSequence
      MaximumMindsPerGeneration = 10
      MaximumThinkCycles = None
      FitnessFunction = fitnessFunction
      FitPopulationSelectionFunction = selectFitPopulation
      ActivationFunctions = activationFunctions
      SyncFunctions = syncFunctions
      OutputHookFunctions = outputHooks
      EndOfGenerationFunctionOption = None
      NeuronLearningAlgorithm = learningAlgorithm
      InfoLog = infoLog
  } |> getLiveEvolutionInstance

let processTurn _ =

  SynchronizeActiveCortex |> player1AI.PostAndReply
  SynchronizeActiveCortex |> player2AI.PostAndReply

  let gameStatus, _ = GetGameStatusAndBoard |> ticTacInstance.PostAndReply
  match gameStatus with
  | GameOver winner ->
    ClearGame
    |> ticTacInstance.PostAndReply
  | ContinueGame ->
    ()

[0..5000]
|> List.iter processTurn