G2A Many GEOs
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
  112.                      else putStr "No answer"
RAW Paste Data
Ledger Nano X - The secure hardware wallet
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top