module Exercise03 where

import Data.List
import Data.Ord (comparing)
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 = concat [take root (drop (i `mod` root * root) xs) | xs <- take root (drop (i `div` root * root) xss)]
  where
    root = intRoot $ length xss

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs = all (\ls -> length ls == 1) (tail (group (sort (0 : xs))))

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = all isValidSubsection (xss ++ map (selectColumn xss) [0 .. length xss -1] ++ map (selectSquare xss) [0 .. length xss -1])

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell xss (j, k) x = replaceAt (replaceAt x k (xss !! j)) j xss

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = if isValidSudoku xss then [map (\(_, _, x : _) -> - x) xs | xs <- solve mc (getMinimum mc)] else []
  where
    mc = mapCandidates xss

solve :: [[(Int, Int, [Int])]] -> (Int, Int, [Int]) -> [[(Int, Int, [Int])]]
solve xss (j, k, x : xs) = if null sol then solve xss (j, k, xs) else sol
  where
    ins = insertAt (length xss -1) xss (j, k) x
    sol = solve ins (getMinimum ins)
solve xss (-1, -1, []) = xss
solve _ (_, _, _) = []

insertAt :: Int -> [[(Int, Int, [Int])]] -> (Int, Int) -> Int -> [[(Int, Int, [Int])]]
insertAt count xss (j, k) x
  | count == -1 = xss
  | count == j = ins (\(a, b, ys) -> if b == k then (a, b, [- x]) else (a, b, ys \\ [x]))
  | count `div` root == j `div` root = ins (\(a, b, ys) -> if b `div` root == k `div` root then (a, b, ys \\ [x]) else (a, b, ys))
  | otherwise = ins (\(a, b, ys) -> if b == k then (a, b, ys \\ [x]) else (a, b, ys))
  where
    root = intRoot $ length xss
    ins f = insertAt (count -1) (replaceAt (map f (xss !! count)) count xss) (j, k) x

replaceAt :: a -> Int -> [a] -> [a]
replaceAt y 0 (_ : xs) = y : xs
replaceAt y k (x : xs) = x : replaceAt y (k -1) xs

getMinimum :: [[(Int, Int, [Int])]] -> (Int, Int, [Int])
getMinimum xss = if null filt then (-1, -1, []) else minimumBy (comparing (\(_, _, xs) -> length xs)) filt
  where
    filt = filter (\(_, _, xs) -> null xs || head xs >= 0) (concat xss)

mapCandidates :: [[Int]] -> [[(Int, Int, [Int])]]
mapCandidates xss = [[(j, k, getCandidates xss (j, k)) | k <- arr] | j <- arr]
  where
    arr = [0 .. length xss -1]

getCandidates :: [[Int]] -> (Int, Int) -> [Int]
getCandidates xss (j, k) = if element /= 0 then [- element] else [1 .. length xss] \\ (getSquare xss (j, k) `union` selectColumn xss k `union` selectRow xss j)
  where
    element = (xss !! j) !! k

getSquare :: [[Int]] -> (Int, Int) -> [Int]
getSquare xss (j, k) = selectSquare xss (root * (j `div` root) + k `div` root)
  where
    root = intRoot $ length xss

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

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

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

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

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