diff --git a/src/League.elm b/src/League.elm index 63b39d1..3ab6878 100644 --- a/src/League.elm +++ b/src/League.elm @@ -60,7 +60,7 @@ decoder = , -- old format: only players as a dict Decode.dict Player.decoder |> Decode.map ComparableDict.toList - |> Decode.map (List.map (\( _, player ) -> ( player.id, player ))) + |> Decode.map (List.map (\( _, player ) -> ( Player.id player, player ))) |> Decode.map (Dict.fromList Player.idSorter) ] ) @@ -69,7 +69,7 @@ decoder = playersDecoder : Decoder (Dict PlayerId Player) playersDecoder = Decode.field "players" (Decode.list Player.decoder) - |> Decode.map (List.map (\player -> ( player.id, player ))) + |> Decode.map (List.map (\player -> ( Player.id player, player ))) |> Decode.map (Dict.fromList Player.idSorter) @@ -98,34 +98,34 @@ addPlayer : Player -> League -> League addPlayer player (League league) = let initialRating = - case Dict.values league.players |> List.map .rating of + case Dict.values league.players |> List.map Player.rating of [] -> Elo.initialRating nonEmpty -> List.sum nonEmpty // List.length nonEmpty in - League { league | players = Dict.insert player.id (Player.setRating initialRating player) league.players } + League { league | players = Dict.insert (Player.id player) (Player.setRating initialRating player) league.players } {-| -} updatePlayer : Player -> League -> League updatePlayer player (League league) = - League { league | players = Dict.insert player.id player league.players } + League { league | players = Dict.insert (Player.id player) player league.players } retirePlayer : Player -> League -> League retirePlayer player (League league) = League { league - | players = Dict.remove player.id league.players + | players = Dict.remove (Player.id player) league.players , currentMatch = case league.currentMatch of Nothing -> Nothing Just (Match a b) -> - if player.name == a.name || player.name == b.name then + if Player.id player == Player.id a || Player.id player == Player.id b then Nothing else @@ -169,7 +169,7 @@ nextMatch (League league) = a :: b :: rest -> let ( firstPossiblePlayer, restOfPossiblePlayers ) = - case List.filter (\player -> player.matches <= playInMatches) allPlayers of + case List.filter (\player -> Player.matchesPlayed player <= playInMatches) allPlayers of [] -> ( a, b :: rest ) @@ -177,13 +177,13 @@ nextMatch (League league) = ( firstPlayIn, restOfPlayIns ) mostMatchesAmongPossiblePlayers = - List.map .matches (firstPossiblePlayer :: restOfPossiblePlayers) + List.map Player.matchesPlayed (firstPossiblePlayer :: restOfPossiblePlayers) |> List.maximum - |> Maybe.withDefault firstPossiblePlayer.matches + |> Maybe.withDefault (Player.matchesPlayed firstPossiblePlayer) in Random.weighted - ( toFloat (mostMatchesAmongPossiblePlayers - firstPossiblePlayer.matches) ^ 2, firstPossiblePlayer ) - (List.map (\player -> ( toFloat (mostMatchesAmongPossiblePlayers - player.matches) ^ 2, player )) restOfPossiblePlayers) + ( toFloat (mostMatchesAmongPossiblePlayers - Player.matchesPlayed firstPossiblePlayer) ^ 2, firstPossiblePlayer ) + (List.map (\player -> ( toFloat (mostMatchesAmongPossiblePlayers - Player.matchesPlayed player) ^ 2, player )) restOfPossiblePlayers) |> Random.andThen (\firstPlayer -> let @@ -199,13 +199,13 @@ nextMatch (League league) = furthestAway = (head :: tail) - |> List.map (\player -> abs (firstPlayer.rating - player.rating)) + |> List.map (\player -> abs (Player.rating firstPlayer - Player.rating player)) |> List.maximum |> Maybe.withDefault 0 in Random.weighted - ( toFloat (furthestAway - abs (firstPlayer.rating - head.rating)) ^ 2, head ) - (List.map (\player -> ( toFloat (furthestAway - abs (firstPlayer.rating - player.rating)) ^ 2, player )) tail) + ( toFloat (furthestAway - abs (Player.rating firstPlayer - Player.rating head)) ^ 2, head ) + (List.map (\player -> ( toFloat (furthestAway - abs (Player.rating firstPlayer - Player.rating player)) ^ 2, player )) tail) |> Random.map (Tuple.pair firstPlayer) ) |> Random.andThen @@ -235,8 +235,8 @@ startMatch (Match playerA playerB) (League league) = -- don't start a match with players that aren't in the -- league... Maybe.map2 Tuple.pair - (Dict.get playerA.id league.players) - (Dict.get playerB.id league.players) + (Dict.get (Player.id playerA) league.players) + (Dict.get (Player.id playerB) league.players) |> Maybe.andThen (\( gotA, gotB ) -> -- ... or when the players are the same player @@ -261,8 +261,8 @@ finishMatch outcome league = let newRatings = Elo.win (kFactor league won) - { won = won.rating - , lost = lost.rating + { won = Player.rating won + , lost = Player.rating lost } in league @@ -274,8 +274,8 @@ finishMatch outcome league = let newRatings = Elo.draw (kFactor league (higherRankedPlayer playerA playerB)) - { playerA = playerA.rating - , playerB = playerB.rating + { playerA = Player.rating playerA + , playerB = Player.rating playerB } in league @@ -296,16 +296,16 @@ kFactor (League league) player = let p90 = Dict.values league.players - |> List.map .rating + |> List.map Player.rating |> percentile 0.9 |> Maybe.withDefault Elo.initialRating in - if player.matches < playInMatches then + if Player.matchesPlayed player < playInMatches then -- players who are new to the league should move around more so that -- they can get ranked closer to their actual correct position sooner. Elo.sensitiveKFactor * 2 - else if player.rating >= p90 then + else if Player.rating player >= p90 then -- players who have been at the top of the rankings for a while should -- be stabler. In my use case, I'm picking things to do next. The -- "most important" thing to do next doesn't actually change a lot, @@ -357,7 +357,7 @@ percentile pct items = {-| -} higherRankedPlayer : Player -> Player -> Player higherRankedPlayer a b = - if a.rating > b.rating then + if Player.rating a > Player.rating b then a else diff --git a/src/Player.elm b/src/Player.elm index 7c7b11c..138f45d 100644 --- a/src/Player.elm +++ b/src/Player.elm @@ -1,4 +1,28 @@ -module Player exposing (Player, PlayerId, decoder, encode, idSorter, incrementMatchesPlayed, init, playerIdFromIntForTestOnly, setRating) +module Player exposing + ( Player, init + , PlayerId, id, idSorter + , name + , rating, setRating + , matchesPlayed, setMatchesPlayed, incrementMatchesPlayed + , encode + , decoder + ) + +{-| + +@docs Player, init + +@docs PlayerId, id, idSorter + +@docs name + +@docs rating, setRating + +@docs matchesPlayed, setMatchesPlayed, incrementMatchesPlayed + +@docs encode, decode + +-} import Elo import Json.Decode as Decode exposing (Decoder) @@ -7,50 +31,100 @@ import Murmur3 import Sort exposing (Sorter) +type Player + = Player + { id : PlayerId + , name : String + , rating : Int + , matches : Int + } + + +init : String -> Player +init name_ = + Player + { id = PlayerId (Murmur3.hashString 0 name_) + , name = name_ + , rating = Elo.initialRating + , matches = 0 + } + + + +-- ID + + type PlayerId = PlayerId Int -playerIdFromIntForTestOnly : Int -> PlayerId -playerIdFromIntForTestOnly = - PlayerId +id : Player -> PlayerId +id (Player player) = + player.id idSorter : Sorter PlayerId idSorter = - Sort.by (\(PlayerId id) -> id) Sort.increasing + Sort.by (\(PlayerId id_) -> id_) Sort.increasing -type alias Player = - { id : PlayerId - , name : String - , rating : Int - , matches : Int - } +-- NAME -init : String -> Player -init name = - { id = PlayerId (Murmur3.hashString 0 name) - , name = name - , rating = Elo.initialRating - , matches = 0 - } + +name : Player -> String +name (Player player) = + player.name + + + +-- RATING + + +rating : Player -> Int +rating (Player player) = + player.rating setRating : Int -> Player -> Player -setRating rating player = - { player | rating = rating } +setRating rating_ (Player player) = + Player { player | rating = rating_ } + + + +-- MATCHES PLAYED + + +matchesPlayed : Player -> Int +matchesPlayed (Player player) = + player.matches + + +setMatchesPlayed : Int -> Player -> Player +setMatchesPlayed matches (Player player) = + Player { player | matches = matches } incrementMatchesPlayed : Player -> Player -incrementMatchesPlayed player = - { player | matches = player.matches + 1 } +incrementMatchesPlayed (Player player) = + Player { player | matches = player.matches + 1 } + + + +-- INTEROP decoder : Decoder Player decoder = - Decode.map4 Player + Decode.map4 + (\id_ name_ rating_ matches -> + Player + { id = id_ + , name = name_ + , rating = rating_ + , matches = matches + } + ) (Decode.oneOf [ Decode.field "id" Decode.int , Decode.field "name" Decode.string @@ -64,14 +138,14 @@ decoder = encode : Player -> Value -encode { id, name, rating, matches } = +encode (Player player) = let (PlayerId idInt) = - id + player.id in Encode.object [ ( "id", Encode.int idInt ) - , ( "name", Encode.string name ) - , ( "rating", Encode.int rating ) - , ( "matches", Encode.int matches ) + , ( "name", Encode.string player.name ) + , ( "rating", Encode.int player.rating ) + , ( "matches", Encode.int player.matches ) ] diff --git a/tests/LeagueTest.elm b/tests/LeagueTest.elm index e68db84..dbc81ac 100644 --- a/tests/LeagueTest.elm +++ b/tests/LeagueTest.elm @@ -39,7 +39,7 @@ decoderTests = , fuzz leagueFuzzer "is backwards-compatible with the older dictionary format" <| \league -> League.players league - |> List.map (\player -> ( player.name, Player.encode player )) + |> List.map (\player -> ( Player.name player, Player.encode player )) |> Encode.object |> Decode.decodeValue League.decoder -- matches played will change with this. That's fine. @@ -60,8 +60,8 @@ playersTests = League.init |> League.addPlayer player |> League.players - |> List.map .name - |> Expect.equal [ player.name ] + |> List.map Player.name + |> Expect.equal [ Player.name player ] , fuzz playerFuzzer "retiring a player removes them from the players list" <| \player -> League.init @@ -89,10 +89,10 @@ startMatchTests = \playerA playerB -> let uniqueA = - Player.init ("real " ++ playerA.name) + Player.init ("real " ++ Player.name playerA) uniqueB = - Player.init ("real " ++ playerA.name) + Player.init ("real " ++ Player.name playerA) in League.init |> League.addPlayer uniqueA @@ -103,15 +103,15 @@ startMatchTests = \playerA playerBMaybeSame -> let playerB = - Player.init ("unique " ++ playerBMaybeSame.name) + Player.init ("unique " ++ Player.name playerBMaybeSame) in League.init |> League.addPlayer playerA |> League.addPlayer playerB |> League.startMatch (Match playerA playerB) |> League.currentMatch - |> Maybe.map (\(Match a b) -> ( a.name, b.name )) - |> Expect.equal (Just ( playerA.name, playerB.name )) + |> Maybe.map (\(Match a b) -> ( Player.name a, Player.name b )) + |> Expect.equal (Just ( Player.name playerA, Player.name playerB )) , fuzz playerFuzzer "you can't start a match with one player against themselves" <| \player -> League.init @@ -141,20 +141,20 @@ finishMatchTests = |> League.startMatch (Match winner existingPlayer) |> League.finishMatch (Win { won = winner, lost = existingPlayer }) |> Expect.all - [ League.getPlayer winner.id - >> Maybe.map .matches - >> Expect.equal (Just (winner.matches + 1)) - , League.getPlayer existingPlayer.id - >> Maybe.map .matches - >> Expect.equal (Just (existingPlayer.matches + 1)) + [ League.getPlayer (Player.id winner) + >> Maybe.map Player.matchesPlayed + >> Expect.equal (Just (Player.matchesPlayed winner + 1)) + , League.getPlayer (Player.id existingPlayer) + >> Maybe.map Player.matchesPlayed + >> Expect.equal (Just (Player.matchesPlayed existingPlayer + 1)) ] , fuzz playerFuzzer "changes ratings according to Elo" <| \winner -> let newRatings = Elo.win (League.kFactor league winner) - { won = winner.rating - , lost = existingPlayer.rating + { won = Player.rating winner + , lost = Player.rating existingPlayer } in league @@ -162,11 +162,11 @@ finishMatchTests = |> League.startMatch (Match winner existingPlayer) |> League.finishMatch (Win { won = winner, lost = existingPlayer }) |> Expect.all - [ League.getPlayer winner.id - >> Maybe.map .rating + [ League.getPlayer (Player.id winner) + >> Maybe.map Player.rating >> Expect.equal (Just newRatings.won) - , League.getPlayer existingPlayer.id - >> Maybe.map .rating + , League.getPlayer (Player.id existingPlayer) + >> Maybe.map Player.rating >> Expect.equal (Just newRatings.lost) ] , fuzz playerFuzzer "does not change the total points in the system" <| @@ -176,9 +176,9 @@ finishMatchTests = |> League.startMatch (Match winner existingPlayer) |> League.finishMatch (Win { won = winner, lost = existingPlayer }) |> League.players - |> List.map .rating + |> List.map Player.rating |> List.sum - |> Expect.equal (winner.rating + existingPlayer.rating) + |> Expect.equal (Player.rating winner + Player.rating existingPlayer) ] , describe "a draw" [ fuzz playerFuzzer "a draw causes both players matches played to go up" <| @@ -188,12 +188,12 @@ finishMatchTests = |> League.startMatch (Match player existingPlayer) |> League.finishMatch (Draw { playerA = player, playerB = existingPlayer }) |> Expect.all - [ League.getPlayer player.id - >> Maybe.map .matches - >> Expect.equal (Just (player.matches + 1)) - , League.getPlayer existingPlayer.id - >> Maybe.map .matches - >> Expect.equal (Just (existingPlayer.matches + 1)) + [ League.getPlayer (Player.id player) + >> Maybe.map Player.matchesPlayed + >> Expect.equal (Just (Player.matchesPlayed player + 1)) + , League.getPlayer (Player.id existingPlayer) + >> Maybe.map Player.matchesPlayed + >> Expect.equal (Just (Player.matchesPlayed existingPlayer + 1)) ] , fuzz playerFuzzer "a draw changes ratings according to Elo" <| \player -> @@ -201,15 +201,15 @@ finishMatchTests = newRatings = Elo.draw (League.kFactor league - (if player.rating > existingPlayer.rating then + (if Player.rating player > Player.rating existingPlayer then player else existingPlayer ) ) - { playerA = player.rating - , playerB = existingPlayer.rating + { playerA = Player.rating player + , playerB = Player.rating existingPlayer } in league @@ -217,11 +217,11 @@ finishMatchTests = |> League.startMatch (Match player existingPlayer) |> League.finishMatch (Draw { playerA = player, playerB = existingPlayer }) |> Expect.all - [ League.getPlayer player.id - >> Maybe.map .rating + [ League.getPlayer (Player.id player) + >> Maybe.map Player.rating >> Expect.equal (Just newRatings.playerA) - , League.getPlayer existingPlayer.id - >> Maybe.map .rating + , League.getPlayer (Player.id existingPlayer) + >> Maybe.map Player.rating >> Expect.equal (Just newRatings.playerB) ] , fuzz playerFuzzer "a draw does not change the total points in the system" <| @@ -231,9 +231,9 @@ finishMatchTests = |> League.startMatch (Match player existingPlayer) |> League.finishMatch (Draw { playerA = player, playerB = existingPlayer }) |> League.players - |> List.map .rating + |> List.map Player.rating |> List.sum - |> Expect.equal (player.rating + existingPlayer.rating) + |> Expect.equal (Player.rating player + Player.rating existingPlayer) ] ] diff --git a/tests/PlayerTest.elm b/tests/PlayerTest.elm index 18d3ee9..5a40752 100644 --- a/tests/PlayerTest.elm +++ b/tests/PlayerTest.elm @@ -22,11 +22,9 @@ playerFuzzer : Fuzzer Player playerFuzzer = Fuzz.map3 (\name rating matches -> - let - initial = - Player.init name - in - { initial | rating = rating, matches = matches } + Player.init name + |> Player.setRating rating + |> Player.setMatchesPlayed matches ) nameFuzzer (Fuzz.intRange 1000 3000) @@ -44,7 +42,7 @@ decoderTest : Test decoderTest = describe "decoder" [ describe "id" - [ test "fills in the ID if it's missing" <| + [ test "is OK with a missing ID" <| \_ -> Encode.object [ ( "name", Encode.string "Test" ) @@ -52,7 +50,6 @@ decoderTest = , ( "matches", Encode.int 0 ) ] |> Decode.decodeValue Player.decoder - |> Result.map .id - |> Expect.equal (Ok (Player.playerIdFromIntForTestOnly 123038886)) + |> Expect.ok ] ]