module Exercise03 where

import Text.Printf (printf)
import Data.List

-- 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 =  [col!!c |c <- [rstart..rstart + r - 1],col <- [selectColumn xss i'| i' <- [cstart..cstart + r - 1]]]
  where 
    l = length xss
    r = intRoot l
    cstart = r * mod i r 
    rstart = r * div i r

-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs = length (nub xs') == length xs'
  where xs' = [x | x <- xs, x /= 0] 

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = and [isValidSubsection (selectSquare xss a) && isValidSubsection (selectColumn xss a) && isValidSubsection (selectRow xss a)| a <- [0..(length xss -1)]]

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x = a ++ row:b
  where (a,tempRow:b) = splitAt j xss
        row = setValRow tempRow k x

setCell2 :: [[Int]] -> (Int,Int) -> Int -> Bool -> [[Int]]
setCell2 xss (j, k) x b
  |b = setCell xss (j, k) x
  |otherwise = xss

setValRow :: [Int] -> Int -> Int -> [Int]
setValRow xs pos val = a ++ val:b 
  where (a,_:b) = splitAt pos xs

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = solveRec xss (0,0) 0 --init at (0,0) with val 0 (+1)

solveRec :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
solveRec xss pos val = 
  let 
      newVal = nextVal xss pos val --next valid value
      xss' = if newVal /= -1 --if valid option left
              then setCell2 xss pos newVal (xss!!fst pos!!snd pos == 0) --change val if is changeable
                else [] --no valid option left 

      newPos = nextPos pos (length xss -1) --get nextPos for recursion
      xss'' 
        | null xss' = xss --no valid option left (2)
        | newPos == (-1, -1) = xss'
        | otherwise = solveRec xss' newPos 0 --foreward --muss gespeichert sein für backtracking -- entweder bis isValid oder bis abbruch       -- |newPos == (-1, -1) && xss' /= [] {-every pos filled-} = xss' --return because done           |null xss' {-no possible solution from here on --> backtrack-}       |otherwise = xss'
  --xss'' aus irgendeinem Grund immer []
  in 
    if null xss'--(isValidSudoku xss'' && not (null xss''))|| (null xss'' && newVal == -1) --Abbruch falls fertig
      then [] -- [] & -1
      else if not (null xss'') && isValidSudoku xss'' --finished
        then xss'' 
        else solveRec xss pos newVal  --nextPos failed -> iterate nextVal
  
nextPos :: (Int, Int) -> Int -> (Int, Int)
nextPos (x, y) max
  |x == max && y == max = (-1, -1)
  |y == max = (x+1, 0)
  |otherwise = (x, y+1)

nextVal :: [[Int]] -> (Int, Int) -> Int -> Int
nextVal xss pos val 
  |val >= length xss = -1
  |isValidSudoku xss' = val'
  |otherwise = nextVal xss pos val'
  where val' = val + 1
        xss' = setCell xss pos val' 

--if everything fails --> monads
--debug.trace
--monad: do -> guards -> return (maybe)
{-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)