|
|
@@ -1,10 +1,19 @@ |
|
|
|
module Main2 where |
|
|
|
|
|
|
|
import System.Random |
|
|
|
import Data.List |
|
|
|
import Packs |
|
|
|
|
|
|
|
data Timestamp = Ts Integer Integer Integer |
|
|
|
data DataPack = Dp String Integer deriving (Eq, Show) |
|
|
|
data BigBox = Bb (Maybe String) deriving Show |
|
|
|
data DataPack = Dp String Integer deriving Show |
|
|
|
type Legal = [DataPack] |
|
|
|
type Pool = [DataPack] |
|
|
|
type BanQ = [BigBox] |
|
|
|
type State = (Legal, Pool, BanQ, StdGen) |
|
|
|
|
|
|
|
instance Eq DataPack where |
|
|
|
(Dp s1 _) == (Dp s2 _) = s1 == s2 |
|
|
|
|
|
|
|
initialTimestamp :: Timestamp |
|
|
|
initialTimestamp = Ts 29 09 1996 |
|
|
@@ -15,6 +24,15 @@ seed = 69420 |
|
|
|
initialRNG :: StdGen |
|
|
|
initialRNG = mkStdGen $ seed |
|
|
|
|
|
|
|
initialState :: State |
|
|
|
initialState = ( |
|
|
|
(createPoolList $ drop n dataPacks) |
|
|
|
, (createLegalList $ take n dataPacks) |
|
|
|
, map (\x -> Bb x) $ (map Just bigBoxes) ++ [Nothing] |
|
|
|
, initialRNG |
|
|
|
) |
|
|
|
where n = (length dataPacks) `div` 2 |
|
|
|
|
|
|
|
isPreviewSeason :: Timestamp -> Bool |
|
|
|
isPreviewSeason (Ts x _ _) = x >= 20 |
|
|
|
|
|
|
@@ -57,13 +75,13 @@ setLegalTimer d = setTimer 3 d |
|
|
|
setInRotTimer :: DataPack -> DataPack |
|
|
|
setInRotTimer d = setTimer (-1) d |
|
|
|
|
|
|
|
dropOldestLegal :: ([DataPack], [DataPack], StdGen) -> ([DataPack], [DataPack], StdGen) |
|
|
|
dropOldestLegal (p, l, r) = (newPool, (drop 2 l), r) |
|
|
|
dropOldestLegal :: State -> State |
|
|
|
dropOldestLegal (l, p, b, r) = ((drop 2 l), newPool, b, r) |
|
|
|
where |
|
|
|
newPool = p ++ (map setLegalTimer (take 2 l)) |
|
|
|
|
|
|
|
addNewPack :: ([DataPack], [DataPack], StdGen) -> ([DataPack], [DataPack], StdGen) |
|
|
|
addNewPack (p, l, r) = (pPool, l ++ [(setInRotTimer nPack)], nR) |
|
|
|
addNewPack :: State -> State |
|
|
|
addNewPack (l, p, b, r) = (l ++ [(setInRotTimer nPack)], pPool, b, nR) |
|
|
|
where |
|
|
|
nPool = length $ legalPoolChoices p |
|
|
|
(iPack, nR) = randomR (0, nPool-1) r |
|
|
@@ -71,8 +89,16 @@ addNewPack (p, l, r) = (pPool, l ++ [(setInRotTimer nPack)], nR) |
|
|
|
nPackName = (\(Dp n _) -> n) nPack |
|
|
|
pPool = filter (\(Dp n _) -> n /= nPackName) p |
|
|
|
|
|
|
|
newRotation :: ([DataPack], [DataPack], StdGen) -> ([DataPack], [DataPack], StdGen) |
|
|
|
newRotation (p, l, r) = addNewPack . addNewPack $ dropOldestLegal (updatePackAge p, l, r) |
|
|
|
rotate :: Integer -> [a] -> [a] |
|
|
|
rotate _ [] = [] |
|
|
|
rotate n xs = zipWith const (drop (fromIntegral n) (cycle xs)) xs |
|
|
|
|
|
|
|
rotateBigBox :: State -> State |
|
|
|
rotateBigBox (l, p, b, r) = (l, p, (rotate 1 b), r) |
|
|
|
|
|
|
|
newRotation :: State -> State |
|
|
|
newRotation (l, p, b, r) = |
|
|
|
rotateBigBox . addNewPack . addNewPack $ dropOldestLegal (l, updatePackAge p, b, r) |
|
|
|
|
|
|
|
changes :: Eq a => [a] -> [a] -> [a] |
|
|
|
changes x y = filter (\n -> not $ n `elem` y) x |
|
|
@@ -80,26 +106,36 @@ changes x y = filter (\n -> not $ n `elem` y) x |
|
|
|
diffRot :: [DataPack] -> [DataPack] -> ([DataPack], [DataPack]) |
|
|
|
diffRot n o = (changes n o, changes o n) |
|
|
|
|
|
|
|
initialRotation :: ([DataPack], [DataPack], StdGen) |
|
|
|
initialRotation = ( |
|
|
|
(createPoolList $ drop n dataPacks) |
|
|
|
, (createLegalList $ take n dataPacks) |
|
|
|
, initialRNG |
|
|
|
) |
|
|
|
where n = (length dataPacks) `div` 2 |
|
|
|
|
|
|
|
strictApplyN :: Integer -> (a -> a) -> a -> a |
|
|
|
strictApplyN 0 _ x = x |
|
|
|
strictApplyN n f x = strictApplyN (n - 1) f $! (f x) |
|
|
|
|
|
|
|
getCurrentRotation :: Timestamp -> ([DataPack], [DataPack], StdGen) |
|
|
|
getCurrentRotation t = strictApplyN n newRotation initialRotation |
|
|
|
getCurrentRotation :: Timestamp -> State |
|
|
|
getCurrentRotation t = strictApplyN n newRotation initialState |
|
|
|
where |
|
|
|
n = t `monthsSince` initialTimestamp |
|
|
|
|
|
|
|
getPreview :: Timestamp -> ([DataPack], [DataPack], StdGen) -> Maybe ([DataPack], [DataPack]) |
|
|
|
getPreview n (p, l, r) |
|
|
|
| isPreviewSeason n = Just $ diffRot nl l |
|
|
|
type Preview = ([DataPack], [DataPack], BigBox, BigBox) |
|
|
|
|
|
|
|
getPreview :: Timestamp -> State -> Maybe Preview |
|
|
|
getPreview n (l, p, b, r) |
|
|
|
| isPreviewSeason n = Just $ (fst packsChange, snd packsChange, head (rotate 1 b), head b) |
|
|
|
| otherwise = Nothing |
|
|
|
where |
|
|
|
(_, nl, _) = newRotation (p, l, r) |
|
|
|
packsChange = diffRot nl l |
|
|
|
(nl, _, _, _) = newRotation (l, p, b, r) |
|
|
|
|
|
|
|
cleanMaybe :: BigBox -> [String] |
|
|
|
cleanMaybe (Bb (Just x)) = [x] |
|
|
|
cleanMaybe (Bb Nothing) = [] |
|
|
|
|
|
|
|
printPreview :: Preview -> [String] |
|
|
|
printPreview (i, o, bi, bo) = [ |
|
|
|
("In : " ++ (intercalate ", " $ (cleanDP i) ++ cbi)) |
|
|
|
, ("Out: " ++ (intercalate ", " $ (cleanDP o) ++ cbo)) |
|
|
|
] |
|
|
|
where |
|
|
|
rmEmp = filter (/="") |
|
|
|
cbi = cleanMaybe bi |
|
|
|
cbo = cleanMaybe bo |
|
|
|
cleanDP = map (\(Dp n _) -> n) |