Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
#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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment