PurpleRain.hs

{-# LANGUAGE RecordWildCards #-}
module Main where

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.interact $ out . solve "RB" . BS.init where
  out (s, e)
    = BS.pack (show s) <> BS.pack " " <> BS.pack (show e)

data Acc =
  A { maxCount :: {-# UNPACK #-} !Int
    , bounds :: {-# UNPACK #-} !(Int, Int)
    , idx :: {-# UNPACK #-} !Int
    , colorAccs :: ![ColorAcc]
    }

data ColorAcc =
  CA { count :: {-# UNPACK #-} !Int
     , start :: {-# UNPACK #-} !Int
     , color :: {-# UNPACK #-} !Char
     } deriving (Eq, Ord)

solve :: String -> BS.ByteString -> (Int, Int)
solve colors = bounds . BS.foldl' go initAcc where
  go acc@A{..} c =
    let cs = doColor idx c <$> colorAccs
        mc = maximum cs
        acc' = acc { idx = idx + 1
                   , colorAccs = cs
                   }
    in
      if count mc > maxCount
      then acc' { maxCount = count mc
                , bounds = (start mc, idx)
                }
      else acc'

  initAcc = A 0 (0,0) 1 $ CA 0 1 <$> colors

doColor :: Int -> Char -> ColorAcc -> ColorAcc
doColor idx c acc@CA{..}
  | c == color = acc { count = count + 1 }
  | count == 0 = acc { start = idx + 1 }
  | otherwise = acc { count = count - 1 }