module Exercise03 where

import Data.List (elemIndex, intercalate, nub, (\\))
import Data.Maybe (fromMaybe)
import Text.Printf (printf)

sudoku :: Int -> [[Int]]
sudoku 0 = [[8, 9, 6, 7, 5, 2, 4, 1, 3], [5, 2, 3, 6, 1, 4, 9, 8, 7], [4, 7, 1, 8, 9, 3, 2, 6, 5], [9, 5, 4, 3, 6, 7, 8, 2, 1], [3, 1, 8, 2, 4, 5, 7, 9, 6], [7, 6, 2, 1, 8, 9, 5, 3, 4], [6, 8, 9, 5, 7, 1, 3, 4, 2], [2, 4, 7, 9, 3, 6, 1, 5, 8], [1, 3, 5, 4, 2, 8, 6, 7, 9]]
sudoku 1 = setCell (sudoku 0) (0, 0) 0
sudoku 2 = setCell (sudoku 0) (1, 0) 0
sudoku 3 = setCell (sudoku 0) (0, 1) 0
sudoku 4 = setCell (sudoku 0) (3, 1) 0
--hard
sudoku 10 = [[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]]
sudoku 11 = [[0, 0, 0, 0, 0, 0, 0, 0, 0], [0, 0, 0, 0, 0, 3, 0, 8, 5], [0, 0, 1, 0, 2, 0, 0, 0, 0], [0, 0, 0, 5, 0, 7, 0, 0, 0], [0, 0, 4, 0, 0, 0, 1, 0, 0], [0, 9, 0, 0, 0, 0, 0, 0, 0], [5, 0, 0, 0, 0, 0, 0, 7, 3], [0, 0, 2, 0, 1, 0, 0, 0, 0], [0, 0, 0, 0, 4, 0, 0, 0, 9]]
sudoku 12 = [[0, 0, 0, 0, 0, 6, 0, 0, 0], [0, 5, 9, 0, 0, 0, 0, 0, 8], [2, 0, 0, 0, 0, 8, 0, 0, 0], [0, 4, 5, 0, 0, 0, 0, 0, 0], [0, 0, 3, 0, 0, 0, 0, 0, 0], [0, 0, 6, 0, 0, 3, 0, 5, 4], [0, 0, 0, 3, 2, 5, 0, 0, 6], [0, 0, 0, 0, 0, 0, 0, 0, 0], [0, 0, 0, 0, 0, 0, 0, 0, 0]]
sudoku 13 = [[0, 0, 5, 3, 0, 0, 0, 0, 0], [8, 0, 0, 0, 0, 0, 0, 2, 0], [0, 7, 0, 0, 1, 0, 5, 0, 0], [4, 0, 0, 0, 0, 5, 3, 0, 0], [0, 1, 0, 0, 7, 0, 0, 0, 6], [0, 0, 3, 2, 0, 0, 0, 8, 0], [0, 6, 0, 5, 0, 0, 0, 0, 9], [0, 0, 4, 0, 0, 0, 0, 3, 0], [0, 0, 0, 0, 0, 9, 7, 0, 0]]
sudoku 14 = [[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]]
--unsolvable
sudoku 100 = [[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]]

s = sudoku 0

f = concat s

-- 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 =
  let px = mod i (div width cellSize) * cellSize
      py = div i (div width cellSize) * cellSize
   in [(xss !! y) !! x | y <- [py .. py + cellSize -1], x <- [px .. px + cellSize -1]]
  where
    cellSize = intRoot $ length xss
    width = length xss

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

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = all isValidSubsection (concat [[selectRow xss i, selectColumn xss i, selectSquare xss i] | i <- [0 .. length xss -1]])

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell xss (k, j) x = take k xss ++ (take j (xss !! k) ++ x : drop (j + 1) (xss !! k)) : drop (k + 1) xss

-- HA 3.1d)
{-WETT-}
indices :: Foldable t => t a -> Int -> (Int, Int)
indices xss i = (mod i $ length xss, div i $ length xss)

xyToSquare :: [[Int]] -> Int -> Int -> Int
xyToSquare xss x y = div y w * w + div x w
  where
    w = intRoot $ length xss

possibilities :: [[Int]] -> Int -> Int -> [Int]
possibilities xss x y = [1 .. length xss] \\ (selectColumn xss x ++ selectRow xss y ++ selectSquare xss (xyToSquare xss x y))

findZero :: [[Int]] -> Int
findZero xss = fromMaybe (-1) (elemIndex 0 (concat xss))

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss
  | i == (-1) = if isValidSudoku xss then xss else []
  | otherwise = let (x, y) = indices xss i in head ((filter (/= []) [solveSudoku (setCell xss (y, x) k) | k <- possibilities xss x y]) ++ [[]])
  where
    i = findZero xss

