[ create a new paste ] login | about

Link: http://codepad.org/bxf3CYwW    [ raw code | fork ]

Haskell, pasted on Apr 16:
-- Contest: Google Code Jam, Qualification Round 2012
-- Author: Todd Owen
--
-- Unless otherwise indicated, all modules used are either bundled with
-- the Haskell Platform (http://hackage.haskell.org/platform/) or available
-- as a separate download from Hackage (http://hackage.haskell.org/).


import Control.Monad
import System.IO
import Text.Printf
import Data.Array.IArray
import Data.List
import Data.Ratio
import Data.Maybe

main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    [t] <- getInts
    forM_ [1..t] $ \n -> do
        putStr $ printf "Case #%d: " n
        doCase

doCase :: IO ()
doCase = do
    [h,w,d] <- getInts
    lines <- replicateM h getLine
    let hall = listArray ((1,1),(h,w)) (concat lines)
    print $ solve hall d

getInts :: IO [Int]
getInts = (map read . words) `fmap` getLine

type Hall = Array (Int,Int) Char
eg1 = listArray ((1,1),(3,3)) "####X####" :: Hall
eg5 = listArray ((1,1),(5,6)) "#######..X.##.#..##...########" :: Hall


solve hall d = length visibleAngles
  where
    visibleAngles = filter id $ map isVisible (angles d)
    isVisible angle = visible hall (d%1) angle (0,0) ix0 pos0
    pos0 = (1%2,1%2)  -- centre of cell
    (ix0,_) = head . filter (\(ix,char) -> char == 'X') $ assocs hall

angles d = [(0,1), (1,0), (0,-1), (-1,0)]  -- allQuadrants no good for zero
           ++ (concatMap allQuadrants $ filter inRange coprimePairs)
  where
    allQuadrants (x,y) = [(x,y), (-x,y), (x,-y), (-x,-y)]
    coprimePairs = [(x,y) | x <- [1..d], y <- [1..d], gcd x y == 1]
    inRange (x,y) = x^2 + y^2 <= d^2

visible :: Hall -> Ratio Int -> (Int,Int) -> (Ratio Int, Ratio Int)
           -> (Int,Int) -> (Ratio Int, Ratio Int) -> Bool
visible hall d angle (tx,ty) ix pos =
    case hall ! ix of
        'X' -> if hitsCentre
               then (tx+xdist/2)^2 + (ty+ydist/2)^2 <= d^2
               else visible'
        '.' -> visible'
  where
    hitsCentre = let ((x,y),(x',y')) = (pos,exitPos)
                 in (1%2-x == x'-1%2) && (1%2-y == y'-1%2)
    visible'  = if tx'^2 + ty'^2 > d^2
                then False
                else case nextCell hall angle ix exitPos of
                    Nothing -> False
                    Just (angle', ix', enterPos)
                        -> visible hall d angle' (tx',ty') ix' enterPos
    exitPos = exitsAt angle pos
    (xdist,ydist) = let ((x,y),(x',y')) = (pos,exitPos)
                    in (abs (x-x'), abs (y-y'))
    (tx',ty') = (tx+xdist, ty+ydist)


nextCell :: Hall -> (Int,Int) -> (Int,Int) -> (Ratio Int,Ratio Int)
            -> Maybe ((Int,Int), (Int,Int), (Ratio Int,Ratio Int))
nextCell hall (vx,vy) (ix,iy) (x,y) = do
    ((vx',ix',x'),(vy',iy',y')) <- case (x,y) of
        (0,0) -> corner (-1) (-1)
        (0,1) -> corner (-1)   1
        (1,0) -> corner   1  (-1)
        (1,1) -> corner   1    1
        (0,_) -> hitHorizontal (-1)
        (1,_) -> hitHorizontal 1
        (_,0) -> hitVertical (-1)
        (_,1) -> hitVertical 1
    return ((vx',vy'),(ix',iy'),(x',y'))
  where
    corner dix diy =
        case (hall ! (ix+dix,iy), hall ! (ix+dix,iy+diy), hall ! (ix,iy+diy)) of
            ('#','#','#') -> Just (bounceX dix, bounceY diy)
            ('#', _ ,'#') -> Just (goX dix, goY diy)
            ('#','#', _ ) -> Just (bounceX dix, goY diy)
            ( _ ,'#','#') -> Just (goX dix, bounceY diy)
            ( _ ,'#', _ ) -> Nothing
            ( _ , _ , _ ) -> Just (goX dix, goY diy)
    hitHorizontal dix =
        case hall ! (ix+dix,iy) of
            '#' -> Just (bounceX dix, sameY)
            _   -> Just (goX dix, sameY)
    hitVertical diy =
        case hall ! (ix,iy+diy) of
            '#' -> Just (sameX, bounceY diy)
            _   -> Just (sameX, goY diy)
    bounceX dix = (-vx,ix,x)
    bounceY diy = (-vy,iy,y)
    goX dix = (vx,ix+dix,1-x)
    goY diy = (vy,iy+diy,1-y)
    sameX = (vx,ix,x)
    sameY = (vy,iy,y)


exitsAt :: (Int,Int) -> (Ratio Int, Ratio Int) -> (Ratio Int, Ratio Int)
exitsAt (vx,vy) (x,y) = head . filter inCell $ catMaybes [xcept,ycept]
  where
    xcept | vx > 0 = Just (1, y + (1-x)*(vy%vx))
          | vx < 0 = Just (0, y + (0-x)*(vy%vx))
          | otherwise = Nothing
    ycept | vy > 0 = Just (x + (1-y)*(vx%vy), 1)
          | vy < 0 = Just (x + (0-y)*(vx%vy), 0)
          | otherwise = Nothing
    inCell (x,y) = x >= 0 && x <= 1 && y >= 0 && y <= 1


Create a new paste based on this one


Comments: