module Exercise03 where

import Text.Printf (printf)
import Data.List (minimumBy, (\\),  elemIndices, intercalate ) 

-- 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 =  [ xs!!xc |  xs <- [xss!!xr | xr <- [k*r .. (k*r+k-1)]], xc <- [ (c*k) .. (c*k+k-1)]]
                        where   k = intRoot (length xss)
                                r = div i k 
                                c = mod i k
-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection  xs = all (<=1) [length [x | x <- xs, x == i] | i <- [1 .. length xs]]

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

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x =  let   (a, xs:b)   = splitAt j xss
                              (aa, _:bb)  = splitAt k xs
                        in a ++ (aa ++ x:bb):b

-- HA 3.1d)
{-WETT-}
getFields :: [[Int]] -> [(Int,Int)]
getFields xss = [(x,y)  | (x,ys) <- zip [0..] xss, y <- elemIndices 0 ys]

getFeasibleSets :: [[Int]] -> Int -> [((Int,Int),[Int])]
getFeasibleSets xss k = [( (x,y), (([0 .. (k*k)]  \\ selectRow xss x) \\ selectColumn xss y)  \\ selectSquare xss ( x - mod x k + div y k) )| (x,y) <- getFields xss]

updateFeasibleSet :: [((Int,Int),[Int])] -> (Int,Int) -> Int -> Int -> [((Int,Int),[Int])]
updateFeasibleSet fss (x,y) val k = [ if x == a || y == b || (div a k == div x k && div b k == div y k) then ((a,b), fs \\  [val]) else ((a,b), fs) | ((a,b), fs) <- fss, (a,b) /= (x,y)]

falsify :: [((Int, Int), [Int])] -> (Int, Int) -> Int -> [((Int, Int), [Int])]
falsify fss pos f = [ if pos == pos1 then (pos1,fs \\ [f] ) else (pos1, fs) | (pos1, fs) <- fss]

tryNextNumber :: [[Int]] -> [((Int,Int),[Int])] -> Int -> [[Int]]
tryNextNumber xss []  _  = xss
tryNextNumber xss fss k  = case (pos, fs) of 
        (_,[])                -> []
        (pos, [f])            -> tryNextNumber (setCell xss pos f) (updateFeasibleSet fss pos f k) k
        (pos, f:_)            -> if null res then tryNextNumber xss (falsify fss pos f) k else res
                where res = tryNextNumber (setCell xss pos f) (updateFeasibleSet fss pos f k) k
        where   (pos, fs) = minimumBy ( \(_, fs1) (_, fs2) -> compare (length fs1) (length fs2)) fss

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss 
                | isValidSudoku xss     = tryNextNumber xss ( getFeasibleSets xss k) k       
                | otherwise             = [] 
        where k = 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]]
weirdSudoku :: [[Int]]
weirdSudoku = [[0,0,0,4],[0,0,0,0],[0,3,0,0],[0,0,4,4]]
-- Utility method to show a sudoku
-- show sudoku with
-- >>> putStr (showSudoku sudoku)
-- Variable not in scope: sudoku :: [[Int]]
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)

-- for Debugging using Haskell GHCi DebugAdapter Phoityne
main :: IO()
main = putStr (showSudoku  $ solveSudoku weirdSudoku)