module Exercise03 where

import Text.Printf (printf)
import Data.List (intercalate, transpose, nub, deleteBy)
import qualified Data.Char

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

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = transpose xss !! i

-- 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 =  [xss !! r !! c|r<-[0..length xss-1], c<- [0.. length xss-1], r>=fR, r<fR+l, c>=fC, c<fC+l]
      where l = intRoot (length xss) --length of the square
            fR = i `div` l * l   --position of the first row
            fC = i `mod` l * l   --position of the first column 



-- HA 3.1b)
isValidSubsection :: [Int] -> Bool
isValidSubsection xs= nub (filter(/=0) xs) == filter(/=0) xs && minimum xs >= 0 && maximum xs <= length xs

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = and $ concat [[isValidSubsection $ selectRow xss tmp| tmp<-i],[isValidSubsection $ selectColumn xss tmp| tmp<-i],
                                 [isValidSubsection $ selectSquare xss tmp| tmp<-i]] 
      where i = [0..length xss -1]

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (r, c) x = take r xss ++
  [take c (xss !! r) ++ [x] ++ drop (c + 1) (xss !! r)] ++
  drop (r + 1) xss

-- HA 3.1d)
{-WETT-}
-- I did have a look at one solution on the internet, which inspired me a way of building my solutionAt function
-- https://gist.github.com/wvandyk/3638996
-- Removes the elements in the second list from the first list
remove' :: [Int] -> [Int] -> [Int]
remove' [] _       = []
remove' xs []      = xs
remove' xs (y:ys)  = remove' (removeAll y xs) ys

-- Remove all occurences of a value in a list
removeAll :: Int -> [Int] -> [Int]
removeAll _ []     = []
removeAll y (x:xs) | x == y    = removeAll y xs
                   | otherwise = x : removeAll y xs
position :: [[Int]] -> (Int,Int) ->Int
position xss (i,j) = (i `div` l )* l + j `div` l 
            where l=intRoot $ length xss                    
-- all functions from above is used to help build this "solutionAt" function
-- The list of solutions at the index (i,j) 
solutionsAt :: (Int,Int) -> [[Int]] -> [Int]
solutionsAt (i,j) xss 
                  | i > length xss || j > length xss  = []
                  | (xss !! i!!j) == 0                = [1..length xss] `remove'` (selectColumn xss j ++ selectRow xss i ++ (selectSquare xss (position xss (i,j))))
                  | otherwise                         = [xss !! i!!j]


nextBlank :: (Int,Int) -> [[Int]] -> (Int,Int)
nextBlank (i,j) xss 
      | i==length xss -1&&j==length xss -1=(i,j)
      | j==length xss && i <length xss -1 =nextBlank (i+1,0) xss
      | xss !! i !! j ==0 = (i,j)
      | otherwise = nextBlank (i,j+1) xss

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss  
  | not(isValidSudoku xss) =[]
  | otherwise=  solve xss (0,0) (solutionsAt (0,0) xss)


--it gives a current edition of the matrix xss, a position to be determined (i,j), 
--and a cooresponding list which contains possible solutions possilities
solve :: [[Int]]->(Int,Int)->[Int]->[[Int]]
solve xss (_,_) [] = []
solve xss (i,j) (possibility:possiblities) 
    -- if reach the end and the possibilities left isn't one, it would not be a successful attempt
    | i==length xss -1 && j ==length xss-1 && not(null possiblities) = []
    | i==length xss -1 && j == length xss -1 && null possiblities  = setCell xss (i,j) possibility
    -- recursion starts here, as it has the function to filter the first possibility if it does not contain a valid solvedNext
    | solvedNext == [] = solve xss (i,j) possiblities
    | otherwise = solvedNext
    -- solveNext always find the nextBlank position and keep going down until reaching the last index and return a valid solution or do the recursion
    where solveNext xss (i,j) = solve xss (nextBlank (i,j) xss) (solutionsAt (nextBlank (i,j) xss) xss) 
          solvedNext = solveNext (setCell xss (i,j) possibility) (i,j) 







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