module Exercise03 where

import Text.Printf (printf)
import Data.List (nub, intercalate,find)
import Data.Maybe (fromMaybe)

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

-- d is dimension of square, aka. sqrt n for n*n Sudoku
-- First step: drop rows upper than the square we need
-- Second: take the d rows of the square we need
-- Step 1 and 2 work on xss
-- Third: drop the columns left of the quare we need
-- Fourth: take the d columns of the square we need
-- Step 3 and 4 work on the lists in xss
-- concat all
selectSquare :: [[Int]] -> Int -> [Int]
selectSquare xss i = 
  let d = intRoot $ length $ head xss in
    let rss = take d $ drop (d*div i d) xss in --rows of the square = step 1 and 2 
      concat [take d $ drop (d*mod i d) xs | xs<-rss] -- columns of the square = step 3 and 4

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


isValidSudoku :: [[Int]] -> Bool
isValidSudoku [] = False
isValidSudoku xss = 
  and [isValidSubsection $ selectRow xss n| n <- [0..length xss -1]]
  && and [isValidSubsection $ selectColumn xss n| n <- [0..length xss -1]]
  && and [isValidSubsection $ selectSquare xss n| n <- [0..length xss -1]]

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (j, k) x = 
  [xss!!r | r<-[0..j-1]] ++ [setInRow (xss!!j) k x] ++  [xss!!r | r<-[j+1..length xss -1]]

setInRow :: [Int] -> Int -> Int -> [Int]
setInRow xs k x = [xs!!i| i<-[0..k-1]]++[x]++[xs!!i| i<-[k+1..length xs -1]]

-- HA 3.1d)
{-WETT-}
solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss
      |null (posToFill xss) && isValidSudoku xss = xss
      |null (posToFill xss) = []
      |otherwise  = 
        let p = head $ posToFill xss in
        let sols = [s | s<-[setCell xss p i| i<-[1..length xss]], isValidSudoku s] in
        fromMaybe [] (find isValidSudoku $ nub $ map solveSudoku sols)

posToFill :: [[Int]] -> [(Int,Int)]
posToFill xss = [(x,y) | x<-[0..length xss- 1], y<-[0..length xss - 1], xss!!x!!y == 0]
{-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)