• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Danganronpa V3 monolith helper yingpotter  Jan 23rd, 2017 (edited) 2,823 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. module Main where
2.
3. import Data.List
4. import Data.Function
5. import qualified Data.Set as Set
6.
7.
8. -- INPUT DATA : Matrix surrounding by Zeroes
9. -- RULE : B <- 1, W <- 2, P <- 3, Y <- 4, Digged <- 0
10. blktest :: [[Int]]
11. blktest = [ [0,0,0,0,0,0,0,0],
12.             [0,1,4,1,1,4,4,0],
13.             [0,4,3,1,4,3,4,0],
14.             [0,3,2,4,2,1,2,0],
15.             [0,4,4,4,2,2,3,0],
16.             [0,1,0,0,3,4,1,0],
17.             [0,1,4,0,0,1,3,0],
18.             [0,0,0,0,0,0,0,0] ]
19.
20. -- INPUT DATA : Goal
21. -- Coordinates which are aimed to be digged
22. -- Notice : coordinates are in format of (row, col). NOT (col.row)
23. goaltest :: [(Int,Int)]
24. 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)]
25.
26.
27. -- Functions
28.
29. height = length blktest
30. width = length (blktest!!0)
31.
32. getvalue :: [[Int]] -> (Int, Int) -> Int
33. getvalue mono p = mono!!x!!y
34.                  where x = fst p
35.                        y = snd p
36.
37. listtest = filter (\x -> getvalue blktest x > 0) [(x,y) | x <- [1..height - 2], y<- [1..width - 2]]
38.
39. rmdups :: Ord a => [a] -> [a]
40. rmdups = rmdups' Set.empty where
41.  rmdups' _ [] = []
42.   rmdups' a (b : c) = if Set.member b a then rmdups' a c
43.                                         else b : rmdups' (Set.insert b a) c
44.
45. updateMatrixAt :: (Int,Int) -> (a->a) -> [[a]] -> [[a]]
46. updateMatrixAt(i,j) f mat
47.    | (upperRows, thisRow : lowerRows ) <- splitAt i mat
48.    , (leftCells, thisCell: rightCells) <- splitAt j thisRow
49.            =                  upperRows
50.             ++ (leftCells ++ (f thisCell): rightCells)
51.                             : lowerRows
52.    | otherwise = error "Tried to index matrix outside range"
53.
54.
55. --isInside :: (Int, Int) -> Bool
56. --isInside p = x > 0 && x < (width -1)  && y > 0 && y < (height - 1)
57. --             where x = fst p
58. --                   y = snd p
59.
60. neighbor :: (Int, Int) -> [(Int, Int)]
61. neighbor p = [(x - 1, y), (x + 1, y), (x, y - 1), (x, y + 1)]
62.            where x = fst p
63.                  y = snd p
64.
65. detectcontiguous' :: [[Int]] -> (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
66. detectcontiguous' mono p plist
67.     | nblist == []   = p : plist
68.     | otherwise      = concatMap (\x -> detectcontiguous' mono x (p : plist)) nblist
69.       where value = getvalue mono p
70.             nblist = (filter (\x -> getvalue mono x == value) (neighbor p)) \\ plist
71. detectcontiguous mono p plist = rmdups \$ detectcontiguous' mono p plist
72.
73. searchbound :: [(Int,Int)] -> [(Int,Int)]
74. searchbound plist = (rmdups \$ concatMap (neighbor) plist) \\ plist
75.
76. diggableareas' :: [[Int]] -> [(Int,Int)] -> [[(Int,Int)]]
77. diggableareas' mono [] = []
78. diggableareas' mono (x:xs)
79.       | rx == [x]   = diggableareas' mono xs
80.      | otherwise   = rx : (diggableareas' mono (xs \\ rx))
81.        where rx = detectcontiguous mono x []
82.
83. digaction :: [[Int]] -> [(Int,Int)] -> [[Int]]
84. digaction mono digplan = foldr (\p -> updateMatrixAt p f1) (foldr (\p -> updateMatrixAt p f0) mono digplan) (searchbound digplan)
85.             where f0 _ = 0
86.                   f1 value
87.                    | value == 0  = 0
88.                    | value == 1  = 2
89.                    | value == 2  = 3
90.                    | value == 3  = 4
91.                    | value == 4  = 1
92.                    | otherwise   = 0
93.
94. dig mono nzp digorder goal
95.       | digplans == []   = []
96.       | intersect nzp goal == [] = [digorder]
97.       | otherwise        = concatMap (\x -> dig (digaction mono x) (nzp \\ x) ((x!!0):digorder) goal) digplans
98.       where digplans = diggableareas' mono nzp
99.
100. dig' mono nzp digorder goal
101.       | diglist == []   = []
102.       | otherwise       = reverse \$ minimumBy (compare `on` length) diglist
103.       where diglist = dig mono nzp digorder goal
104.
105. printCord :: (Int, Int) -> String
106. printCord (row, col) = "Row : " ++ show row ++ ",  Column : " ++ show col
107.
108. main :: IO ()
109. main  =  do
110.     let z = dig' blktest listtest [] goaltest
111.    if (length z > 0) then putStrLn . unlines \$ map printCord z