ARotate.hs

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math#-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Data.Function (on)
import Text.Printf
import Control.Monad
import Data.Tuple (swap)
import Data.Array
import Data.Foldable  (for_)
import qualified Data.Vector as V
import Control.Monad


import qualified Data.Map



import Text.XFormat.Read
import Data.Maybe
import qualified Data.Tree  as T

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : splitBy p (dropWhile p b)
   where
     (a, b) = break p xs
 
split :: String -> [String]
split = splitBy (=='/')


rr :: String -> Integer
rr = read

--input = lines <$> getContents
input :: IO [String]
--input = lines <$> readFile "/Users/oskimura/prog/input.txt"
input = lines <$> readFile "/Users/oskimura/Downloads/A-small-practice (4).in"
--input = lines <$> readFile "/Users/oskimura/Downloads/A-large-practice (3).in"

slices = unfoldr . phi
  where phi n xs | n < 1 || null xs = Nothing
                 | otherwise        = Just $ splitAt n xs
toIS text = case fromJust . readf (Integer % String) $ text of
              x :%: b -> (x,b)
output xs = unlines . zipWith (\ c n -> "Case #"++ show c ++": "++ printf "%s" n) [1..] $ xs
put = writeFile "output.txt"

rot000 = id
rot090 = map reverse . transpose
rot180 = reverse . map reverse
rot270 = reverse . transpose

down   = transpose . map (uncurry (++) . partition (== '.')) . transpose

check :: [(Integer, Integer)] -> (Integer, Integer) -> Integer -> Bool
check arr (y,x) m 
    = or . map  ((>=m) . genericLength) .  map g $ a1:a2:a3:a4:a5:a6:a7:[a8]
      where
        g xs  = arr `intersect` xs
        n = m-1
        a1 = [(y+i,x)     | i<- [0 .. n]]
        a2 = [(y+i,x)     | i<- [-n .. 0]]
        a3 = [(y, x+i)    | i<- [0 .. n]]
        a4 = [(y, x+i)    | i<- [-n .. -1]]
        a5 = [(y+i, x+i)  | i<- [0 .. n]]
        a6 = [(y+i, x+i)  | i<- [-n .. 0]]
        a7 = [(y+i, x-i)  | i<- [0 .. n]]
        a8 = [(y-i, x+i)  | i<- [0 .. n]]

pickup a c = map snd . filter ((==c) . fst) . zip (elems a) $ (indices a)

solve xs n k = on answer f bs rs
    where 
      arr = makeArray (down . rot090 $ xs) n
      bs = pickup arr 'B'
      rs = pickup arr 'R'
      f ys = or [ check ys y k | y <- ys ]
answer :: Bool -> Bool -> String
answer True  True   = "Both"
answer False False  = "Neither"
answer False True   = "Red"
answer True  False  = "Blue"


test1 = ["......."
        ,"......."
        ,"......."
        ,"...R..."
        ,"...BB.."
        ,"..BRB.."
        ,".RRBR.."
        ]


test2 = ["......"
        ,"......"
        ,".R...R"
        ,".R..BB"
        ,".R.RBR"
        ,"RB.BBB"
        ]
test3 = ["R..."
        ,"BR.."
        ,"BR.."
        ,"BR.."
        ]
test4 = ["..."
        ,"RR."
        ,"BBB"]

{--
check :: (Char -> Bool) -> Array (Integer, Integer) Char -> (Integer,Integer) -> [(Integer,Integer)] -> Integer -> Bool
check f xs idx   visited 0  = True
check f xs (0,y) visited n  = False
check f xs (x,0) visited n  = False
check f xs (x,y) visited n  
    | mx<x || my<y = False
    | otherwise    = if b then or nexts else False
    where nexts   = [ check f xs i (i:visited) $ (n-1) | i <- idxes ]
          idxes   = let idx = [-1 .. 1 ] in [ (x+i1,y+i2)| i1 <- idx, i2 <- idx ] \\ visited
          b       = f (xs!(x,y))
          (mx,my) = snd . bounds $ xs
--}

makeArray xs n = listArray ((1,1),(n,n)) (concat xs)




main = do { (n : others) <- input
          ; n <- pure . rr $ n
          ; let loop others  = do { (ns:xss)   <- others
                                  ; [k,n]       <- pure . map rr . words $ ns
                                  ; (xs,xss)    <- pure . genericSplitAt k $ xss
                                  ; let ret       =  (solve xs k n)  in
                                    if null xss then return ret
                                     else (ret : loop (return xss))
                                  }
          ; let ret = loop (return others) in
            put . output $ ret
          }