module Exercise08 where import Data.Bits import Data.List import System.Random (mkStdGen, randoms, randomIO, Random) import Data.Maybe import Data.Ord -- Player is either 1 or -1 type Player = Int -- A field is just an Int value where the absolute gives the number of pieces on the field -- and the sign corresponds to the player -- e.g. -3 would mean there are three blobs in this field of player -1 type Field = Int type Row = [Field] type Column = [Field] -- boards are rectangles represented as a list of rows type Board = [Row] -- A position on the board is represented as (row, column) -- (0,0) is the top left corner, coordinate values increase towards the bottom right type Pos = (Int, Int) -- A size represented as (height,width) type Size = (Int, Int) -- A strategy takes the player who's move it is, optionally takes a list of double values -- to allow for probabilistic strategies, takes the current board and gives back the position -- of the move the player should do type Strategy = [Double] -> Player -> Board -> Pos -- A stateful strategy can additionally pass some object between invocations type StatefulStrategyFunc a = a -> [Double] -> Player -> Board -> (Pos, a) -- first value is the state object to pass to the first invocation of each game type StatefulStrategy a = (a, StatefulStrategyFunc a) defaultSize :: Size defaultSize = (9,6) -- Some useful helper functions row :: Board -> Int -> Row row = (!!) column :: Board -> Int -> Column column = row . transpose width :: Board -> Int width (x : _) = length x width _ = 0 height :: Board -> Int height = length size :: Board -> Size size b = (height b, width b) getCell :: Pos -> Board -> Field getCell (y, x) b = b !! y !! x -- pretty print a single cell showCell :: Field -> String showCell c = "- +" !! succ (signum c) : show (abs c) -- pretty print the given board showBoard :: Board -> String showBoard = unlines . map (unwords . map showCell) -- print a board to the console printBoard :: Board -> IO () printBoard = putStr . showBoard -- check if a position is one a board of the given size isValidPos :: Size -> Pos -> Bool isValidPos (r, c) (y, x) = y >= 0 && y < r && x >= 0 && x < c {- x.1 -} -- Check if the given player can put an orb on the given position canPlaceOrb :: Player -> Pos -> Board -> Bool canPlaceOrb p pos b = sc == 0 || sp == sc where sp = signum p sc = signum $ getCell pos b -- Check if the given player has won the game, -- you can assume that the opponent has made at least one move before hasWon :: Player -> Board -> Bool hasWon p = all (all ((/= os) . signum)) -- Checks if in each row, all sgns are different from the oponents sgn where os = (-1) * signum p -- the list of neighbors of a cell neighbors :: Size -> Pos -> [Pos] neighbors (nRows, nCols) (row, col) = if row < 0 || col < 0 || row >= nRows || col >= nCols then [] else [(row, col - 1) | not leftBorder] ++ [(row - 1, col) | not upperBorder] ++ [(row, col + 1) | not rightBorder] ++ [(row + 1, col) | not lowerBorder] where leftBorder = col == 0 upperBorder = row == 0 rightBorder = col == nCols - 1 lowerBorder = row == nRows - 1 -- update a single position on the board -- f: function that modifies the number of orbs in the cell -- p: player to whom the updated cell should belong updatePos :: (Int -> Int) -> Player -> Pos -> Board -> Board updatePos f p (row, col) board = rowsBefore ++ [newRow] ++ rowsAfter where currValue = getCell (row, col) board newSignedValue = p * f (abs currValue) rowsBefore = take row board rowsAfter = drop (row + 1) board currRow = board !! row colsBefore = take col currRow colsAfter = drop (col + 1) currRow newRow = colsBefore ++ [newSignedValue] ++ colsAfter {- x.2 -} -- place an orb for the given player in the given cell putOrb :: Player -> Pos -> Board -> Board putOrb p pos b | canPlaceOrb p pos b = resultOverflow | otherwise = b where newBoard = updatePos (+1) p pos b resultOverflow = overflowRec p [pos] newBoard overflowRec :: Player -> [Pos] -> Board -> Board overflowRec _ [] b = b overflowRec _ _ [] = [] overflowRec p (pos:ps) b | currValue < nNeigh = overflowRec p ps b -- No Overflow | hasWon p addedBoard = addedBoard -- Game is done -> no infinite loop | otherwise = overflowRec p (ps ++ nachbarn) addedBoard -- Otherwise keep going recursivley where nachbarn = neighbors (size b) pos nNeigh = length nachbarn currValue = abs $ getCell pos b subtractedBoard = updatePos (+ (-nNeigh)) p pos b addedBoard = foldl (\currBoard pos -> updatePos (+1) p pos currBoard) subtractedBoard nachbarn {- x.3 -} {-WETT-} -- My submission strategy :: Strategy strategy _ = alphaBetaPruneStrat alphaBetaPruneStrat :: Player -> Board -> Pos alphaBetaPruneStrat p b = bestPos where depth = 3 maxVal = 540 -- 9 * 6 * 10 minVal = -maxVal (bestVal, bestPos) = alphaBetaPruneWith ((*fromIntegral p) . scoreFunction) True p b depth (minVal - 1) (maxVal + 1) True scoreFunction :: Board -> Double scoreFunction b = sum [cellWeight b (nRow, nCol) * fromIntegral entry | nRow <- [0..nRows - 1], let row = b!!nRow, nCol <- [0..nCols - 1], let entry = row!!nCol] where (nRows, nCols) = size b -- 6 6 8 8 = 4 -- 5 5 9 9 = 2 *click* nice -- 5 5 10 10 = 3 cellWeight :: Board -> Pos -> Double cellWeight b (row, col) = if row < 0 || col < 0 || row >= nRows || col >= nCols then 0 else 1 + sum ( [0.5 | leftBorder] ++ [0.5 | upperBorder] ++ [1 | rightBorder] ++ [1 | lowerBorder]) where (nRows, nCols) = size b leftBorder = col == 0 upperBorder = row == 0 rightBorder = col == nCols - 1 lowerBorder = row == nRows - 1 alphaBetaPruneWith :: (Board -> Double) -> Bool -> Player -> Board -> Int -> Double -> Double -> Bool -> (Double, Pos) alphaBetaPruneWith scoreFunction maxPlayer maxPlayerID currBoard currDepth alpha beta start | not start && hasWon maxPlayerID currBoard = (maxVal, (-1, -2)) -- MaxPlayer has won (Assuming max scoreFunction < 10) | not start && hasWon (-maxPlayerID) currBoard = (minVal, (-1, -3)) -- MinPlayer has won (Assuming max scoreFunction < 10) | currDepth == 0 = (scoreFunction currBoard, (-1, -1)) -- maxDepth reached -- Maximizing player | maxPlayer = maxRec scoreFunction nextBoards maxPlayerID currDepth alpha beta (minVal, (-currDepth, -4)) -- Minimizing player | otherwise = minRec scoreFunction nextBoards maxPlayerID currDepth alpha beta (maxVal, (-currDepth, -5)) where maxVal = 540 minVal = -maxVal currPlayer = if maxPlayer then maxPlayerID else -maxPlayerID nextBoards = getAllPossibleNextBoards currPlayer currBoard $ getAllPos currBoard maxRec :: (Board -> Double) -> [(Pos, Board)] -> Player -> Int -> Double -> Double -> (Double, Pos) -> (Double, Pos) maxRec _ [] _ _ _ _ currBest = currBest maxRec scoreFunction ((currPos, currBoard):bs) maxPlayerID depth currAlpha currBeta (bestVal, bestPos) -- Beta cutoff | newAlpha >= currBeta = (newValue, currPos) -- new best | newValue > currAlpha = maxRec scoreFunction bs maxPlayerID depth newAlpha currBeta (newValue, currPos) -- otherwise check next with old best | otherwise = maxRec scoreFunction bs maxPlayerID depth newAlpha currBeta (bestVal, bestPos) where (childValue, _) = alphaBetaPruneWith scoreFunction False maxPlayerID currBoard (depth - 1) currAlpha currBeta False newValue = max bestVal childValue newAlpha = max currAlpha newValue minRec :: (Board -> Double) -> [(Pos, Board)] -> Player -> Int -> Double -> Double -> (Double, Pos) -> (Double, Pos) minRec _ [] _ _ _ _ currBest = currBest minRec scoreFunction ((currPos, currBoard):bs) maxPlayerID depth currAlpha currBeta (bestVal, bestPos) -- Alpha cutoff | newBeta <= currAlpha = (newValue, currPos) -- new best | newValue < currBeta = minRec scoreFunction bs maxPlayerID depth currAlpha newBeta (newValue, currPos) -- otherwise check next with old best | otherwise = minRec scoreFunction bs maxPlayerID depth currAlpha newBeta (bestVal, bestPos) where (childValue, _) = alphaBetaPruneWith scoreFunction True maxPlayerID currBoard (depth - 1) currAlpha currBeta False newValue = min bestVal childValue newBeta = min currBeta newValue {-TTEW-} -- Your strategy -- Strategy :: [Double] -> Player -> Board -> Pos {- strategy' :: Strategy strategy' xs p b = alphaBetaPruneStrat p b -- = maxNegWeightedOrbCountOpponentMoveStrat allBoards xs p b --- | isJust instaWin = let Just pos = instaWin in pos --- | otherwise = maxNegWeightedOrbCountOpponentMoveStrat allBoards xs p b --- | otherwise = maxHeuristicsOpponentMoveStrat allBoards xs p b --- | otherwise = maxWeightedOrbCountThreeMoves allBoards xs p b --- | otherwise = maxWeightedOrbCountOpponentMoveStrat allBoards xs p b --- | otherwise = maxOrbCountCellValueStrat allBoards xs p b --- | otherwise = maxOrbCountOwnCellsStrat allBoards xs p b --- | otherwise = maxOrbCounStrat allBoards xs p b where allBoards = getAllPossibleNextBoards p b $ getAllPos b instaWin = winInOne allBoards p b -} -- adds state to a strategy that doesn't use it wrapStrategy :: Strategy -> StatefulStrategy Int wrapStrategy strat = (0, \s r p b -> (strat r p b, succ s)) -- the actual strategy submissions -- if you want to use state modify this instead of strategy -- additionally you may change the Int in this type declaration to any type that is usefully for your strategy strategyState :: StatefulStrategy Int strategyState = wrapStrategy strategy ---------------------------------------------------- Strategies ---------------------------------------------------- -- 1st Strat -- Get as many orbs next time as possible -- 63 maxOrbCounStrat :: [(Pos, Board)] -> Strategy maxOrbCounStrat allBoards _ p b = fst $ maximumBy (comparing (countOrbs p . snd)) allBoards -- 2nd Strat -- Get as many orbs next time as possible but only place on already owned cells (first move random) -- 40 maxOrbCountOwnCellsStrat :: [(Pos, Board)] -> Strategy maxOrbCountOwnCellsStrat allBoards rs p b | null filteredBoards = maxOrbCounStrat allBoards rs p b | otherwise = fst $ maximumBy (comparing (countOrbs p . snd)) filteredBoards where filteredBoards = getAllPossibleNextBoards p b $ getAllCurrentPos p b -- 3rd Strat -- Corners are worth more than edges are worth more than the interior but still only count orbs -- 72 maxOrbCountCellValueStrat :: [(Pos, Board)] -> Strategy maxOrbCountCellValueStrat allBoards _ p b = fst $ maximumBy (comparing (countWeightedOrbs p . snd)) allBoards -- 4th Strat -- MinMaximizes weighted orb count after one turn from each player -- 95 (Rank 4) maxWeightedOrbCountOpponentMoveStrat :: [(Pos, Board)] -> Strategy maxWeightedOrbCountOpponentMoveStrat allBoards rs p = minMaxWith (countWeightedOrbs p) allBoards rs p -- 5th Strat -- Maximizes weighted orb count after 3 turns if the oponent plays the 3rd Strat (When playing the 4th Strat, I get timeouts) -- 93 (Rank 4) maxWeightedOrbCountThreeMoves :: [(Pos, Board)] -> Strategy maxWeightedOrbCountThreeMoves allBoards rs p b = fst $ maximumBy (comparing (maxValueAfter . snd)) allBoards where -- Chronoligcal order is from bottom to top -- Maximum Weighted value I can get after opponent played 4th Strat on current Board maxValueAfter :: Board -> Double maxValueAfter currBoard = maximum $ map (countWeightedOrbs p . snd) (allMyBoardsAfter currBoard) -- All possible Boards after oponents played 4th strat on current Board allMyBoardsAfter :: Board -> [(Pos, Board)] allMyBoardsAfter currBoard = getAllPossibleNextBoards p (opponentBoard currBoard) $ getAllPos currBoard -- Board after Oponent move if he plays 4th strat opponentBoard :: Board -> Board opponentBoard currBoard = putOrb (-p) (opponentMove currBoard) currBoard -- Opponents Move if he plays the 4th strat opponentMove :: Board -> Pos opponentMove currBoard = maxOrbCountCellValueStrat (allOponentBoards currBoard) rs (-p) currBoard -- All Possible Moves the Oponent can make for a given Board allOponentBoards :: Board -> [(Pos, Board)] allOponentBoards currBoard = getAllPossibleNextBoards (-p) currBoard $ getAllPos currBoard -- 6th Strat -- 4th Strat with online score function from https://brilliant.org/wiki/chain-reaction-game/ -- If this is not allowed, the 4th Strat should be taken. -- 94 (Rank 4) maxHeuristicsOpponentMoveStrat :: [(Pos, Board)] -> Strategy maxHeuristicsOpponentMoveStrat allBoards rs p = minMaxWith (brilliantOrgScoreFunction p) allBoards rs p -- 7th Strat -- MinMaximizes weighted orb count after one turn from each player with -- 95 (Rank 4) -- https://virusga.me/#user?id=412 maxNegWeightedOrbCountOpponentMoveStrat :: [(Pos, Board)] -> Strategy maxNegWeightedOrbCountOpponentMoveStrat allBoards rs p = minMaxWith ((*fromIntegral p) . weightedBoardScore) allBoards rs p -- 8th Strat -- MinMax with alpha beta prunning -- Depth 1: Rank 26 (https://virusga.me/#user?id=419) -- Depth 2: Rank 24 (https://virusga.me/#user?id=420) -- Depth 3: Rank 26 (https://virusga.me/#user?id=421) -- There is most likely a bug in the code, the first cells are always been taken. (too early cutoff?) alphaBetaPruneStratOld :: Player -> Board -> Pos alphaBetaPruneStratOld p b = bestPos where depth = 10 -- used to be 3 while testing (nRows, nCols) = size b maxVal = fromIntegral $ nRows * nCols * 10 minVal = -maxVal (bestVal, bestPos) = alphaBetaPruneWith weightedBoardScore (p == 1) p b depth minVal maxVal True -- 9th Strat -- 8th Strat with always maximizing (p * score) and some slight changes -- Depth 1: Rank 11 (https://virusga.me/#user?id=423) -- Depth 2: Rank 7 (https://virusga.me/#user?id=427) -- Depth 3: Rank 2 (https://virusga.me/#user?id=443) (Avg. Move normal List: 85ms (1.1.2021, 19:37:18) -- Avg. Move reversed List: 107.7272ms (1.1.2021, 19:52:11)) -- Depth 4: Timeouts alphaBetaPruneStratWeighted :: Player -> Board -> Pos alphaBetaPruneStratWeighted p b = bestPos where depth = 3 (nRows, nCols) = size b maxVal = fromIntegral $ nRows * nCols * 10 minVal = -maxVal (bestVal, bestPos) = alphaBetaPruneWith ((*fromIntegral p) . weightedBoardScore) True p b depth (minVal - 1) (maxVal + 1) True -- 10th Strat -- 9th Strat but Testing different scoreFunctions -- func1: Rank 3 (https://virusga.me/#user?id=461) -- func2 [0.4, 0.4, 0.4, 0.4]: Rank 3 (https://virusga.me/#user?id=464) -- func2 [0.2, 0.2, 0.3, 0.3]: Rank 2 (https://virusga.me/#user?id=465) -- func2 [0.6, 0.6, 0.8, 0.8]: Rank 2 (https://virusga.me/#user?id=466) -- func2 [0.6, 0.6, 0.8, 0.8] * ifIsCritical 2: Rank 2 (https://virusga.me/#user?id=467) -- func2 [0.5, 0.5, 0.55, 0.55] * ifIsCritical 1.5: Rank 5 (https://virusga.me/#user?id=468) -- func2 [0.5, 0.5, 0.8, 0.8]: Rank 3 (https://virusga.me/#user?id=469) -- func2 [0.6, 0.6, 0.8, 0.8]: Rank 1 (https://virusga.me/#user?id=470) -- Best so far -- brilliantOrgScoreFunction: Ranke 2 (https://virusga.me/#user?id=568) That stupid ass complex shit doesn't even work as good as the normal Strat (2 less wins than strat before) -- func2 [0.4, 0.4, 0.5, 0.5]: Rank 2-4 (https://virusga.me/#user?id=673) -- func2 [0.5, 0.5, 0.6, 0.6]: Rank 2-4 (https://virusga.me/#user?id=674) -- I don't even know anymore... Why on earth is .6, .6, .8, .8 so strong?! alphaBetaPruneStrat' :: Player -> Board -> Pos alphaBetaPruneStrat' p b = bestPos where depth = 3 (nRows, nCols) = size b maxVal = fromIntegral $ nRows * nCols * 10 minVal = -maxVal (bestVal, bestPos) = alphaBetaPruneWith ((*fromIntegral p) . scoreFunction2) True p b depth (minVal - 1) (maxVal + 1) True ---------------------------------------------------- Helpers ---------------------------------------------------- scoreFunction1 :: Board -> Double scoreFunction1 b = sum [let currPos = (nRow, nCol) isCrit = isCritical currPos b in getCellWeigth b (nRow, nCol) * fromIntegral entry * (if isCrit then 1.5 else 1) | nRow <- [0..nRows - 1], let row = b!!nRow, nCol <- [0..nCols - 1], let entry = row!!nCol] where (nRows, nCols) = size b scoreFunction2 :: Board -> Double scoreFunction2 b = sum [getCellWeigth2 b (nRow, nCol) * fromIntegral entry | nRow <- [0..nRows - 1], let row = b!!nRow, nCol <- [0..nCols - 1], let entry = row!!nCol] where (nRows, nCols) = size b getCellWeigth2 :: Board -> Pos -> Double getCellWeigth2 b (row, col) = if row < 0 || col < 0 || row >= nRows || col >= nCols then 0 else 1 + sum ( [0.6 | leftBorder] ++ [0.6 | upperBorder] ++ [0.8 | rightBorder] ++ [0.8 | lowerBorder]) where (nRows, nCols) = size b leftBorder = col == 0 upperBorder = row == 0 rightBorder = col == nCols - 1 lowerBorder = row == nRows - 1 -- Return als Positions of a board getAllPos :: Board -> [Pos] getAllPos b = [(row, col) | row <- [0..nRows - 1], col <- [0..nCols - 1]] where (nRows, nCols) = size b -- Get all possible outcomes for a single move with restricted allowed Moves getAllPossibleNextBoards :: Player -> Board -> [Pos] -> [(Pos, Board)] getAllPossibleNextBoards p b allowedPoss = resultBoards where possiblePos = filter (\pos -> canPlaceOrb p pos b) allowedPoss resultBoards = map (\pos -> (pos, putOrb p pos b)) possiblePos -- Return a List of all positions in which give player has orbs getAllCurrentPos :: Player -> Board -> [Pos] getAllCurrentPos p b = filter (\pos -> signum (getCell pos b) == signum p) $ getAllPos b -- Checks if there is a single move which instantly wins. winInOne :: [(Pos, Board)] -> Player -> Board -> Maybe Pos winInOne resultBoards p currBoard = if null winingPos then Nothing else Just (fst $ head winingPos) where results = map (\(pos, b) -> (pos, hasWon p b)) resultBoards winingPos = filter snd results -- Counts how many orbs the given player currently has. countOrbs :: Player -> Board -> Int countOrbs p b = sum [abs entry | row <- b, entry <- row, signum entry == signum p] getCellWeigth :: Board -> Pos -> Double getCellWeigth b (row, col) = if row < 0 || col < 0 || row >= nRows || col >= nCols then 0 else 1 + sum ( [0.5 | leftBorder] ++ [0.5 | upperBorder] ++ [0.75 | rightBorder] ++ [0.75 | lowerBorder]) where (nRows, nCols) = size b leftBorder = col == 0 upperBorder = row == 0 rightBorder = col == nCols - 1 lowerBorder = row == nRows - 1 countWeightedOrbs :: Player -> Board -> Double countWeightedOrbs p b = sum [getCellWeigth b (nRow, nCol) * fromIntegral (abs entry) | nRow <- [0..nRows - 1], let row = b!!nRow, nCol <- [0..nCols - 1], let entry = row!!nCol, signum entry == signum p] where (nRows, nCols) = size b minMaxWith :: (Board -> Double) -> [(Pos, Board)] -> Strategy minMaxWith scoreFunction allBoards _ p b = fst $ maximumBy (comparing (opponentValue . snd)) allBoards where -- opponentValue = min myWeightedValue opponentValue :: Board -> Double opponentValue currBoard = minimum $ map (scoreFunction . snd) $ allOponentBoards currBoard allOponentBoards :: Board -> [(Pos, Board)] allOponentBoards currBoard = getAllPossibleNextBoards (-p) currBoard $ getAllPos currBoard brilliantOrgScoreFunction :: Player -> Board -> Double brilliantOrgScoreFunction p b = fromIntegral $ sum [brilliantOrgScoreOfCell p pos b | pos <- myPositions] where myPositions = getAllCurrentPos p b -- Yet w/o the cahin rule brilliantOrgScoreOfCell :: Player -> Pos -> Board -> Int brilliantOrgScoreOfCell p pos b | signum value /= signum p = 0 | sumNachbarn == 0 = currEdgeCornerValue + criticalSum + abs value + criticalSum | otherwise = abs value - sumNachbarn + criticalSum where s = size b value = getCell pos b nachbarn = neighbors (size b) pos sumNachbarn = sum [5 - critMas | nachbar <- nachbarn, let nachbarValue = getCell nachbar b, signum nachbarValue == -signum p, let critMas = criticalMass s nachbar, abs nachbarValue == critMas - 1] currEdgeCornerValue = edgeCornerValue s pos criticalSum = if isCritical pos b then 2 else 0 isCritical :: Pos -> Board -> Bool isCritical pos b = abs (getCell pos b) == criticalMass (size b) pos - 1 criticalMass :: Size -> Pos -> Int criticalMass (nRows, nCols) (row, col) = 4 - sum ( [1 | leftBorder] ++ [1 | upperBorder] ++ [1 | rightBorder] ++ [1 | lowerBorder]) where leftBorder = col == 0 upperBorder = row == 0 rightBorder = col == nCols - 1 lowerBorder = row == nRows - 1 edgeCornerValue :: Size -> Pos -> Int edgeCornerValue (nRows, nCols) (row, col) | luC || ruC || rlC || llC = 3 -- Corner | leftBorder || upperBorder || rightBorder || lowerBorder = 2 -- Border | otherwise = 0 -- Interior where leftBorder = col == 0 upperBorder = row == 0 rightBorder = col == nCols - 1 lowerBorder = row == nRows - 1 luC = leftBorder && upperBorder ruC = rightBorder && upperBorder rlC = rightBorder && lowerBorder llC = leftBorder && lowerBorder weightedBoardScore :: Board -> Double weightedBoardScore b = sum [getCellWeigth b (nRow, nCol) * fromIntegral entry | nRow <- [0..nRows - 1], let row = b!!nRow, nCol <- [0..nCols - 1], let entry = row!!nCol] where (nRows, nCols) = size b -- Simulate a game between two strategies on a board of the given size and -- returns the state of the board before each move together with the player that won the game play :: [Int] -> Size -> StatefulStrategy a -> StatefulStrategy b -> [(Board, Pos)] play rss (r, c) (isa, sa) (isb, sb) = go rss isa sa isb sb 1 0 (replicate r (replicate c 0)) where -- type signature is necessary, inferred type is wrong! go :: [Int] -> a -> StatefulStrategyFunc a -> b -> StatefulStrategyFunc b -> Player -> Int -> Board -> [(Board, Pos)] go (rs:rss) stc sc stn sn p n b | won = [] | valid = (b, m) : go rss stn sn st' sc (-p) (succ n) (putOrb p m b) | otherwise = [] where won = n > 1 && hasWon (-p) b (m, st') = sc stc (mkRandoms rs) p b valid = isValidPos (size b) m && canPlaceOrb p m b -- Play a game and print it to the console playAndPrint :: Size -> StatefulStrategy a -> StatefulStrategy b -> IO () playAndPrint size sa sb = do seed <- randomIO -- let seed = 42 let moves = play (mkRandoms seed) size sa sb putStr $ unlines (zipWith showState moves $ cycle ['+', '-']) ++ "\n" ++ (case length moves `mod` 2 of { 1 -> "Winner: +"; 0 -> "Winner: -" }) ++ "\n" ++ "View at https://vmnipkow16.in.tum.de/christmas2020/embed.html#i" ++ base64 (1 : t size ++ concatMap (t . snd) moves) ++ "\n" where showState (b, pos) p = showBoard b ++ p : " places at " ++ show pos ++ "\n" t (a, b) = [a, b] mkRandoms :: Random a => Int -> [a] mkRandoms = randoms . mkStdGen base64 :: [Int] -> String base64 xs = case xs of [] -> "" [a] -> f1 a : f2 a 0 : "==" [a, b] -> f1 a : f2 a b : f3 b 0 : "=" a : b : c : d -> f1 a : f2 a b : f3 b c : f4 c : base64 d where alphabet = (!!) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" f1 a = alphabet $ shiftR a 2 f2 a b = alphabet $ shiftL (a .&. 3 ) 4 .|. shiftR b 4 f3 b c = alphabet $ shiftL (b .&. 15) 2 .|. shiftR c 6 f4 c = alphabet $ c .&. 63