module Exercise03 where

import Text.Printf (printf)
import Data.List (find, intercalate, nub, transpose)
import Data.Maybe (catMaybes, fromMaybe)

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

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss = selectRow $ transpose 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 = intRoot $ length xss
      firstRow = n * (i `div` n)
      firstCol = n * (i `mod` n)
      rows = [firstRow .. firstRow + n - 1]
  in concat [take n $ drop firstCol $ selectRow xss r | r <- rows]

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs =
  let xsnz = [i | i <- xs, i /= 0] -- xs with no 0s
  in nub xsnz == xsnz

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss =
  let subsections = concat [[selectRow xss i, selectColumn xss i, selectSquare xss i] | i <- [0 .. length xss - 1]]
  in and [isValidSubsection i | i <- subsections]

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x =
  let setRowCell xs k x = take k xs ++ [x] ++ drop (k + 1) xs
  in [if j == i then setRowCell (xss !! i) k x else xss !! i | i <- [0 .. length xss - 1]]

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss =
      -- number of cells per subsection
  let n = length xss
      -- square number of a cell
      squareNr (j, k) = j - j `mod` intRoot n + k `div` intRoot n
      -- numbers that could be entered into a cell
      validNumbers xss (j, k) = [i | i <- [1 .. n],
                                 i `notElem` selectRow xss j,
                                 i `notElem` selectColumn xss k,
                                 i `notElem` selectSquare xss (squareNr (j, k))]
      -- cells that must be filled
      nonPrefilledCells = concat [catMaybes [if selectRow xss j !! k == 0 then Just (j, k) else Nothing | k <- [0 .. n - 1]] | j <- [0 .. n - 1]]
      -- solve the sudoku recursively
      bruteForce xss remainingCells
       | null remainingCells = xss -- we're done
       | otherwise = fromMaybe [] $ find (not . null) [bruteForce (setCell xss (head remainingCells) i) $ tail remainingCells | i <- validNumbers xss $ head remainingCells]
  in if isValidSudoku xss then bruteForce xss nonPrefilledCells else []
{-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 i [] = []
    chunksOf i ls = take i ls : chunksOf i (drop i ls)