module Exercise03 where

import Data.Array.Unboxed
import Data.List (intercalate)
--import Debug.Trace
import Text.Printf (printf)

-- HA 3.1a) i
selectRow :: [[Int]] -> Int -> [Int]
selectRow xss i = xss !! i

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [xs !! i | xs <- xss]

-- HA 3.1a) iii
intRoot :: Int -> Int
intRoot = floor . sqrt . fromIntegral

--return numbers in square as a list. squares are numbered  from left to right and top to bottom
--e.g. :
--[0,1,2]
--[3,4,5]
--[6,7,8]
selectSquare :: [[Int]] -> Int -> [Int]
selectSquare xss i =
  let n = length xss
      sqsi = intRoot n
      (by, bx) = (i `div` (n `div` sqsi) * sqsi, i `mod` sqsi * sqsi)
   in [xss !! y !! x | y <- [by .. by + sqsi -1], x <- [bx .. bx + sqsi -1]]

-- HA 3.1b)

isVldR :: [Int] -> UArray Int Bool -> Int -> Int -> Bool
isVldR xs bs n i
  | i - n == 0 = True
  | bs ! el = False
  | otherwise = isVldR xs (bs // [(el, True)]) n i
  where
    el = xs !! i

isValidSubsection :: [Int] -> Bool
isValidSubsection xs = let n = length xs in isVldR xs (array (0, n -1) []) n 0

isValidSudoku :: [[Int]] -> Bool
isValidSudoku lss =
  let n = length lss
      xs = convertLStoAS lss n
      sqsi = intRoot n
      nm = n - 1
      ea = array ((0, 1), (nm, n)) [] :: UArray (Int, Int) Bool
   in isRekValidSudoku xs 0 n sqsi ea ea ea

isRekValidSudoku :: UArray Int Int -> Int -> Int -> Int -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> Bool
--isRekValidSudoku xs i n sqsi rbss cbss bbss | trace ("rekval: " ++ show i ++ " sqsi:"++ show sqsi) False = undefined
isRekValidSudoku xs i n sqsi rbss cbss bbss
  | i >= n * n = True
  | isVldS (xs ! i) i n sqsi rbss cbss bbss =
    let el = xs ! i
     in isRekValidSudoku xs (i + 1) n sqsi (setRBSS rbss i el n) (setCBSS cbss i el n) (setBBSS bbss i el n sqsi)
  | otherwise = False

convertLStoAS :: [[Int]] -> Int -> UArray Int Int
convertLStoAS lss n = array (0, (n * n) -1) [(x + y * n, lss !! y !! x) | y <- [0 .. n -1], x <- [0 .. n -1]]

convertAStoLS :: UArray Int Int -> Int -> [[Int]]
convertAStoLS xss n = [[xss ! (y * n + x) | x <- [0 .. n -1]] | y <- [0 .. n -1]]

isVldS :: Int -> Int -> Int -> Int -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> Bool
--isVldS el i n sqsi rbss cbss bbss | trace ("isvlds: i:" ++ show i ++ " el:"++ show el ) False = undefined
isVldS 0 _ _ _ _ _ _ = True
--isVldS el i n sqsi rbss cbss bbss | trace ("        rbss:" ++ show (checkRBSS rbss i el n) ++ " row:"++show (i `mod` n)) False = undefined
--isVldS el i n sqsi rbss cbss bbss | trace ("        cbss:" ++ show (checkCBSS cbss i el n)++ " col:"++ show (i `mod` n)) False = undefined
--isVldS el i n sqsi rbss cbss bbss | trace ("        bbss:" ++ show (checkBBSS bbss i el n sqsi) ++ " sq: "++ show (gSindexToSquareIndex i n sqsi)) False = undefined
isVldS el i n sqsi rbss cbss bbss = not (checkRBSS rbss i el n || checkCBSS cbss i el n || checkBBSS bbss i el n sqsi)
{-# INLINE isVldS #-}

checkRBSS :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Bool
checkRBSS rbss i el n = rbss ! (i `div` n, el)
{-# INLINE checkRBSS #-}

setRBSS :: UArray (Int, Int) Bool -> Int -> Int -> Int -> UArray (Int, Int) Bool
setRBSS rbss _ 0 _ = rbss
setRBSS rbss i el n = rbss // [((i `div` n, el), True)]
{-# INLINE setRBSS #-}

checkCBSS :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Bool
checkCBSS cbss i el n = cbss ! (i `mod` n, el)
{-# INLINE checkCBSS #-}

setCBSS :: UArray (Int, Int) Bool -> Int -> Int -> Int -> UArray (Int, Int) Bool
setCBSS cbss _ 0 _ = cbss
setCBSS cbss i el n = cbss // [((i `mod` n, el), True)]
{-# INLINE setCBSS #-}

checkBBSS :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
checkBBSS bbss i el n sqsi = bbss ! (gSindexToSquareIndex i n sqsi, el)
{-# INLINE checkBBSS #-}

setBBSS :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> UArray (Int, Int) Bool
setBBSS bbss _ 0 _ _ = bbss
setBBSS bbss i el n sqsi = bbss // [((gSindexToSquareIndex i n sqsi, el), True)]
{-# INLINE setBBSS #-}

gSindexToSquareIndex :: Int -> Int -> Int -> Int
gSindexToSquareIndex i n sqsi = ((i `mod` n) `div` sqsi) + ((i `div` n) `div` sqsi) * sqsi
{-# INLINE gSindexToSquareIndex #-}

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell xss (j, k) x = convertAStoLS (convertLStoAS xss n // [(j * n + k, x)]) n where n = length xss

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku lss =
  let n = length lss
      xs = convertLStoAS lss n
      sqsi = intRoot n
      (notInvalid, rbss, cbss, bbss) = presetBSS xs n sqsi
   in if notInvalid
        then
          let (solved, sxs) = actuallySolveSudoku xs 0 n sqsi rbss cbss bbss
           in if solved
                then convertAStoLS sxs n
                else []
        else []
{-TTEW-}



actuallySolveSudoku :: UArray Int Int -> Int -> Int -> Int -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> (Bool, UArray Int Int)
actuallySolveSudoku xs i n sqsi rbss cbss bbss
  --  | trace ("Solve: i:" ++ show i) False = undefined
  --  | trace (showSudoku $ convertAStoLS xs n) False = undefined
  | i >= n * n = (True, xs)
  | xs ! i /= 0 = actuallySolveSudoku xs (i + 1) n sqsi rbss cbss bbss
  | otherwise = actuallyStepSolveSudoku 1
  where
    actuallyStepSolveSudoku el
      --  | trace ("Step: i:" ++ show i ++ " el: " ++ show el) False = undefined
      | el > n = (False, xs)
      | otherwise =
        if isVldS el i n sqsi rbss cbss bbss
          then
            let (b, nxs) = actuallySolveSudoku (xs // [(i, el)]) (i + 1) n sqsi (setRBSS rbss i el n) (setCBSS cbss i el n) (setBBSS bbss i el n sqsi)
             in if b
                  then (True, nxs)
                  else actuallyStepSolveSudoku (el + 1)
          else actuallyStepSolveSudoku (el + 1)
{-# INLINE actuallySolveSudoku #-}

presetBSS :: UArray Int Int -> Int -> Int -> (Bool, UArray (Int, Int) Bool, UArray (Int, Int) Bool, UArray (Int, Int) Bool)
presetBSS xs n sqsi = let ea = array ((0, 1), (n -1, n)) [] :: UArray (Int, Int) Bool in aux 0 ea ea ea
  where
    aux :: Int -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> UArray (Int, Int) Bool -> (Bool, UArray (Int, Int) Bool, UArray (Int, Int) Bool, UArray (Int, Int) Bool)
    aux i rbss cbss bbss =
      if i >= n * n
        then (True, rbss, cbss, bbss)
        else
          let el = xs ! i
           in if isVldS el i n sqsi rbss cbss bbss
                then aux (i + 1) (setRBSS rbss i el n) (setCBSS cbss i el n) (setBBSS bbss i el n sqsi)
                else (False, rbss, cbss, bbss)

{-
  Test Sudoku and Prints down here
-}

sudokuSolved4 :: [[Int]]
sudokuSolved4 =
  [ [1, 2, 3, 4],
    [3, 4, 1, 2],
    [4, 1, 2, 3],
    [2, 3, 4, 1]
  ]

sudokuUnsolv4 :: [[Int]]
sudokuUnsolv4 =
  [ [0, 0, 3, 4],
    [0, 0, 0, 0],
    [4, 4, 0, 0],
    [0, 0, 0, 0]
  ]

sudokuEasy4 :: [[Int]]
sudokuEasy4 =
  [ [1, 2, 3, 4],
    [3, 4, 1, 2],
    [0, 1, 2, 3],
    [0, 0, 4, 0]
  ]

sudokuEmpty4 :: [[Int]]
sudokuEmpty4 =
  [ [0, 0, 0, 0],
    [0, 0, 0, 0],
    [0, 0, 0, 0],
    [0, 0, 0, 0]
  ]

hardSudoku :: [[Int]]
hardSudoku =
  [ [8, 0, 0, 0, 0, 0, 0, 0, 0],
    [0, 0, 3, 6, 0, 0, 0, 0, 0],
    [0, 7, 0, 0, 9, 0, 2, 0, 0],
    [0, 5, 0, 0, 0, 7, 0, 0, 0],
    [0, 0, 0, 0, 4, 5, 7, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 3, 0],
    [0, 0, 1, 0, 0, 0, 0, 6, 8],
    [0, 0, 8, 5, 0, 0, 0, 1, 0],
    [0, 9, 0, 0, 0, 0, 4, 0, 0]
  ]

-- Malte Schmitz
chefsudoku :: [[Int]]
chefsudoku =
  [ [0, 0, 0, 0, 0, 5, 0, 8, 0],
    [0, 0, 0, 6, 0, 1, 0, 4, 3],
    [0, 0, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 5, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 6, 0, 0, 0],
    [3, 0, 0, 0, 0, 0, 0, 0, 5],
    [5, 3, 0, 0, 0, 0, 0, 6, 1],
    [0, 0, 0, 0, 0, 0, 0, 0, 4],
    [0, 0, 0, 0, 0, 0, 0, 0, 0]
  ]

-- Benjamin Defant
sudoku16 :: [[Int]]
sudoku16 =
  [ [0, 0, 0, 11, 0, 0, 9, 0, 15, 0, 4, 0, 1, 0, 0, 13],
    [0, 0, 0, 0, 0, 15, 0, 12, 0, 1, 0, 0, 0, 0, 7, 0],
    [0, 0, 16, 0, 0, 0, 0, 0, 12, 0, 10, 0, 8, 11, 0, 14],
    [8, 0, 0, 0, 7, 0, 13, 0, 0, 3, 0, 2, 0, 0, 4, 0],
    [0, 0, 0, 7, 2, 0, 0, 0, 0, 10, 0, 0, 4, 0, 0, 8],
    [0, 0, 0, 0, 0, 11, 0, 16, 9, 0, 0, 12, 0, 1, 0, 0],
    [6, 0, 8, 0, 9, 0, 10, 0, 1, 0, 3, 0, 14, 0, 0, 0],
    [0, 14, 0, 3, 4, 8, 0, 0, 0, 0, 0, 7, 0, 9, 0, 0],
    [0, 0, 9, 5, 10, 0, 8, 2, 0, 16, 0, 0, 15, 0, 0, 0],
    [2, 0, 0, 4, 0, 6, 11, 0, 8, 0, 14, 0, 0, 12, 0, 0],
    [0, 0, 0, 0, 16, 0, 0, 15, 0, 5, 0, 0, 6, 0, 0, 4],
    [14, 11, 0, 0, 0, 7, 0, 0, 2, 0, 0, 10, 0, 13, 0, 0],
    [0, 16, 0, 0, 8, 0, 0, 5, 0, 15, 0, 0, 0, 0, 12, 0],
    [3, 0, 15, 0, 0, 10, 2, 0, 13, 0, 1, 0, 0, 0, 0, 0],
    [0, 9, 0, 10, 0, 13, 0, 1, 0, 6, 0, 8, 0, 14, 0, 0],
    [0, 0, 0, 0, 12, 0, 4, 0, 0, 0, 0, 3, 9, 0, 0, 0]
  ]

-- Jonas Bauer
fucker :: [[Int]]
fucker = [[0,28,0,2,0,0,0,5,0,0,21,0,0,0,0,0,0,0,0,0,26,0,20,0,0,0,0,0,0,0,0,0,0,0,0,0],
          [0,0,1,0,32,20,0,0,0,0,0,2,34,0,0,0,0,0,0,0,5,0,19,0,0,0,13,0,0,4,0,0,6,0,0,0],
          [19,0,17,8,0,0,34,0,28,0,0,0,0,0,22,0,0,0,16,0,0,11,6,0,0,29,0,0,0,9,0,0,0,0,18,10],
          [5,0,0,9,6,0,0,0,0,20,0,0,0,1,0,0,29,0,0,36,0,0,0,32,0,0,0,22,0,0,7,0,0,0,0,0],
          [0,0,0,0,0,26,0,0,0,0,27,0,20,0,0,0,0,0,8,0,0,1,28,0,3,0,0,0,0,0,0,5,0,9,0,0],
          [0,0,0,0,0,4,23,0,0,0,0,0,0,7,0,0,0,0,17,0,0,0,0,0,5,0,0,0,20,0,2,32,0,0,0,0],

          [22,0,5,0,0,31,0,9,1,0,0,0,3,0,0,0,0,0,13,0,19,0,0,0,18,0,8,0,0,20,0,14,0,2,0,4],
          [0,20,0,0,0,7,16,0,24,0,0,0,0,0,2,4,0,0,0,21,0,15,0,0,0,0,0,0,0,0,0,0,9,0,6,32],
          [4,0,0,10,0,0,0,0,0,14,0,0,0,12,0,0,0,0,0,7,0,6,1,0,0,0,21,2,0,0,0,0,0,0,0,23],
          [0,0,0,0,1,0,0,0,0,0,0,0,0,16,0,0,0,5,0,9,0,0,0,8,0,0,0,0,12,0,17,0,0,0,0,0],
          [14,0,0,0,0,6,0,0,0,5,0,8,0,0,0,24,0,21,0,17,0,0,0,0,31,0,0,0,28,0,22,0,27,0,34,0],
          [0,0,0,0,0,0,0,0,0,0,0,6,0,8,0,13,0,1,0,0,0,0,14,0,29,17,0,4,0,0,0,33,20,0,0,3],

          [2,0,3,0,0,0,0,0,0,0,0,0,0,25,0,0,0,0,0,0,9,0,0,0,15,0,4,0,0,0,0,29,0,0,23,0],
          [0,0,0,0,34,0,0,0,0,1,4,0,0,0,0,0,2,26,0,0,0,0,0,0,24,0,0,0,0,0,9,0,0,0,0,28],
          [0,9,0,0,0,25,0,0,0,0,0,14,0,0,0,0,3,0,0,0,0,0,0,11,0,0,0,32,0,0,18,0,0,0,24,0],
          [0,0,0,0,36,0,0,0,18,0,17,0,0,10,0,12,0,0,0,0,0,8,5,19,0,0,0,13,0,0,0,21,0,3,0,0],
          [0,0,0,0,31,0,19,0,0,0,0,11,0,5,0,0,23,0,0,0,0,0,2,0,9,0,3,25,0,0,0,0,0,8,35,0],
          [21,8,0,0,0,0,0,20,0,0,0,0,0,0,0,6,0,0,0,0,0,0,0,17,0,0,12,0,18,0,16,0,2,0,7,0],

          [36,2,0,0,0,9,0,0,0,34,0,0,0,20,0,0,0,0,0,0,0,23,0,25,6,0,29,0,13,0,14,0,5,0,0,0],
          [0,0,0,34,0,0,18,0,0,0,16,0,6,28,9,0,0,0,0,0,0,0,0,0,0,0,35,8,0,0,1,0,0,21,0,36],
          [29,0,0,0,0,0,8,0,0,26,0,1,0,0,0,2,0,0,0,0,0,16,36,9,0,0,0,0,32,0,0,6,0,0,0,7],
          [0,0,0,0,0,0,14,0,0,0,0,24,0,0,5,7,0,0,0,0,0,0,0,1,2,0,0,0,3,0,0,0,0,29,0,0],
          [0,0,27,0,0,0,30,0,0,9,0,0,14,0,25,0,11,0,5,2,0,0,0,0,17,0,1,0,4,0,0,34,0,0,12,0],
          [8,0,0,0,22,1,0,4,5,2,0,20,0,0,0,0,0,0,26,0,0,0,0,0,0,7,0,9,0,0,3,0,0,18,0,0],

          [0,0,0,17,0,0,0,0,10,0,9,0,24,0,0,3,26,0,0,0,0,0,0,0,0,0,19,0,0,21,0,36,0,30,0,20],
          [30,0,0,24,0,8,15,0,20,0,2,0,0,0,0,0,0,0,12,0,0,0,11,0,0,1,28,0,0,6,0,0,25,0,0,9],
          [0,0,0,7,20,5,21,0,30,0,0,4,8,0,23,0,0,0,2,26,0,34,0,0,10,3,9,0,36,11,0,18,0,0,14,0],
          [31,0,0,0,11,0,17,0,0,7,0,28,1,4,0,0,0,35,0,0,0,0,0,20,0,0,30,0,0,0,0,0,0,0,3,0],
          [34,0,2,0,26,0,0,0,11,18,0,0,15,0,32,9,0,0,21,5,0,0,0,0,35,0,0,20,0,0,0,0,0,0,1,0],
          [0,10,0,0,0,0,0,8,0,36,6,0,0,0,0,0,0,19,0,0,23,0,0,0,7,0,0,0,0,0,0,0,0,11,0,0],

          [12,0,0,0,0,0,1,0,0,8,23,0,5,0,4,0,0,2,0,19,0,17,0,3,0,6,0,10,0,0,0,20,0,0,0,26],
          [0,0,0,0,21,10,0,0,31,0,0,0,0,0,6,0,0,0,11,0,4,0,9,7,26,25,0,0,2,17,0,22,0,0,0,34],
          [0,0,8,0,0,0,0,29,0,0,0,34,0,0,0,0,0,15,0,0,2,13,0,18,21,0,0,0,19,0,31,0,0,0,9,12],
          [0,0,0,0,4,0,0,26,0,0,0,22,0,0,0,0,0,0,0,16,34,0,0,21,0,31,0,0,1,0,6,0,0,23,0,30],
          [0,0,7,0,0,0,2,0,16,0,0,0,21,0,0,0,0,3,10,0,0,0,0,15,0,0,0,28,30,0,0,0,0,4,0,17],
          [3,0,0,0,24,0,28,0,0,0,10,0,0,11,18,0,0,13,0,23,0,0,0,33,12,0,0,35,9,29,0,0,0,25,5,2]]

-- Utility method to show a sudoku
-- show sudoku with
-- >>> putStr (showSudoku sudoku)
showSudoku :: [[Int]] -> String
showSudoku xss = unlines $ intercalate [showDivider] $ chunksOf squareSize $ map showRow xss
  where
    size = length xss
    squareSize = intRoot size
    numberSize = size `div` 10 + 1

    showRowSection xs = unwords $ map (printf ("%0" ++ show numberSize ++ "d")) xs
    showRow xs = intercalate "|" $ map showRowSection $ chunksOf squareSize xs
    showDivider = intercalate "+" $ replicate squareSize $ replicate ((numberSize + 1) * squareSize - 1) '-'

    chunksOf :: Int -> [e] -> [[e]]
    chunksOf i [] = []
    --pff und solche Leute erstellen Angaben. Das sollte "chunksOf _ [] = []" sein ;)    
    chunksOf i ls = take i ls : chunksOf i (drop i ls)