module Exercise03 where

import Text.Printf (printf)
import Data.List (intercalate, delete)
import Data.Bits
import Data.Maybe
data Cell = Value Int | Options Int deriving (Eq, Show)


intRoot :: Int -> Int
intRoot = floor . sqrt . fromIntegral

--Returns one row numbered 0 to n
selectRow :: [[Int]] -> Int -> [Int]
selectRow xss i = xss!!i

--Returns one column numbered 0 to n
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [xs!!i | xs <- xss]


--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 size (drop (size * (i `mod` size))xs) | xs <- take size $ drop ((i `div` size) * size) xss]
  where size = floor $ sqrt $ fromIntegral $ length xss


--checks if every number between 1 and n at most once in the list
isValidSubsection :: [Int] -> Bool
isValidSubsection [] = True
isValidSubsection (x:xs) 
  | x == 0 || (x `notElem` xs) = isValidSubsection xs
  | otherwise = False

--checks if the sudoku currently is valid(every number less than twice in each row/column/square)
isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = and [isValidSubsection (selectSquare xss i) && isValidSubsection (selectRow xss i) && isValidSubsection (selectColumn xss i) | i <- [0.. (length xss-1)]]
  && and [x >= 0 && x <= length xss | x <- concat xss]

--set cell (x,y) to n while keeping the rest unchanged
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (x,y) n = take x xss ++ [take y (xss!!x) ++ [n] ++ drop (y+1) (xss!!x)] ++ drop (x+1) xss

--checks if sudoku has at least one 0 field
hasEmpty :: [[Int]] -> Bool
hasEmpty s = 0 `elem` concat s

--finds first 0 field
findEmpty :: [[Int]] -> (Int, Int)
findEmpty xss
  |not (hasEmpty xss) = (-1, -1)
  |otherwise = (coord `mod` length xss,coord `div` length xss)
 where coord = findEmptyAux (concat xss) 0

findEmptyAux :: [Int] -> Int -> Int
findEmptyAux [] _ = -1
findEmptyAux (x:xs) n
  | x == 0 = n
  | otherwise = findEmptyAux xs (n + 1)

solveSudokuDumm :: [[Int]] -> [[Int]]
solveSudokuDumm xss 
  | not $ isValidSudoku xss = []
  | hasEmpty xss= solveSudokuAux xss (findEmpty xss) (length xss)
  | otherwise = xss

solveSudokuAux :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
solveSudokuAux _ _ 0 = []
solveSudokuAux xss coord n
 | isValidSudoku cur = if null next then solveSudokuAux xss coord (n-1) else next
 | otherwise = solveSudokuAux xss coord (n-1)
 where 
  cur = setCell xss coord n
  next = solveSudokuDumm cur
  
findFirstNotNull :: [[a]] -> [a]
findFirstNotNull [] = []
findFirstNotNull ([]:xss) = findFirstNotNull xss
findFirstNotNull (xs:_) = xs


solveSudokuFast :: [[Int]] -> [[Int]]
solveSudokuFast xss = solveSudokuFastAux xss (0, 0)
  where
    solveSudokuFastAux :: [[Int]] -> (Int, Int) -> [[Int]]
    solveSudokuFastAux xss (j, k)
      | j >= length xss = if isValidSudoku xss then xss else []
      | k >= length xss = solveSudokuFastAux xss (j + 1, 0)
      | (xss !! j) !! k /= 0 = solveSudokuFastAux xss (j, k + 1)
      | otherwise =
          let
            isValid i = isValidSudoku (setCell xss (j, k) i)
            solveRecursive i = solveSudokuFastAux (setCell xss (j, k) i) (j, k + 1)
            recursiveResults = [solveRecursive i | i <- [1..length xss], isValid i]
          in
            findFirstNotNull recursiveResults

{-WETT-}

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku = solveSudokuFast

isEmpty :: Cell -> Bool
isEmpty (Options 0) = True
isEmpty _ = False

isSingle :: Cell -> Bool
isSingle (Options x) = popCount x == 1
isSingle _ = False

isValue :: Cell -> Bool
isValue (Value _) = True
isValue _ = False

optionSize :: Cell -> Int
optionSize (Options x) = popCount x

