Return to Question

import qualified Data.Vector as V
data Board = Board (V.Vector (V.Vector Integer))
type Coordinates = (Int, Int)
instance Show Board where
 show (Board b)=unlines . V.toList $ V.map show b
fromList :: [[Integer]] -> Board
fromList l = Board $ V.fromList $ V.fromList <$> l
-- a few setters and getters
(!):: Board -> Coordinates -> Integer
(Board b) ! (i,j) = (b V.! j)V.! i
getColumn :: Board -> Coordinates -> [Integer]
getColumn b (i, _) = [b ! (i, j) | j<-[0..8]]
getRow :: Board -> (Int, Int) -> [Integer]
getRow b (_, j) = [b ! (i, j) | i<-[0..8]]
getSquare :: Board -> Coordinates -> [Integer]
getSquare b (i, j) = [b ! (i' + u, j' + v) | u<-[0..2],v<-[0..2]]
 where i' = i `div` 3
 j' = j `div` 3
insert :: Board -> Coordinates -> Integer -> Board
insert (Board b) (i, j) k = Board b'
 where v = b V.! j
 v' = v V.// [(i, k)]
 b' = b V.// [(j, v')]
 
-- check whether it is possible to insert candidate at given position
possible :: Board -> Coordinates -> Integer -> Bool
possible b coords@(i, j) k
 |i < 0 || i >= 9 || j < 0 || j >= 9 || k < 0 || k > 9 = undefined
 |b ! coords > 0 = False
 |k `elem` getRow b coords = False
 |k `elem` getColumn b coords = False
 |k `elem` getSquare b coords = False
 |otherwise = True
-- check whether board is already full
full :: Board -> Bool
full b = 0 `notElem` [b ! (i,j) | i<-[0..8], j<-[0..8]]
-- recursion to find all solutions to a given board
solve :: Board -> [Board]
solve b
 |full b = [b]
 |otherwise = concat[ solve (insert b (x, y) n)|
 x<-[0..8],
 y<-[0..8],
 n<-[1..9],
 possible b (x,y) n]
main = print $ solve b
-- normal sudoku
b :: Board
b = fromList [
 [5,3,0,0,7,0,0,0,0],
 [6,0,0,1,9,5,0,0,0],
 [0,9,8,0,0,0,0,6,0],
 [8,0,0,0,6,0,0,0,3],
 [4,0,0,8,0,3,0,0,1],
 [7,0,0,0,2,0,0,0,6],
 [0,6,0,0,0,0,2,8,0],
 [0,0,0,4,1,9,0,0,5],
 [0,0,0,0,8,0,0,7,9]
 ]
 
-- only one entry is missing
c :: Board
c = fromList [
 [0,3,8,2,9,4,5,6,1],
 [9,2,1,5,3,6,8,7,4],
 [4,5,6,7,8,1,9,2,3],
 [1,4,7,3,5,9,2,8,6],
 [2,8,3,6,1,7,4,5,9],
 [5,6,9,8,4,2,3,1,7],
 [6,7,4,9,2,5,1,3,8],
 [8,9,2,1,7,3,6,4,5],
 [3,1,5,4,6,8,7,9,2]]

Try it online!

--https://www.youtube.com/watch?v=G_UYXzGuqvM
import qualified Data.Vector as V
data Board = Board (V.Vector (V.Vector Integer))
type Coordinates = (Int, Int)
instance Show Board where
 show (Board b)=unlines . V.toList $ V.map show b
fromList :: [[Integer]] -> Board
fromList l = Board $ V.fromList $ V.fromList <$> l
-- a few setters and getters
(!):: Board -> Coordinates -> Integer
(Board b) ! (i,j) = (b V.! j)V.! i
getColumn :: Board -> Coordinates -> [Integer]
getColumn b (i, _) = [b ! (i, j) | j<-[0..8]]
getRow :: Board -> (Int, Int) -> [Integer]
getRow b (_, j) = [b ! (i, j) | i<-[0..8]]
getSquare :: Board -> Coordinates -> [Integer]
getSquare b (i, j) = [b ! (i'*3 + u, j'*3 + v) | u<-[0..2],v<-[0..2]]
 where i' = i `div` 3
 j' = j `div` 3
