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 =  let n=length xss; nRoot= intRoot n; row = i `div` nRoot; col = i `mod` nRoot in 
    concat [[xs] | num <- [nRoot*row .. nRoot*row+(nRoot-1)], xs <- take nRoot $ drop (nRoot*col) $selectRow xss num]

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

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

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

-- HA 3.1d)
{-WETT-}
newtype Crumb = Crumb ([[Int]],(Int,Int),[Int]) deriving Show --Sudoku, (x,y) and possibilities
type Crumbs = [Crumb]

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = if not (isValidSudoku xss) then [] else let sudoku=findUnique xss; zero = findZero sudoku in solveSudokuAux(sudoku,zero,possibilities sudoku zero,[])

solveSudokuAux :: ([[Int]],(Int,Int),[Int],Crumbs) -> [[Int]]
solveSudokuAux (xss,(x,y),poss,cs) 
  | null xss = []
  | x == -1 = xss
  | null poss = solveSudokuAux (goUp cs)
  | otherwise = let newSudoku = findUnique $ setCell xss (x,y) (head poss); newZero = findZero newSudoku 
                  in solveSudokuAux (newSudoku,newZero,possibilities newSudoku newZero, Crumb (xss,(x,y),tail poss):cs)

goUp :: Crumbs -> ([[Int]],(Int,Int),[Int],Crumbs)
goUp [] = ([],(-1,-1),[],[])
goUp (Crumb (xss,(x,y),poss):cs) = (xss,(x,y),poss,cs)

findUnique :: [[Int]] -> [[Int]] --if no unique, return input
findUnique xss = aux 0 0 where
  aux x y
    | x == length xss = xss
    | y == length xss = aux (x+1) 0
    | xss!!x!!y /= 0 = aux x (y+1)
    | length (possibilities xss (x,y)) == 1 = findUnique (setCell xss (x,y) (head $ possibilities xss (x,y)))
    | otherwise = aux x (y+1)

possibilities :: [[Int]] -> (Int,Int) -> [Int]
possibilities xss (x,y) = if x==(-1) then [] else let nRoot = intRoot (length xss) 
  in (([1..length xss]\\selectRow xss x)\\ selectColumn xss y)\\ selectSquare xss ((x `div` nRoot)*nRoot + (y `div` nRoot))

findZero :: [[Int]] -> (Int,Int) --(x,y) if 0 found, otherwise (-1,-1)
findZero xss = aux 0 0 where
  aux x y
    | x == length xss = (-1,-1)
    | y == length xss = aux (x+1) 0
    | xss!!x!!y == 0 = (x,y)
    | otherwise = aux x (y+1)

findZeroes :: [[Int]] -> [(Int,Int)]
findZeroes xss = aux 0 0 where
  aux x y
    | x == length xss = []
    | y == length xss = aux (x+1) 0
    | xss!!x!!y == 0 = (x,y) : aux x (y+1)
    | otherwise = aux x (y+1)
{-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]]

harderSudoku ::[[Int]]
harderSudoku = [[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]]
          
bigSudoku :: [[Int]]
bigSudoku =  [[0,6,0,0, 0,0,0,8, 11,0,0,15, 14,0,0,16],
              [15,11,0,0, 0,16,14,0, 0,0,12,0, 0,6,0,0],
              [13,0,9,12, 0,0,0,0, 3,16,14,0, 15,11,10,0],
              [2,0,16,0, 11,0,15,10, 1,0,0,0, 0,0,0,0],
              
              [0,15,11,10, 0,0,16,2, 13,8,9,12, 0,0,0,0],
              [12,13,0,0, 4,1,5,6, 2,3,0,0, 0,0,11,10],
              [5,0,6,1, 12,0,9,0, 15,11,10,7, 16,0,0,3],
              [0,2,0,0, 0,10,0,11, 6,0,5,0, 0,13,0,9],

              [10,7,15,11, 16,0,0,0, 12,13,0,0, 0,0,0,6],
              [9,0,0,0, 0,0,1,0, 0,2,0,16, 10,0,0,11],
              [1,0,4,6, 9,13,0,0, 7,0,11,0, 3,16,0,0],
              [16,14,0,0, 7,0,10,15, 4,6,1,0, 0,0,13,8],
              
              [11,10,0,15, 0,0,0,16, 9,12,13,0, 0,1,5,4],
              [0,0,12,0, 1,4,6,0, 16,0,0,0, 11,10,0,0],
              [0,0,5,0, 8,12,13,0, 10,0,0,11, 2,0,0,14],
              [3,16,0,0, 10,0,0,7, 0,0,6,0, 0,0,12,0]]

chefsudoku :: [[Int]]
chefsudoku =
  [[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]]

smallSudoku :: [[Int]]
smallSudoku = [ [3,4,1,0],
                [0,2,0,0],
                [0,0,2,0],
                [0,1,4,3]]

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