WIRE.hs

module Main where

import Control.Monad
import Data.IORef
import qualified Data.Set as Set

type Point = (Integer, Integer)

type Wire = UPair Point

data UPair a
    = UPair { ufst :: a , usnd :: a }
    deriving (Show)
    
instance Eq a => Eq (UPair a) where
    UPair x1 y1 == UPair x2 y2
        | x1 == x2 && y1 == y2 = True
        | x1 == y2 && y1 == x2 = True
        | otherwise = False

instance Ord a => Ord (UPair a) where
    UPair x1 y1 `compare` UPair x2 y2 = orderPair x1 y1 `compare` orderPair x2 y2 where
        orderPair :: Ord a => a -> a -> (a, a)
        orderPair x y = if x >= y then (x, y) else (y, x)

getAllSubsets :: Ord a => Set.Set a -> [Set.Set a]
getAllSubsets xs
    | null xs = return Set.empty
    | otherwise = do
        ys <- getAllSubsets (Set.deleteMin xs)
        [ys, Set.insert (Set.findMin xs) ys]

checkFlow :: Set.Set Wire -> Point -> Point -> Bool
checkFlow rel beg end = loop Set.empty [beg] where
    loop :: Set.Set Point -> [Point] -> Bool
    loop visiteds [] = False
    loop visiteds ((i, j) : nexts)
        | (i, j) == end = True
        | (i, j) `Set.member` visiteds = loop visiteds nexts
        | otherwise = loop visiteds' nexts'
        where
            visiteds' :: Set.Set Point
            visiteds' = Set.insert (i, j) visiteds
            nexts' :: [Point]
            nexts' = [ p | p <- [(i + 1, j), (i - 1, j), (i, j + 1), (i, j - 1)], UPair p (i, j) `Set.member` rel ] ++ nexts

getAllWires :: Integer -> Integer -> [Wire]
getAllWires r c = do
    i1 <- [0, 1 .. r]
    j1 <- [0, 1 .. c]
    (i2, j2) <- [(i1 + 1, j1), (i1, j1 + 1)]
    guard ((i2 >= 0 && i2 <= r) && (j2 >= 0 && j2 <= c))
    return (UPair (i1, j1) (i2, j2))

succUpd :: IORef Integer -> IO ()
succUpd ptr = do
    val <- readIORef ptr
    let val' = succ val
    val' `seq` writeIORef ptr val'

main :: IO ()
main = do
    putStrLn "row:"
    r <- readLn
    putStrLn "col:"
    c <- readLn
    putStrLn ("row = " ++ shows r (", col = " ++ shows c "."))
    idx_ptr <- newIORef 0
    cnt_ptr <- newIORef 0
    forM_ (getAllSubsets (Set.fromList (getAllWires r c))) $ \circuit -> do
        idx <- readIORef idx_ptr
        if idx `mod` 1000000 == 0
            then putStrLn ("idx = " ++ shows idx ";")
            else return ()
        succUpd idx_ptr
        when (checkFlow circuit (0, 0) (0, c)) $ succUpd cnt_ptr
    cnt <- readIORef cnt_ptr
    idx <- readIORef idx_ptr
    writeFile "answer.txt" ("answer = " ++ shows cnt (" / " ++ shows idx "."))
    return ()