--------------------------------------------------------------------------------

module Codeforces.Virtual
    ( VirtualUser(..)
    , VirtualResult(..)
    , Delta
    , Seed
    , calculateResult
    ) where

import           Codeforces.Types.Common
import           Codeforces.Types.RatingChange
import           Codeforces.Types.Standings
import           Codeforces.Virtual.RatingCalculator
import           Codeforces.Virtual.Types

import           Control.Applicative

import qualified Data.Map                      as M

--------------------------------------------------------------------------------

-- | Computes the results the user would have had, had they participated in this
-- contest live with their current rating.
calculateResult
    :: VirtualUser          -- ^ Details about the virtual participation.
    -> [RatingChange]       -- ^ Rating changes for this contest
    -> [RanklistRow]        -- ^ Standings for this contest.
    -> Maybe VirtualResult  -- ^ Contest results for this user
calculateResult :: VirtualUser
-> [RatingChange] -> [RanklistRow] -> Maybe VirtualResult
calculateResult VirtualUser
vu [RatingChange]
rcs [RanklistRow]
rrs =
    Int -> Int -> Seed -> VirtualResult
VirtualResult
        (Int -> Int -> Seed -> VirtualResult)
-> Maybe Int -> Maybe (Int -> Seed -> VirtualResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Contestant -> Int
contestantRank (Contestant -> Int) -> Maybe Contestant -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Party -> [Contestant] -> Maybe Contestant
findContestant Party
virtualParty [Contestant]
crContestants)
        Maybe (Int -> Seed -> VirtualResult)
-> Maybe Int -> Maybe (Seed -> VirtualResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Party -> Map Party Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Party
virtualParty Map Party Int
crDeltas
        Maybe (Seed -> VirtualResult) -> Maybe Seed -> Maybe VirtualResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Map Int Seed -> Maybe Seed
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (VirtualUser -> Int
vuRating VirtualUser
vu) Map Int Seed
crSeeds
    where ContestResults {[Contestant]
Map Int Seed
Map Party Int
crSeeds :: ContestResults -> Map Int Seed
crDeltas :: ContestResults -> Map Party Int
crContestants :: ContestResults -> [Contestant]
crSeeds :: Map Int Seed
crDeltas :: Map Party Int
crContestants :: [Contestant]
..} = VirtualUser -> [RatingChange] -> [RanklistRow] -> ContestResults
computeResults VirtualUser
vu [RatingChange]
rcs [RanklistRow]
rrs

-- | Computes the complete updated results for a contest after including the
-- virtual user.
computeResults
    :: VirtualUser -> [RatingChange] -> [RanklistRow] -> ContestResults
computeResults :: VirtualUser -> [RatingChange] -> [RanklistRow] -> ContestResults
computeResults vu :: VirtualUser
vu@VirtualUser {Seed
Int
vuPenalty :: VirtualUser -> Int
vuPoints :: VirtualUser -> Seed
vuRating :: Int
vuPenalty :: Int
vuPoints :: Seed
vuRating :: VirtualUser -> Int
..} [RatingChange]
rcs [RanklistRow]
rrs = Map Handle Int -> [RanklistRow] -> ContestResults
calculateContestResults
    Map Handle Int
updatedRatings
    [RanklistRow]
updatedRankings
  where
    updatedRatings :: Map Handle Int
updatedRatings  = Handle -> Int -> Map Handle Int -> Map Handle Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Handle
virtualHandle Int
vuRating ([RatingChange] -> Map Handle Int
previousRatings [RatingChange]
rcs)
    updatedRankings :: [RanklistRow]
updatedRankings = VirtualUser -> [RanklistRow] -> [RanklistRow]
virtualRankings VirtualUser
vu [RanklistRow]
rrs

-- | 'previousRatings' @ratingChanges@ returns a map of each user's handle to
-- their rating before the contest.
previousRatings :: [RatingChange] -> M.Map Handle Rating
previousRatings :: [RatingChange] -> Map Handle Int
previousRatings = [(Handle, Int)] -> Map Handle Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Handle, Int)] -> Map Handle Int)
-> ([RatingChange] -> [(Handle, Int)])
-> [RatingChange]
-> Map Handle Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RatingChange -> (Handle, Int))
-> [RatingChange] -> [(Handle, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Handle -> Int -> (Handle, Int))
-> (RatingChange -> Handle)
-> (RatingChange -> Int)
-> RatingChange
-> (Handle, Int)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) RatingChange -> Handle
rcHandle RatingChange -> Int
rcOldRating)

--------------------------------------------------------------------------------

