Danganronpa V3 monolith helper

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"