Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module Main where
- import Data.List
- import Data.Function
- import qualified Data.Set as Set
- -- INPUT DATA : Matrix surrounding by Zeroes
- -- RULE : B <- 1, W <- 2, P <- 3, Y <- 4, Digged <- 0
- blktest :: [[Int]]
- blktest = [ [0,0,0,0,0,0,0,0],
- [0,1,4,1,1,4,4,0],
- [0,4,3,1,4,3,4,0],
- [0,3,2,4,2,1,2,0],
- [0,4,4,4,2,2,3,0],
- [0,1,0,0,3,4,1,0],
- [0,1,4,0,0,1,3,0],
- [0,0,0,0,0,0,0,0] ]
- -- INPUT DATA : Goal
- -- Coordinates which are aimed to be digged
- -- Notice : coordinates are in format of (row, col). NOT (col.row)
- goaltest :: [(Int,Int)]
- goaltest = [ (3,2),(4,2),(2,3),(3,3),(4,3),(5,3),(2,4),(3,4),(4,4),(5,4),(3,5),(4,5)]
- -- Functions
- height = length blktest
- width = length (blktest!!0)
- getvalue :: [[Int]] -> (Int, Int) -> Int
- getvalue mono p = mono!!x!!y
- where x = fst p
- y = snd p
- listtest = filter (\x -> getvalue blktest x > 0) [(x,y) | x <- [1..height - 2], y<- [1..width - 2]]
- rmdups :: Ord a => [a] -> [a]
- rmdups = rmdups' Set.empty where
- rmdups' _ [] = []
- rmdups' a (b : c) = if Set.member b a then rmdups' a c
- else b : rmdups' (Set.insert b a) c
- updateMatrixAt :: (Int,Int) -> (a->a) -> [[a]] -> [[a]]
- updateMatrixAt(i,j) f mat
- | (upperRows, thisRow : lowerRows ) <- splitAt i mat
- , (leftCells, thisCell: rightCells) <- splitAt j thisRow
- = upperRows
- ++ (leftCells ++ (f thisCell): rightCells)
- : lowerRows
- | otherwise = error "Tried to index matrix outside range"
- --isInside :: (Int, Int) -> Bool
- --isInside p = x > 0 && x < (width -1) && y > 0 && y < (height - 1)
- -- where x = fst p
- -- y = snd p
- neighbor :: (Int, Int) -> [(Int, Int)]
- neighbor p = [(x - 1, y), (x + 1, y), (x, y - 1), (x, y + 1)]
- where x = fst p
- y = snd p
- detectcontiguous' :: [[Int]] -> (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
- detectcontiguous' mono p plist
- | nblist == [] = p : plist
- | otherwise = concatMap (\x -> detectcontiguous' mono x (p : plist)) nblist
- where value = getvalue mono p
- nblist = (filter (\x -> getvalue mono x == value) (neighbor p)) \\ plist
- detectcontiguous mono p plist = rmdups $ detectcontiguous' mono p plist
- searchbound :: [(Int,Int)] -> [(Int,Int)]
- searchbound plist = (rmdups $ concatMap (neighbor) plist) \\ plist
- diggableareas' :: [[Int]] -> [(Int,Int)] -> [[(Int,Int)]]
- diggableareas' mono [] = []
- diggableareas' mono (x:xs)
- | rx == [x] = diggableareas' mono xs
- | otherwise = rx : (diggableareas' mono (xs \\ rx))
- where rx = detectcontiguous mono x []
- digaction :: [[Int]] -> [(Int,Int)] -> [[Int]]
- digaction mono digplan = foldr (\p -> updateMatrixAt p f1) (foldr (\p -> updateMatrixAt p f0) mono digplan) (searchbound digplan)
- where f0 _ = 0
- f1 value
- | value == 0 = 0
- | value == 1 = 2
- | value == 2 = 3
- | value == 3 = 4
- | value == 4 = 1
- | otherwise = 0
- dig mono nzp digorder goal
- | digplans == [] = []
- | intersect nzp goal == [] = [digorder]
- | otherwise = concatMap (\x -> dig (digaction mono x) (nzp \\ x) ((x!!0):digorder) goal) digplans
- where digplans = diggableareas' mono nzp
- dig' mono nzp digorder goal
- | diglist == [] = []
- | otherwise = reverse $ minimumBy (compare `on` length) diglist
- where diglist = dig mono nzp digorder goal
- printCord :: (Int, Int) -> String
- printCord (row, col) = "Row : " ++ show row ++ ", Column : " ++ show col
- main :: IO ()
- main = do
- let z = dig' blktest listtest [] goaltest
- if (length z > 0) then putStrLn . unlines $ map printCord z
- else putStr "No answer"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement