module Exercise03 where

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

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

-- HA 3.1a) ii
selectColumn :: [[Int]] -> Int -> [Int]
selectColumn xss i = [r!!i | r <- 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 =  [(xss!!k)!!j | k <- [row(i)..row(i)+n-1], j <- [col(i)..col(i)+n-1]]
    where
    n = (intRoot $ length xss)
    row i = i - (mod i n)
    col i = (mod i n) * n
    

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

isValidSudoku :: [[Int]] -> Bool
isValidSudoku xss = all (isValidSubsection) [f xss i | i <- [0..(length xss)-1], f <- [selectRow, selectColumn, selectSquare]]

-- HA 3.1c)
setCell :: [[Int]] -> (Int, Int) -> Int -> [[Int]]
setCell xss (j, k) x = a ++ pure (aa ++ pure x ++ bb) ++ b
  where
  (a, (c:b)) = splitAt j xss
  (aa, (cc:bb)) = splitAt k c 

-- HA 3.1d)

{-WETT-}

type Zipper a = ([a],[a])
type DoubleZipper a = Zipper (Zipper a)
type Coor = (Int, Int)
type Sudoku = [[Int]]
type Mod = (Coor, Int, Int)

reset :: Zipper a -> Zipper a
reset zip = moveTo zip 0


-- optimize
contentOf :: Zipper a -> [a]
contentOf zip = fst $ reset zip

dContentOf :: DoubleZipper a -> [[a]]
dContentOf zip = map contentOf (contentOf zip)

zippy :: [a] -> Zipper a
zippy xss = (xss, [])

doubleZippy :: [[a]] -> DoubleZipper a
doubleZippy xss = zippy (map zippy xss)

goForward :: Zipper a -> Zipper a  
goForward (x:xs, bs) = (xs, x:bs)  
      
goBack :: Zipper a -> Zipper a  
goBack (xs, b:bs) = (b:xs, bs)

getHead :: Zipper a -> a
getHead (x:xs, bs) = x

getPos :: Zipper a -> Int
getPos (xs, bs) = length bs

getCoor :: DoubleZipper a -> Coor
getCoor ([], bs) = (length bs, -1)
getCoor (x:xs, bs) = (length bs, getPos x)

moveTo :: Zipper a -> Int -> Zipper a
moveTo (a, b) i
  | i > n = moveTo (goForward (a, b)) i 
  | i < n = moveTo (goBack (a, b)) i
  | i == n = (a, b)
  where
  n :: Int
  n = length b

dMoveTo :: DoubleZipper a -> Coor -> DoubleZipper a
dMoveTo dzip (i, j) =
  let (y:ys, c) = moveTo dzip i
  in ((moveTo y j):ys, c)

dGoForward :: DoubleZipper a -> DoubleZipper a
dGoForward (([], cs):xss, bs) = (xss, ([], cs):bs)
dGoForward ((x:xs, cs):xss, bs) = ((xs, x:cs):xss, bs)
dGoForward ([], bs) = ([], bs)
  
dModify :: (a -> a) -> DoubleZipper a -> Coor -> DoubleZipper a
dModify f dzip (i, j) =
  let (y:ys, c) = dMoveTo dzip (i, j)
  in ((modify f y):ys, c)

modify :: (a -> a) -> Zipper a -> Zipper a
modify f (x:xs, bs) = (f(x):xs, bs)

remove :: Int -> Zipper a -> Zipper a
remove y zip =
  let (x:xs, c) = moveTo zip y
  in (xs, c)
  
isEmpty :: Zipper a -> Bool
isEmpty (xs, bs) = null xs

getVV :: Sudoku -> Coor -> [Int]
getVV xss (x, y) = filter (\z -> not $ elem z influence) [1..n]
  where
    n :: Int
    n = length xss
    sqrtN :: Int
    sqrtN = intRoot n
    influence :: [Int]
    influence = nub ((selectRow xss x) ++ (selectColumn xss y) ++ (selectSquare xss (x - (mod x sqrtN) + (div y sqrtN))))

dFindFirst :: (a -> Bool) -> DoubleZipper a -> DoubleZipper a
dFindFirst _ ([], xs) = ([], xs)
dFindFirst p ((x:xs, cd):xss, bs) = if p x then ((x:xs, cd):xss, bs) else dFindFirst p (dGoForward ((x:xs, cd):xss, bs))
dFindFirst p xss = dFindFirst p (dGoForward xss) 

nextBlank :: DoubleZipper Int -> DoubleZipper Int
nextBlank dzip = dFindFirst (\x -> x == 0) dzip

solveSudoku :: Sudoku -> Sudoku
solveSudoku xss = if not(isValidSudoku xss) then [] else dContentOf (ssolveSudoku (doubleZippy xss)) 

ssolveSudoku :: DoubleZipper Int -> DoubleZipper Int
ssolveSudoku xss = if isEmpty nB then xss else processVV (zippy (getVV (dContentOf xss) c))
  where
    nB = nextBlank xss
    c = getCoor nB
    processVV :: Zipper Int -> DoubleZipper Int
    processVV vv
      | isEmpty(vv) = doubleZippy []
      | otherwise = if not(null(flatS)) && isValidSudoku (flatS) then sudoku else processVV (goForward(vv))
        where
          sudoku = ssolveSudoku (dModify (\x -> getHead(vv)) xss c)
          flatS = dContentOf sudoku

{-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)
    
test :: [[Int]]
test = [[1,0,0,0],
        [0,0,3,1],
        [0,2,0,0],
        [0,1,0,0]]