module Exercise03 where

import Text.Printf (printf)
import Data.List (minimumBy, transpose, (\\), delete, nub, intercalate)

-- HA 3.1a) i
selectRow :: [[Int]] -> Int -> [Int]
selectRow (x:xss) i = if i == 0 then x else selectRow xss (i - 1)

-- HA 3.1a) ii
-- alternativ statt xs !! i: get xs i
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [xs !! i | xs <- xss]

get :: [Int] -> Int -> Int
get (x:xs) i = if i == 0 then x else get xs (i - 1)

-- 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]
--alternativ statt xss !! (row + r) !! (column + c): get (selectRow xss (row + r)) (column + c)
selectSquare :: [[Int]] -> Int -> [Int]
selectSquare xss i = [ xss !! (row + r) !! (column + c) | r <- [0 .. size - 1], c <- [0 .. size - 1]]
  where size = intRoot (length xss)
        row = div i size * size
        column = mod i size * size


-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs = length (nub notNullList) == length notNullList && length [ x | x <- notNullList, x <= length xs && x > 0] == length notNullList
  where notNullList = [ x | x <- xs, x /= 0]
{- alternativ:
  isValidSubsection :: [Int] -> [Int] -> Bool
  isValidSubsection [] = True
  isValidSubsection (x:xs) ns
    | x > length (x:xs) || x < 0 = False
    | x == 0 = isValidSubsection xs ns
    | otherwise = x 'elem' ns && isValidSubsection xs remove x ns
-}

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

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x = [[ if m /= j || n /= k then xss !! m !! n else x
 | n <- [0..(length xss - 1)]] | m <- [0..(length xss - 1)]]

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = if isFilledCompletely solution then solution else []
  where solution = buildSudoku (solveSudokuP (setUp xss))

isFilledCompletely :: [[Int]] -> Bool
isFilledCompletely xss = null [ x | x <- concat xss, x == 0]

solveSudokuP :: [[[Int]]] -> [[[Int]]]
solveSudokuP xsss = solve (settle xsss)

solve :: [[[Int]]] -> [[[Int]]]
solve xsss
  | not (isValidPSudoku xsss) = []
  | isGridFilled xsss = xsss
  | otherwise = if solution1 /= [] then solution1 else (if null grid2 || null solution2 then [] else solution2)
  where (grid1, grid2) = nextGrid xsss
        solution1 = solveSudokuP grid1
        solution2 = solveSudokuP grid2

buildSudoku :: [[[Int]]] -> [[Int]]
buildSudoku xsss = [[if length xs == 1 then head xs else 0 | xs <- xss] | xss <- xsss]

isGridFilled :: [[[Int]]] -> Bool
isGridFilled xsss = null [ () | xss <- concat xsss, length xss > 1 ]

isValidPSudoku :: [[[Int]]] -> Bool
isValidPSudoku xsss = isValidSudoku (buildSudoku xsss) && null [ cell | cell <- concat xsss, null cell]

nextGrid :: [[[Int]]] -> ([[[Int]]], [[[Int]]])
nextGrid xsss = (firstGrid, secondGrid)
  where size = length xsss
        cells = [ (i, possibilities) | (i, possibilities) <- zip [0..] (concat xsss), length possibilities > 1]
        min = minimum [ length p | (_, p) <- cells]
        (index, newVal : rest ) = head [ (i, possibilities) | (i, possibilities) <- cells, length possibilities == min]
        firstGrid = setCellPossibility xsss (div index size, mod index size) [newVal]
        secondGrid = setCellPossibility xsss (div index size, mod index size) rest

setCellPossibility :: [[[Int]]] -> (Int,Int) -> [Int] -> [[[Int]]]
setCellPossibility xsss (j, k) x = [[ if m /= j || n /= k then xsss !! m !! n else x
 | n <- [0..(length xsss - 1)]] | m <- [0..(length xsss - 1)]]

{-setting up a distinct puzzle with all the possibilities for every cell-}

setUp :: [[Int]] -> [[[Int]]]
setUp xxs = [ [ if x == 0 then [1..(length xxs)] else [x] | x <- xs ]| xs <- xxs ]

settle :: [[[Int]]] -> [[[Int]]]
settle xxxs = if xxxs == xxxs' then xxxs else settle xxxs' where xxxs' = cleanUp xxxs

cleanUp :: [[[Int]]] -> [[[Int]]]
cleanUp xxxs =  squaresToRows [ cleanUpRow square | square <- squaresToRows (transpose [ cleanUpRow column  | column <- transpose [ cleanUpRow row | row <- xxxs]])]

cleanUpRow :: [[Int]] -> [[Int]]
cleanUpRow xxs = [ if length xs > 1 then xs \\ list else xs | xs <- xxs] where list = [ head xs | xs <- xxs, length xs == 1]

squaresToRows :: [[[Int]]] -> [[[Int]]]
squaresToRows xxxs = [ selectPossibilitiesSquare xxxs i | i <- [0..(length xxxs-1)]]

selectPossibilitiesSquare :: [[[Int]]] -> Int -> [[Int]]
selectPossibilitiesSquare xsss i = [ xsss !! (row + r) !! (column + c) | r <- [0 .. size - 1], c <- [0 .. size - 1]]
  where size = intRoot (length xsss)
        row = div i size * size
        column = mod i size * size


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