module Exercise03 where

import Data.List (delete, intercalate)
import Text.Printf (printf)

-- HA 3.1a) i
selectRow :: [[Int]] -> Int -> [Int]
selectRow [] _ = []
selectRow (xs : _) 0 = xs
selectRow (_ : xss) i = selectRow xss (i - 1)

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss 0 = [x | (x : _) <- xss]
selectColumn xss i = selectColumn [xs | (_ : xs) <- xss] (i - 1)

-- 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 s = intRoot $ length xss
      rows = selectNIndices xss (s * div i s) s
      m = s * mod i s
   in concat [selectNIndices r m s | r <- rows]
  where
    selectNIndices [] _ _ = []
    selectNIndices (x : _) 0 1 = [x]
    selectNIndices (x : xs) 0 n = x : selectNIndices xs 0 (n - 1)
    selectNIndices (_ : xs) from n = selectNIndices xs (from - 1) n

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection [] = True
isValidSubsection (x : xs) = (x == 0 || notElem x xs) && isValidSubsection xs

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss =
  and [isValidSubsection $ f xss i | f <- [selectRow, selectColumn, selectSquare], i <- [0 .. length xss - 1]]

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell [] (_, _) _ = []
setCell (xs : xss) (0, k) x = setElem xs k x : xss
  where
    setElem [] _ _ = []
    setElem (_ : xs) 0 x' = x' : xs
    setElem (x : xs) k x' = x : setElem xs (k - 1) x'
setCell (xs : xss) (j, k) x = xs : setCell xss (j - 1, k) x

-- HA 3.1d)
{-WETT-}

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss =
  let n = length xss
   in if isValidSudoku xss then solve xss n (0, 0, invert (selectRow xss 0) n) [] else []
  where
    solve xss n (j, k, available) square
      | j == n = xss
      | head (selectColumn [selectRow xss j] k) /= 0 =
        solve xss n (newCoords available) newSquare
      | otherwise =
        let possibilities = [(setCell xss (j, k) i, i) | i <- available, i `notElem` c, i `notElem` newSquare]
         in head $ [sud : oku | (sud : oku) <- [solve sudoku n (newCoords $ delete i available) newSquare | (sudoku, i) <- possibilities]] ++ [[]]
      where
        newCoords available = if k == n - 1 then (j + 1, 0, invert (selectRow xss $ j + 1) n) else (j, k + 1, available)
        newSquare =
          let sqN = intRoot n
           in if mod k sqN == 0 then selectSquare xss $ sqN * div j sqN + div k sqN else square
        c = selectColumn xss k
    invert xs n = [x | x <- [1 .. n], x `notElem` xs]

{-TTEW-}

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]
  ]

-- 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 _ [] = []
    chunksOf i ls = take i ls : chunksOf i (drop i ls)