insert :: Board -> Coordinates -> Integer -> Board
insert (Board b) (i, j) k = Board b'
 where v = b V.! j
 v' = v V.// [(i, k)]
 b' = b V.// [(j, v')]
 
-- check whether it is possible to insert candidate at given position
possible :: Board -> Coordinates -> Integer -> Bool
possible b coords@(i, j) k
 |i < 0 || i >= 9 || j < 0 || j >= 9 || k < 0 || k > 9 = undefined
 |b ! coords > 0 = False
 |k `elem` getRow b coords = False
 |k `elem` getColumn b coords = False
 |k `elem` getSquare b coords = False
 |otherwise = True
-- check whether board is already full
full :: Board -> Bool
full b = 0 `notElem` [b ! (i,j) | i<-[0..8], j<-[0..8]]
-- recursion to find all solutions to a given board
solve :: Board -> [Board]
solve b
 |full b = [b]
 |otherwise = concat[ solve $! (insert b (x, y) n)|
 x<-[0..8],
 y<-[0..8],
 n<-[1..9],
 possible b (x,y) n]
main = print $ solve b
-- normal sudoku
b :: Board
b = fromList [
 [5,3,0,0,7,0,0,0,0],
 [6,0,0,1,9,5,0,0,0],
 [0,9,8,0,0,0,0,6,0],
 [8,0,0,0,6,0,0,0,3],
 [4,0,0,8,0,3,0,0,1],
 [7,0,0,0,2,0,0,0,6],
 [0,6,0,0,0,0,2,8,0],
 [0,0,0,4,1,9,0,0,5],
 [0,0,0,0,8,0,0,7,9]
 ]
 
-- only one a few entries are missing
c :: Board
c = fromList [
 [0,0,0,0,9,4,5,6,1],
 [9,2,1,5,3,6,8,7,4],
 [4,5,6,7,8,1,9,2,3],
 [1,4,7,3,5,9,2,8,6],
 [2,8,3,6,1,7,4,5,9],
 [5,6,9,8,4,2,3,1,7],
 [6,7,4,9,2,5,1,3,8],
 [8,9,2,1,7,3,6,4,5],
 [3,1,5,4,6,8,7,9,2]]

Try it online!

import qualified Data.Vector as V
data Board = Board (V.Vector (V.Vector Integer))
type Coordinates = (Int, Int)
instance Show Board where
 show (Board b)=unlines . V.toList $ V.map show b
fromList :: [[Integer]] -> Board
fromList l = Board $ V.fromList $ V.fromList <$> l
-- a few setters and getters
(!):: Board -> Coordinates -> Integer
(Board b) ! (i,j) = (b V.! j)V.! i
getColumn :: Board -> Coordinates -> [Integer]
getColumn b (i, _) = [b ! (i, j) | j<-[0..8]]
getRow :: Board -> (Int, Int) -> [Integer]
getRow b (_, j) = [b ! (i, j) | i<-[0..8]]
getSquare :: Board -> Coordinates -> [Integer]
getSquare b (i, j) = [b ! (i' + u, j' + v) | u<-[0..2],v<-[0..2]]
 where i' = i `div` 3
 j' = j `div` 3
insert :: Board -> Coordinates -> Integer -> Board
insert (Board b) (i, j) k = Board b'
 where v = b V.! j
 v' = v V.// [(i, k)]
 b' = b V.// [(j, v')]
-- check whether it is possible to insert candidate at given position
possible :: Board -> Coordinates -> Integer -> Bool
possible b coords@(i, j) k
 |i < 0 || i >= 9 || j < 0 || j >= 9 || k < 0 || k > 9 = undefined
 |b ! coords > 0 = False
 |k `elem` getRow b coords = False
 |k `elem` getColumn b coords = False
 |k `elem` getSquare b coords = False
 |otherwise = True