-- | Builds an updated list of 'RanklistRow's for this contest by finding the
-- virtual user's rank and including them in the list.
virtualRankings :: VirtualUser -> [RanklistRow] -> [RanklistRow]
virtualRankings :: VirtualUser -> [RanklistRow] -> [RanklistRow]
virtualRankings VirtualUser
vu [RanklistRow]
rrs = [RanklistRow] -> Int -> [RanklistRow]
go [RanklistRow]
rrs Int
1
  where
    go :: [RanklistRow] -> Int -> [RanklistRow]
go [] Int
rank = [Int -> VirtualUser -> RanklistRow
mkVirtualRow Int
rank VirtualUser
vu]
    go (RanklistRow
x : [RanklistRow]
xs) Int
_ | VirtualUser -> RanklistRow -> Bool
shouldInsert VirtualUser
vu RanklistRow
x = Int -> VirtualUser -> RanklistRow
mkVirtualRow (RanklistRow -> Int
rrRank RanklistRow
x) VirtualUser
vu RanklistRow -> [RanklistRow] -> [RanklistRow]
forall a. a -> [a] -> [a]
: RanklistRow
x RanklistRow -> [RanklistRow] -> [RanklistRow]
forall a. a -> [a] -> [a]
: [RanklistRow]
xs
                  | Bool
otherwise         = RanklistRow
x RanklistRow -> [RanklistRow] -> [RanklistRow]
forall a. a -> [a] -> [a]
: [RanklistRow] -> Int -> [RanklistRow]
go [RanklistRow]
xs (RanklistRow -> Int
rrRank RanklistRow
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    -- | Whether to insert the virtual user's row before the given row.
    shouldInsert :: VirtualUser -> RanklistRow -> Bool
shouldInsert VirtualUser {Seed
Int
vuRating :: Int
vuPenalty :: Int
vuPoints :: Seed
vuPenalty :: VirtualUser -> Int
vuPoints :: VirtualUser -> Seed
vuRating :: VirtualUser -> Int
..} RanklistRow {Seed
Int
[ProblemResult]
Maybe DiffTime
Party
rrLastSubmissionTime :: RanklistRow -> Maybe DiffTime
rrProblemResults :: RanklistRow -> [ProblemResult]
rrUnsuccessfulHackCount :: RanklistRow -> Int
rrSuccessfulHackCount :: RanklistRow -> Int
rrPenalty :: RanklistRow -> Int
rrPoints :: RanklistRow -> Seed
rrParty :: RanklistRow -> Party
rrLastSubmissionTime :: Maybe DiffTime
rrProblemResults :: [ProblemResult]
rrUnsuccessfulHackCount :: Int
rrSuccessfulHackCount :: Int
rrPenalty :: Int
rrPoints :: Seed
rrRank :: Int
rrParty :: Party
rrRank :: RanklistRow -> Int
..} =
        (Seed
vuPoints Seed -> Seed -> Bool
forall a. Ord a => a -> a -> Bool
> Seed
rrPoints)
            Bool -> Bool -> Bool
|| (Seed
vuPoints Seed -> Seed -> Bool
forall a. Eq a => a -> a -> Bool
== Seed
rrPoints Bool -> Bool -> Bool
&& Int
vuPenalty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rrPenalty)

-- | Constructs the virtual user's 'RanklistRow', using the virtual user's rank,
-- and their contest results.
mkVirtualRow :: Int -> VirtualUser -> RanklistRow
mkVirtualRow :: Int -> VirtualUser -> RanklistRow
mkVirtualRow Int
virtualRank VirtualUser {Seed
Int
vuRating :: Int
vuPenalty :: Int
vuPoints :: Seed
vuPenalty :: VirtualUser -> Int
vuPoints :: VirtualUser -> Seed
vuRating :: VirtualUser -> Int
..} = RanklistRow :: Party
-> Int
-> Seed
-> Int
-> Int
-> Int
-> [ProblemResult]
-> Maybe DiffTime
-> RanklistRow
RanklistRow
    { rrParty :: Party
rrParty                 = Party
virtualParty
    , rrRank :: Int
rrRank                  = Int
virtualRank
    , rrPoints :: Seed
rrPoints                = Seed
vuPoints
    , rrPenalty :: Int
rrPenalty               = Int
vuPenalty
    , rrSuccessfulHackCount :: Int
rrSuccessfulHackCount   = Int
0
    , rrUnsuccessfulHackCount :: Int
rrUnsuccessfulHackCount = Int
0
    , rrProblemResults :: [ProblemResult]
rrProblemResults        = []
    , rrLastSubmissionTime :: Maybe DiffTime
rrLastSubmissionTime    = Maybe DiffTime
forall a. Maybe a
Nothing
    }

--------------------------------------------------------------------------------