options :: Cell -> Int
options (Options x) = x

fromValue :: Cell -> Int
fromValue (Value x) = x

initialize :: Int -> [[Cell]]
initialize x = replicate x $ replicate x $ Options ((2^(x+1))-2)

deleteFromCell :: Int -> Cell -> Cell
deleteFromCell n (Options c) = Options (clearBit c n)
deleteFromCell _ c = c

selectRowCell :: [[a]] -> Int -> [a]
selectRowCell xss i = xss!!i

--Returns one column numbered 0 to n
selectColumnCell :: [[a]] -> Int -> [a]
selectColumnCell xss i = [xs!!i | xs <- xss]

selectSquareCell :: [[a]] -> Int -> [a]
selectSquareCell xss i = concat [take size (drop (size * (i `mod` size))xs) | xs <- take size $ drop ((i `div` size) * size) xss]
  where size = floor $ sqrt $ fromIntegral $ length xss

setRow :: [[Cell]] -> [Cell] -> Int -> [[Cell]]
setRow table row i = take i table ++ (row : drop (i + 1) table)

setColumn :: [[Cell]] -> [Cell] -> Int -> [[Cell]]
setColumn table column i = zipWith (setIndex i) table column
  where setIndex n xs e = take n xs ++ (e: drop (n + 1) xs)

setSquare :: [[a]] -> [a] -> Int -> [[a]]
setSquare table cell i = take squareRow table ++ zipWith (\t s -> take squareColumn t ++ s ++ drop (squareColumn + squareSize) t) sqareRows square ++ drop (squareRow + squareSize) table
  where 
    squareSize = intRoot (length table)
    squareRow = squareSize * (i`div` squareSize)
    squareColumn = (i `mod` squareSize) * squareSize
    sqareRows = take squareSize (drop squareRow table)

    chunksOf :: Int -> [e] -> [[e]]
    chunksOf siz [] = []
    chunksOf siz ls = take siz ls : chunksOf siz (drop siz ls)

    square = chunksOf squareSize cell

squareIndex :: (Int,Int) -> Int -> Int
squareIndex (x,y) size = x `div` squareSize + squareSize * (y `div` squareSize)
  where squareSize = intRoot size

getCell :: [[a]] -> (Int,Int) -> a
getCell sudoku (x,y) = sudoku !! y !! x

selectValue :: [[Cell]] -> (Int, Int) -> Int -> [[Cell]]
selectValue table _ 0 = table
selectValue table (x,y) val = filterSquare
  where
    size = length table
    squareId = squareIndex (x,y) size
    firstSet = setCellCell table (x,y) (Value val)
    filterRow = setRow firstSet (map (deleteFromCell val) (selectRowCell firstSet y)) y
    filterColumn = setColumn filterRow (map (deleteFromCell val) (selectColumnCell filterRow x)) x
    filterSquare = setSquare filterColumn (map (deleteFromCell val) (selectSquareCell filterColumn squareId)) squareId

isFailedSubsection ::[Cell] -> Bool
isFailedSubsection = any isEmpty 


isFailure :: [[Cell]] -> Bool
isFailure xss= any isEmpty $ concat xss
--isFailure "Patrick" = True

setCellCell :: [[Cell]] -> (Int, Int) -> Cell -> [[Cell]]
setCellCell xss (y,x) n = take x xss ++ [take y row ++ [n] ++ drop (y+1) row] ++ drop (x+1) xss
  where row = xss!!x

solveSudokuKi :: [[Int]] -> [[Int]]
solveSudokuKi sudoku
  |not $ isValidSudoku sudoku = []
  |otherwise = maybe [] (map (map fromValue)) (solveSudokuKiAux starter)
  where
    size = length sudoku
    starter = foldl (\s c -> selectValue s c (getCell sudoku c)) (initialize size) ((,) <$> [0..size-1] <*> [0..size-1])

solveSudokuKiAux :: [[Cell]] -> Maybe [[Cell]]
solveSudokuKiAux table
  |isFailure table = Nothing
  |otherwise = maybe (Just table) (\b -> tryListForCell table (options $ getCell table b ) b  1) (findBestNext table)

