Skip to content

Instantly share code, notes, and snippets.

Embed
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
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.