allPossibilities :: [[Int]] -> [[Int]]
allPossibilities xss = [possibilities xss y x | x <- [0 .. length xss -1], y <- [0 .. length xss -1]]

findLeast :: [[Int]] -> Int
findLeast xss = let min = minimum p in if min /= length xss + 1 then fromMaybe (-1) (elemIndex min p) else -1
  where
    p = map (\x -> if null x then length xss + 1 else length x) $ allPossibilities xss

solveSudoku3 :: [[Int]] -> [[Int]]
solveSudoku3 xss = squareify (solveSudokuFlat $ concat xss)

squareify :: [Int] -> [[Int]]
squareify xs
  | null xs = []
  | otherwise = [take r (drop (y * r) xs) | y <- [0 .. r -1]]
  where
    r = sidelength xs

sidelength :: [Int] -> Int
sidelength xs = intRoot $ length xs

squarelength :: [Int] -> Int
squarelength xs = intRoot $ sidelength xs

isValidSudokuFlat :: [Int] -> Bool
isValidSudokuFlat xs = all isValidSubsection (concat [[selectRowFlat xs i, selectColumnFlat xs i, selectSquareFlat xs i] | i <- [0 .. sidelength xs -1]])

isValidSubsectionFlat :: [Int] -> Bool
isValidSubsectionFlat xs = length (nub ns) == length ns
  where
    ns = filter (/= 0) xs

selectRowFlat :: [Int] -> Int -> [Int]
selectRowFlat xs i = take (sidelength xs) $ drop (sidelength xs * i) xs

selectRowFlatIndex :: [Int] -> Int -> [Int]
selectRowFlatIndex xs i = take (sidelength xs) $ drop (sidelength xs * (i `mod` sidelength xs)) xs

selectColumnFlatIndex :: [Int] -> Int -> [Int]
--TODO
selectColumnFlatIndex xs i = [xs !! (x * sidelength xs + i `mod` sidelength xs) | x <- [0 .. sidelength xs -1]]


selectColumnFlat :: [Int] -> Int -> [Int]
selectColumnFlat xs i = [xs !! (x*sidelength xs+ i) | x<- [0..sidelength xs -1]]

selectSquareFlat :: [Int] -> Int -> [Int]
selectSquareFlat xs i = concat [take (squarelength xs) (drop (sidelength xs * k + o) xs) | k <- [0 .. squarelength xs -1]]
  where
    o =
      let w = sidelength xs
          c = squarelength xs
       in ((i `mod` c) + ((i `div` c) * w)) * c

selectSquareFlatIndex :: [Int] -> Int -> [Int]
selectSquareFlatIndex xs i = selectSquareFlat xs $ flatToSquareIndex i (sidelength xs) (squarelength xs)

flatToSquareIndex :: Int -> Int -> Int -> Int
flatToSquareIndex i w c = (i `mod` w) `div` c + ((i `div` w) `div` c)*c

findZeroFlat :: [Int] -> Int
findZeroFlat xs = fromMaybe (-1) (elemIndex 0 xs)

setCellFlat :: [Int] -> Int -> Int -> [Int]
setCellFlat xs i x = take i xs ++ x : drop (i + 1) xs

possibilitiesFlat :: [Int] -> Int -> [Int]
possibilitiesFlat xs i = [1 .. sidelength xs] \\ (selectColumnFlatIndex xs i ++ selectRowFlatIndex xs i ++ selectSquareFlatIndex xs i)

solveSudokuFlat :: [Int] -> [Int]
solveSudokuFlat xs
  | i == (-1) = if isValidSudokuFlat xs then xs else []
  | otherwise = head ((filter (/= []) [solveSudokuFlat (setCellFlat xs i k) | k <- possibilitiesFlat xs i]) ++ [[]])
  where
    i = findZeroFlat xs

solveSudoku2 :: [[Int]] -> [[Int]]
solveSudoku2 xss
  | i == (-1) = if isValidSudoku xss then xss else []
  | otherwise = let (x, y) = indices xss i in head ((filter (/= []) [solveSudoku2 (setCell xss (x, y) k) | k <- possibilities xss x y]) ++ [[]])
  where
    i = findLeast xss

{-TTEW-}

test = all (== sudoku 0) [solveSudoku (sudoku i) | i <- [0 .. 4]] && solveSudoku hardSudoku == [[8, 1, 2, 7, 5, 3, 6, 4, 9], [9, 4, 3, 6, 8, 2, 1, 7, 5], [6, 7, 5, 4, 9, 1, 2, 8, 3], [1, 5, 4, 2, 3, 7, 8, 9, 6], [3, 6, 9, 8, 4, 5, 7, 2, 1], [2, 8, 7, 1, 6, 9, 5, 3, 4], [5, 2, 1, 9, 7, 4, 3, 6, 8], [4, 3, 8, 5, 2, 6, 9, 1, 7], [7, 9, 6, 3, 1, 8, 4, 5, 2]]

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)