module Exercise03 where

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

-- 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 = 
  let offset = intRoot $ length xss
      xOff = i `div` offset * offset
      yOff = i `mod` offset * offset
  in  [xss !! (xOff + a) !! (yOff + b) | a <- [0..offset-1], b <- [0..offset-1]]


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

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

-- HA 3.1c)
setCell :: [[Int]] -> (Int,Int) -> Int -> [[Int]]
setCell xss (x, y) n = [if row /= x then xss !! row else [if col /= y then xss !! row !! col else n | col <- [0..length xss - 1]] | row <- [0..length xss - 1]] 


-- HA 3.1d)
{-WETT-}

solveSudoku :: [[Int]] -> [[Int]]
solveSudoku xss = 
  let cs = [(x, y) | x <- hs, y <- hs]
      hs = [0..length xss - 1]
  in  if isValidSudoku xss then decider (xss, setUpOptions xss cs) cs else []

setUpOptions :: [[Int]] -> [(Int, Int)] -> [((Int, Int), [Int])]
setUpOptions xss cs =
  let os = [1..length xss]
      update es [] = es 
      update es (p:xs) = update (updateOptions (xss, es) p) xs
  in  sortOn (length . snd) $ update [((x, y), os) | (x, y) <- cs, xss !! x !! y == 0] [(x, y) | (x, y) <- cs, xss !! x !! y > 0]

-- decides weather or not to continue this path
decider :: ([[Int]], [((Int, Int), [Int])]) -> [(Int, Int)] -> [[Int]]
decider (xss, es) cs
  | null es = xss                               -- solved
  | null (snd $ head es) = []                   -- invalid
  | otherwise = nextStep (xss, es) cs           -- valid but unsolved

-- expects valid but unsolved input
nextStep :: ([[Int]], [((Int, Int), [Int])]) -> [(Int, Int)] -> [[Int]]
nextStep (xss, es) cs
  | null obvEs = obvXss                         -- found solution
  | null (snd $ head obvEs) = []                -- deemed invalid
  | otherwise = if null next then decider (obvXss, deleteOption obvEs) cs else next
    where 
      (obvXss, obvEs) = fillObvious (xss, es) cs     -- fills every field with exactly one possible option
      next = decider (setPos (obvXss, obvEs)) cs     -- try choosing the first option for the first empty field

setPos :: ([[Int]], [((Int, Int), [Int])]) -> ([[Int]], [((Int, Int), [Int])])
setPos (xss, ((x, y), os) : es) = 
  let newXss = take x xss ++ setWithinRow (xss !! x) : drop (x + 1) xss
      setWithinRow xs = take y xs ++ head os : drop (y + 1) xs
  in  (newXss, sortOn (length . snd) $ updateOptions (newXss, es) (x, y))

updateOptions :: ([[Int]], [((Int, Int), [Int])]) -> (Int, Int) -> [((Int, Int), [Int])]
updateOptions (xss, es) (x, y) = 
  let n = xss !! x !! y
      offset = intRoot $ length xss
      xOff = x `div` offset
      yOff = y `div` offset
  in  [if a == x || b == y || (a `div` offset == xOff && b `div` offset == yOff) then ((a, b), delete n os) else ((a, b), os) | ((a, b), os) <- es]

deleteOption :: [((Int, Int), [Int])] -> [((Int, Int), [Int])]
deleteOption ((p, _:os) : es) = (p, os) : es

fillObvious :: ([[Int]], [((Int, Int), [Int])]) -> [(Int, Int)] -> ([[Int]], [((Int, Int), [Int])])
fillObvious (xss, es) cs
  | null es || length (snd $ head es) /= 1 = (xss, es)
  | otherwise = fillObvious (setPos (xss, es)) cs

{-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)
-- Variable not in scope: sudoku :: [[Int]]
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 _ [] = []
    chunksOf i ls = take i ls : chunksOf i (drop i ls)