module Exercise03 where

import Data.List (find, intercalate, nub, (\\))
import Text.Printf (printf)
import Debug.Trace

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

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [x !! i | x <- 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]
-- len is n for n X n Sudoku and vn is suare root of len.
selectSquare :: [[Int]] -> Int -> [Int]
selectSquare xss i = (i * vn `div` len) `squareHelper` (i * vn `mod` len)
  where
    squareHelper row index = concat [drop index . take (index + vn) $ xs | xs <- drop (row * vn) . take ((row + 1) * vn) $ xss]
    vn = intRoot (len)
    len = length xss

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs = filter (/= 0) xs == nub xs \\ [0]

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = and [isValidSubsection subsection | subsection <- (xss ++ [selectColumn xss x | x <- [0 .. len -1]] ++ [selectSquare xss x | x <- [0 .. len -1]])]
  where
    len = length xss

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell xss (x, y) n = (take (x) xss) ++ [((take (y) (selectRow xss x)) ++ [n] ++ (drop (y + 1) (selectRow xss x)))] ++ (drop (x + 1) xss)

-- HA 3.1d)
{-WETT-}
selectCell :: [[Int]] -> (Int, Int) -> Int
selectCell xss (x, y) = (selectRow xss x) !! y

isValid :: [[Int]] -> (Int, Int) -> Bool
isValid xss (x, y) = isValidSubsection (selectSquare xss square) && isValidSubsection (selectRow xss x) && isValidSubsection (selectColumn xss y) && selectCell xss (x,y) /= 0
  where
    square = let n = length xss in (((intRoot n) * (x `div` intRoot n)) + (y `div` intRoot n))

validCellVals :: [[Int]] -> (Int, Int) -> [Int]
validCellVals xss n = [x | x <- [1..length xss], isValid (setCell xss n x) n]

{-Changed so that only the next valid value per cell is returned, for alternate implementation of solveSudoku.-}
-- validCellVal :: [[Int]] -> (Int, Int) -> Int
-- validCellVal xss c
--   | isValid (setCell xss c ((selectCell xss c) + 1)) c = (selectCell xss c) + 1
--   | selectCell xss c < length xss = validCellVal (setCell xss c ((selectCell xss c) + 1)) c
--   | otherwise = -1

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = backtracker xss (0, 0)
  where backtracker xss (x,y)
          |y >= length xss  = backtracker xss (x+1,0)
          |x >= length xss  = xss
          |selectCell xss (x,y) /= 0 = backtracker xss (x,y+1)
          |otherwise  = f (filter (/=[]) [backtracker (setCell xss (x,y) val) (x,y+1) | val <- validCellVals xss (x,y)])
          where f ns = if null ns then [] else ns !! 0

{-Tried to implement it, so that for every cell, the possible cell values get tried one after another to avoid trying all possible values at once.
If it worked, a lot of combinations would be ruled out. Works only on 4 x 4 empty sudoku for some reason.-}
-- solveSudoku :: [[Int]] -> [[Int]]
-- solveSudoku xss = backtracker xss (0, 0)
--   where
--     backtracker xss (x, y)
--       | y >= length xss = backtracker xss (x + 1, 0)
--       | x >= length xss = xss
--       | selectCell xss (x, y) /= 0 = backtracker xss (x, y + 1)
--       | validCellVal xss (x, y) == -1 = []
--       | otherwise = if next /= [] then next
--         else backtracker (setCell xss (x,y) (validCellVal xss (x,y))) (x,y)
--         where next = backtracker (setCell xss (x,y) (validCellVal xss (x,y))) (x,y+1)

{-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)