module Exercise03 where

import Text.Printf (printf)
import Data.List (intercalate, transpose)

-- HA 3.1a) i
selectRow :: [[Int]] -> Int -> [Int]
selectRow xss i = xss !! i

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [ row !! i | row <-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 bs = intRoot (length xss) 
                         lineblock = take bs (drop (i - i `mod` bs) xss)
                         takedrop lss = take bs (drop ((i `mod` bs) * bs) lss)
                     in  concatMap takedrop lineblock

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection [] = True
isValidSubsection (x:xs) 
  | x == 0 || x `notElem` xs = isValidSubsection xs
  | otherwise = False

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = ($!) and [isValidSubsection xs | xs <- xss] && and [isValidSubsection xs | xs <- transpose xss] &&
                        and[isValidSubsection (selectSquare xss i) | i<-[0..length xss-1]]

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x = let change [] _ = []
                           change (l:ls) k
                             | k > 0     = l : change ls (k-1)
                             | otherwise = x : ls
                           changeInLine [] _ = []
                           changeInLine (l:ls) j
                             | j > 0     = l : changeInLine ls (j-1)
                             | otherwise = change l k : ls
                       in changeInLine xss j


-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss =  backtracking xss (unsolved xss) [1..length xss]

unsolved :: [[Int]] -> [(Int,Int)]
unsolved xss = [(y,z) | (x,(y,z)) <- zip (concat xss) [(i,j) | i<-[0..length xss -1], j<-[0..length xss -1]], x == 0]

backtracking :: [[Int]] -> [(Int,Int)] -> [Int] -> [[Int]]
backtracking  _   _ [] = [[]]
backtracking xss [] _  = if isValidSudoku xss then xss else [[]] -- leer oder lösung (umfassend? fehler?)
backtracking xss (u:us) (g:gs) 
  | isValidSudoku xss' && guess /= [[]] = guess
  | otherwise          =  backtracking xss (u:us) gs
  where xss'  = setCell xss (m,n) g
        guess = backtracking xss' us [1..length xss]
        (m,n) = u

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