-- recursion to find all solutions to a given board
solve :: Board -> [Board]
solve b = concat[ solve (insert b (x, y) n)|x<-[0..8],y<-[0..8],n<-[1..9], possible b (x,y) n]
main = print $ solve b
b :: Board
b = fromList [
 [5,3,0,0,7,0,0,0,0],
 [6,0,0,1,9,5,0,0,0],
 [0,9,8,0,0,0,0,6,0],
 [8,0,0,0,6,0,0,0,3],
 [4,0,0,8,0,3,0,0,1],
 [7,0,0,0,2,0,0,0,6],
 [0,6,0,0,0,0,2,8,0],
 [0,0,0,4,1,9,0,0,5],
 [0,0,0,0,8,0,0,7,9]
 ]

Try it online!

import qualified Data.Vector as V
data Board = Board (V.Vector (V.Vector Integer))
type Coordinates = (Int, Int)
instance Show Board where
 show (Board b)=unlines . V.toList $ V.map show b
fromList :: [[Integer]] -> Board
fromList l = Board $ V.fromList $ V.fromList <$> l
-- a few setters and getters
(!):: Board -> Coordinates -> Integer
(Board b) ! (i,j) = (b V.! j)V.! i
getColumn :: Board -> Coordinates -> [Integer]
getColumn b (i, _) = [b ! (i, j) | j<-[0..8]]
getRow :: Board -> (Int, Int) -> [Integer]
getRow b (_, j) = [b ! (i, j) | i<-[0..8]]
getSquare :: Board -> Coordinates -> [Integer]
getSquare b (i, j) = [b ! (i' + u, j' + v) | u<-[0..2],v<-[0..2]]
 where i' = i `div` 3
 j' = j `div` 3
insert :: Board -> Coordinates -> Integer -> Board
insert (Board b) (i, j) k = Board b'
 where v = b V.! j
 v' = v V.// [(i, k)]
 b' = b V.// [(j, v')]

-- check whether it is possible to insert candidate at given position
possible :: Board -> Coordinates -> Integer -> Bool
possible b coords@(i, j) k
 |i < 0 || i >= 9 || j < 0 || j >= 9 || k < 0 || k > 9 = undefined
 |b ! coords > 0 = False
 |k `elem` getRow b coords = False
 |k `elem` getColumn b coords = False
 |k `elem` getSquare b coords = False
 |otherwise = True
-- check whether board is already full
full :: Board -> Bool
full b = 0 `notElem` [b ! (i,j) | i<-[0..8], j<-[0..8]]
-- recursion to find all solutions to a given board
solve :: Board -> [Board]
solve b
 |full b = [b]
 |otherwise = concat[ solve (insert b (x, y) n)|
 x<-[0..8],y<-[0..8],n<-[1..9], possible b (x,y) n]
main = print $ solve b
-- normal sudoku
b :: Board
b = fromList [
 [5,3,0,0,7,0,0,0,0],
 [6,0,0,1,9,5,0,0,0],
 [0,9,8,0,0,0,0,6,0],
 [8,0,0,0,6,0,0,0,3],
 [4,0,0,8,0,3,0,0,1],
 [7,0,0,0,2,0,0,0,6],
 [0,6,0,0,0,0,2,8,0],
 [0,0,0,4,1,9,0,0,5],
 [0,0,0,0,8,0,0,7,9]
 ]
-- only one entry is missing
c :: Board
c = fromList [
 [0,3,8,2,9,4,5,6,1],
 [9,2,1,5,3,6,8,7,4],
 [4,5,6,7,8,1,9,2,3],
 [1,4,7,3,5,9,2,8,6],
 [2,8,3,6,1,7,4,5,9],
 [5,6,9,8,4,2,3,1,7],
 [6,7,4,9,2,5,1,3,8],
 [8,9,2,1,7,3,6,4,5],
 [3,1,5,4,6,8,7,9,2]]

Try it online!

Try it online!]TIO-k7iw2jpg

Try it online!