From d7b94526c8ae73b5a169afd0b47ad48838b624fb Mon Sep 17 00:00:00 2001 From: Shaun Kerr Date: Fri, 22 Jun 2018 15:58:20 +1200 Subject: [PATCH] Second Big Bang --- .Main.hs.swp | Bin 0 -> 24576 bytes Main.hs | 78 +++++++++++++++++++++++++++++++++++++++++++---------------- Packs.hs | 1 - Test.hs | 4 +++ 4 files changed, 61 insertions(+), 22 deletions(-) create mode 100644 .Main.hs.swp create mode 100644 Test.hs diff --git a/.Main.hs.swp b/.Main.hs.swp new file mode 100644 index 0000000000000000000000000000000000000000..fd8a81384aac021ee8faaac9321c24d995aa3490 GIT binary patch literal 24576 zcmeI3TWlOx8OIMzpeenjp&>}{aN<~EmTYYAHiS4}r*YC$f!v4_lFD`Bv3Km9WOsJE zGfs9N=1-rAQ|rKk-TsS+zTEa zAQc3a&L}_c&Y5%h&i`EY%=u2HhrY6FkKQ~mq_|cp^}AMa;(;}vQnMSC3ajpXAmKN- zrrlapbwjsxgLn^{3-yH}kF7fNesi_ytpZj7tAJI&Dqt0`3RnfK0#<E1 z*bbZEv!G!a+yqx{SL(O$BAkJJuobqzD!2=-+@{oPZ~?vpC*dgUgaKFsABR8Os?^Wm z49r6f4#6mlz^!okqe}fAUV;2%>5@?gum8 zl=cHZ^4(guSgC$25O!^!Z?(K2>Pj7vK}gHYMBAFpT4yh^WLqN1%UCTH?oGaA^*9EU z&v90_dy8=by+M}>dRF(ZMSo3|a*2lYF_WmB52n0bLFCPOEfLdk<*!>Xf6X7Ix?Mvz zM8_G^WkRaeDC+d4p@Tv-K$=@ycPMGruSHnpJV?bxbwKCrr_d>{ z=GCWkr=Z*2_!M~GL)z6N6y;8u61yL!UE^LBx3nJ6Zl$u*6pEjqpO@X`K0MU&5jE*W^-w-nJ4AD3iZ0P=)J;>js8~>-B|9@Uj|2s@3=^y9BomY5Ffo}1P*|pe zEa;mKnCAXQqn2$hXGaq|j+s6b=s_kT(QdC>_X@fxLx-yyL_+7mT#7>cP?>n~cZpP! z_K>2sR~!C}7wTp~uU)Hs$vcVbn46*w4#@P^a)U~ven2}zgh;{-431Ve+t}!u7tEnk zzh0cZ#Eb`drn@X^Exmrdo^V1h+7&PZ$PCenZ7wj)7-`I`i%BYz%@PerXluHt}$PdAhvL+Zku*g5ijlmk_av0B9b2it$NcgVOzd>6>=mb zF-KIbsC*2vNGDqvjOlk~v0PPh8Ql}-lBwzSa)}FX>u%2((WciixuuqoJkxJe8}jz_ z3~eeVg2x?_8P0TJDI%1XXzL;E1k{&{j+{?RY57@h;f{4jZ{L;4yF0x}0mqWU`1Kjl zLo&B5N^{*3W?G)iQFQ9vJ|kZ8kArqJO~8=Mmiai6U$TNQGiIs~>xnp~X^N$@bEMVN z92er;*npb39n_Xj2o?^GIc%}>PlJH%eqrmCR9hIB)FvO zCEY1W@HN&pL-Opjq?q!9o%7Lri=Tdzty3!N&uFJp;up44ruAiH%1ymoP??p2cEo_B zBqrF5Ir(^0OnPvbu3>UFNtMm~nqPhGbZcRkzX>o*X zE0~UFX1$VWI;@r{upGBz$be%0m+nLNWqB-1uXOH6hE}}xj;ly&GeH!!%uYo;<_2Fb zQfsM0LB}yA3>zon1=?h?bdP_bGxMlf(VNU9a$4r361f*lFuw%x#MYfXDqhP!$$N_) zuQpD_@sq{ii1ZF8eszcw@pHB~_QC))Ql_&~_S5(4%| z6|f3e1*`&A0jq#jz$#!BunOc9FxwWIU4J*&v7eV{vjx|?|E`i))8g*&XXCr26Kz;@ zC9$vZ(Nl8I#=nYF&6t8s)cC!8y3u{&V^a2spFC;R@539ou&FvY($|;SA1C9+n1r2NyO#5$=T7@$tU`Pr`8+1@Ze|!ngkxyaF#k4Nkyr_ynwhtN8XW!ej6# zxKM&2cn{yc`28=y)9_8$4POHB`(MVd{~P!byZ|R*9=1aPen}gP-~Wej1|EPTAZ@=A z?uJYcADec}jwKtI^py5w_E{zx`*+EPmbhD!ZT-|k=X}5q1{Ae9D=_^(Js`l&r9CKM z4+_Mm2JArr&mI&=&mqW?!X6Z0^<@0}nR5_1|Gse<+k*n)z*}%#^*Y{b_MkxQQ?&;L z%+W*XEeozkmUg+D#QSIu3UE}_9u%+#1=91q@%e%O+k*lewdIILd{{tEFNWs*KjeM> zEM(9Bzs>!t@Qd_WZZpT;SOu&CRspMkRlq7>6|f3e1*`&A0jq#jz$)+`R3PWRXGd{{7_V*4X)6y?mu~9Q{TE3cv)%vz literal 0 HcmV?d00001 diff --git a/Main.hs b/Main.hs index 9302d9d..4c9e323 100644 --- a/Main.hs +++ b/Main.hs @@ -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) diff --git a/Packs.hs b/Packs.hs index 3cdabc9..d18b0db 100644 --- a/Packs.hs +++ b/Packs.hs @@ -1,6 +1,5 @@ module Packs where - bigBoxes :: [String] bigBoxes = [ "Creation and Control" diff --git a/Test.hs b/Test.hs new file mode 100644 index 0000000..a7071e3 --- /dev/null +++ b/Test.hs @@ -0,0 +1,4 @@ +cleanMaybe :: Maybe String -> [String] +cleanMaybe (Just x) = [x] +cleanMaybe Nothing = [] +