module Exercise03 where

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

-- HA 3.1a) i
selectRow :: [[Int]] -> Int -> [Int]
selectRow xss i
  | i < length xss = xss !! i
  | otherwise = []

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [x | ys <- xss, let x = ys !! i]

-- 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 =  [y | ys <- rs, y <- drop c (take (c + s) ys)]
  where
    s = intRoot (length xss)
    c = mod i s * s
    r = div i s * s
    rs = drop r (take (r + s) xss)

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


isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = r && c && s && l
  where
    len = length xss
    l = (and [length xs == len | xs <- xss]) && len /= 0
    r = and [isValidSubsection (selectRow xss i) | i <- [0 .. (len - 1)]]
    c = and [isValidSubsection (selectColumn xss i) | i <- [0 .. (len - 1)]]
    s = and [isValidSubsection (selectSquare xss i) | i <- [0 .. (len - 1)]]


-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x = [selectRow xss i | i <- [0 .. (j - 1)]] ++ [modded] ++ [selectRow xss i | i <- [(j + 1) .. (length xss - 1)]]
  where
    rowtomod = selectRow xss j
    modded = [rowtomod !! i | i <- [0 .. (k - 1)]] ++ [x] ++ [rowtomod !! i | i <- [(k + 1) .. (length rowtomod - 1)]]

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = solveSudoku' nextJ nextK xss (possibleDigits nextJ nextK xss)
  where
    next = if head(selectRow xss 0) == 0 then (0, 0) else unsolved 0 0 xss
    nextJ = fst next
    nextK = snd next
{-TTEW-}

solveSudoku' :: Int -> Int -> [[Int]] -> [Int] -> [[Int]]
solveSudoku' j k board [] = []
--solveSudoku' 8 8 board [x] = setCell board (8, 8) x
solveSudoku' j k board (x:xs) 
  | j == maxIndex && k == maxIndex && null xs = setCell board (maxIndex, maxIndex) x
  | null (solveSudoku' nextJ nextK (setCell board (j, k) x) (possibleDigits nextJ nextK (setCell board (j, k) x))) = solveSudoku' j k board xs
  | otherwise = solveSudoku' nextJ nextK (setCell board (j, k) x) (possibleDigits nextJ nextK (setCell board (j, k) x))
  where
    next = unsolved j k board
    nextJ = fst next
    nextK = snd next
    maxIndex = length board - 1


unsolved :: Int -> Int -> [[Int]] -> (Int, Int)
--does not work for 0 0 !!!!
--unsolved 8 8 board = (8, 8) --technically, the result should be empty? but i can force my solver into its base case this way
--unsolved j 8 board = unsolved (j + 1) (-1) board --the point that calls it will def not be empty, so i can force it into next row and start with 0 there
unsolved j k board 
  | j == max && k == max = (max, max)
  | k == max = unsolved (j + 1) (-1) board
  | selectRow board j !! (k + 1) == 0 = (j, k + 1)
  | otherwise                         = unsolved j (k + 1) board
  where
    max = length board - 1

possibleDigits :: Int -> Int -> [[Int]] -> [Int]
possibleDigits j k board
  | selectRow board j !! k == 0 = [x | x <- [1 .. max], isValidSudoku (setCell board (j, k) x)]
  | otherwise = [selectRow board j !! k]
  where 
    max = length board

smallSudoku :: [[Int]]
smallSudoku = [[0,0,3,0],
              [0,0,0,0],
              [0,1,0,0],
              [0,0,0,0]]


smallerSudoku :: [[Int]]
smallerSudoku = [[2,4,3,0],
                 [0,0,0,0],
                 [0,1,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]]

easySudoku :: [[Int]]
easySudoku = [[0,0,0,0,0,0,0,0,0],
              [0,0,0,0,0,0,0,0,0],
              [0,0,0,3,0,0,5,0,5],
              [0,0,0,0,3,0,0,0,0],
              [0,4,0,0,0,0,0,0,0],
              [0,0,0,0,0,0,0,0,0],
              [6,0,0,0,0,0,0,1,0],
              [0,0,0,0,5,0,0,0,0],
              [0,0,0,0,0,4,0,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)