tryListForCell :: [[Cell]] -> Int -> (Int, Int) -> Int -> Maybe [[Cell]]
tryListForCell _ 0 _ _= Nothing
tryListForCell table ops coords i 
  |testBit ops i = maybe (tryListForCell table (clearBit ops i) coords (i+1)) Just (solveSudokuKiAux (selectValue table coords i))
  |otherwise = tryListForCell table ops coords (i+1)
{-
findBestNext :: [[Cell]] -> Maybe (Int,Int)
findBestNext table = aux (filter (not . isValue . fst)  (zip (concat table) ((,) <$> [0..size-1] <*> [0..size-1])))
  where 
    size = length table
    aux [] = Nothing
    aux ((_, (cx,cy)):[]) =Just (cy,cx)
    aux ((o1,c1):(o2,c2):cs)
      |optionSize o1 == 1 = Just (snd c1, fst c1)
      |optionSize o1 > optionSize o2 = aux ((o2,c2):cs)
      |otherwise = aux ((o1,c1):cs)
-}
      
findBestNext :: [[Cell]] -> Maybe (Int,Int)
findBestNext table = aux (zip (concat table) ((,) <$> [0..size-1] <*> [0..size-1]))
  where 
    size = length table
    aux [] = Nothing
    aux ((Value _, _):xs) = aux xs 
    aux ((_, (cx,cy)):[]) = Just (cy,cx)
    aux ((o1,c1):(o2,c2):cs)
      |isValue o2 = aux ((o1,c1):cs)
      |optionSize o1 == 1 = Just (snd c1, fst c1)
      |optionSize o1 > optionSize o2 = aux ((o2,c2):cs)
      |otherwise = aux ((o1,c1):cs)

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

maltesImpodoku :: [[Int]]
maltesImpodoku =
  [[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]]

maltesAntidoku :: [[Int]]
maltesAntidoku =
  [[4,0,0, 0,0,0, 8,0,5],
   [0,3,0, 0,0,0, 0,0,0],
   [0,0,0, 7,0,0, 0,0,0],

   [0,2,0, 0,0,0, 0,6,0],
   [0,0,0, 0,8,0, 4,0,0],
   [0,0,0, 0,1,0, 0,0,0],

   [0,0,0, 6,0,3, 0,7,0],
   [5,0,0, 2,0,0, 0,0,0],
   [1,0,4, 0,0,0, 0,0,0]]

bigSudoku :: [[Int]]
bigSudoku =
  [[11,0,5,0, 0,12,0,0, 13,0,0,10, 0,0,0,0],
   [0,13,0,0, 0,0,5,0,  1,0,14,0,  2,0,0,0],
   [0,0,0,9,  0,0,0,2,  0,5,0,0,   14,0,7,0],
   [4,0,12,0, 8,0,0,0,  0,0,0,16,  0,10,0,0],

   [0,9,0,11, 0,0,4,0,  3,6,0,0,   0,0,0,7],
   [6,0,8,0,  10,13,0,16,0,0,11,0, 15,0,9,0],
   [0,3,0,0,  0,0,2,0,  15,0,0,0,  0,13,0,1],
   [16,0,0,2, 0,1,0,5,  0,14,0,8,  0,0,0,0],
   
   [0,0,16,0, 13,4,0,0, 0,0,0,0,   0,0,12,0],
   [0,0,10,3, 0,7,0,0,  5,0,16,0,  9,0,0,15],
   [15,0,11,0,1,0,0,9,  0,2,0,3,   0,4,0,0],
   [0,0,0,0,  0,0,8,0,  0,0,4,0,   10,0,0,0],
   
   [2,0,4,0,  0,0,0,0,  0,0,0,12,  0,0,5,0],
   [0,12,0,13,0,0,0,1,  0,0,10,0,  0,3,0,8],
   [8,0,9,0,  4,0,3,0,  0,7,0,0,   11,0,13,0],
   [0,5,0,14, 0,0,0,11, 0,0,1,6,   0,0,0,10]]

impossible :: [[Int]]
impossible = [[1,2,0,0], [0,0,0,0], [0,0,0,1],[0,0,0,2]]
-- 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)


--main = putStr $ showSudoku $ solveSudokuKi bigSudoku