Skip to content

Commit

Permalink
make Player opaque too
Browse files Browse the repository at this point in the history
  • Loading branch information
@BrianHicks
BrianHicks committed Apr 5, 2021
1 parent 26ed088 commit c7c993e
Show file tree
Hide file tree
Showing 4 changed files with 169 additions and 98 deletions.
50 changes: 25 additions & 25 deletions src/League.elm
View file
Expand Up @@ -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)
]
)
Expand All @@ -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)


Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -169,21 +169,21 @@ 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 )

firstPlayIn :: restOfPlayIns ->
( 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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand Down
130 changes: 102 additions & 28 deletions src/Player.elm
View file
@@ -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)
Expand All @@ -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
Expand All @@ -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 )
]

0 comments on commit c7c993e

Please sign in to comment.