sudoku solver haskell first itteration

This commit is contained in:
Danilo Reyes 2025-04-02 21:44:39 -06:00
parent dd2643ce3a
commit 0b0a55516f
4 changed files with 188 additions and 0 deletions

61
src/sudoku-hs/flake.lock generated Normal file
View File

@ -0,0 +1,61 @@
{
"nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1731533236,
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1743576891,
"narHash": "sha256-vXiKURtntURybE6FMNFAVpRPr8+e8KoLPrYs9TGuAKc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "44a69ed688786e98a101f02b712c313f1ade37ab",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixos-24.11",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs"
}
},
"systems": {
"locked": {
"lastModified": 1681028828,
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
"owner": "nix-systems",
"repo": "default",
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
"type": "github"
},
"original": {
"owner": "nix-systems",
"repo": "default",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

26
src/sudoku-hs/flake.nix Normal file
View File

@ -0,0 +1,26 @@
{
description = "A Haskell Sudoku solver using CSV input";
inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixos-24.11";
inputs.flake-utils.url = "github:numtide/flake-utils";
outputs =
{
self,
nixpkgs,
flake-utils,
}:
flake-utils.lib.eachDefaultSystem (
system:
let
pkgs = import nixpkgs { inherit system; };
hsPkgs = pkgs.haskellPackages;
in
{
packages.default = hsPkgs.callCabal2nix "sudoku-solver" ./. { };
apps.default = {
type = "app";
program = "${self.packages.${system}.default}/bin/sudoku-solver";
};
}
);
}

88
src/sudoku-hs/src/Main.hs Normal file
View File

@ -0,0 +1,88 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Char (isSpace)
import Data.List (transpose, dropWhileEnd)
import Data.Maybe (isNothing, listToMaybe)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Vector as V
import qualified Data.Csv as CSV
import System.Environment (getArgs)
import Text.Read (readMaybe)
type Cell = Maybe Int
type Grid = [[Cell]]
parseCell :: String -> Cell
parseCell s = readMaybe (trim s)
where trim = dropWhileEnd isSpace . dropWhile isSpace
readCSV :: FilePath -> IO Grid
readCSV path = do
csvData <- BL.readFile path
case CSV.decode CSV.NoHeader csvData of
Left err -> error ("CSV parse error: " ++ err)
Right v -> return $ map (map (parseCell . trimQuotes) . V.toList) (V.toList v)
where trimQuotes = filter (/= '"')
printGrid :: Grid -> IO ()
printGrid = putStrLn . unlines . map (unwords . map showCell)
where showCell = maybe "." show
solve :: Grid -> Maybe Grid
solve grid = solve' grid
solve' :: Grid -> Maybe Grid
solve' g = case findEmpty g of
Nothing -> Just g
Just (r, c) ->
listToMaybe [ g'
| n <- [1..9]
, isSafe g r c n
, let g' = updateGrid g r c (Just n)
, Just _ <- [solve' g'] ]
findEmpty :: Grid -> Maybe (Int, Int)
findEmpty g = listToMaybe
[ (r, c)
| (r, row) <- zip [0..] g
, (c, cell) <- zip [0..] row
, isNothing cell ]
isSafe :: Grid -> Int -> Int -> Int -> Bool
isSafe g r c n =
notElem (Just n) (getRow r g) &&
notElem (Just n) (getCol c g) &&
notElem (Just n) (getBox r c g)
getRow :: Int -> Grid -> [Cell]
getRow r g = g !! r
getCol :: Int -> Grid -> [Cell]
getCol c g = map (!! c) g
getBox :: Int -> Int -> Grid -> [Cell]
getBox r c g =
[ g !! r' !! c'
| r' <- brange, c' <- crange ]
where
brange = let b = r - r `mod` 3 in [b..b+2]
crange = let b = c - c `mod` 3 in [b..b+2]
updateGrid :: Grid -> Int -> Int -> Cell -> Grid
updateGrid g r c val =
take r g ++
[take c (g !! r) ++ [val] ++ drop (c + 1) (g !! r)] ++
drop (r + 1) g
main :: IO ()
main = do
args <- getArgs
case args of
[filePath] -> do
grid <- readCSV filePath
case solve grid of
Nothing -> putStrLn "No solution found."
Just g -> printGrid g
_ -> putStrLn "Usage: sudoku-solver <sudoku.csv>"

View File

@ -0,0 +1,13 @@
cabal-version: >=1.10
name: sudoku-solver
version: 0.1.0.0
build-type: Simple
executable sudoku-solver
main-is: Main.hs
hs-source-dirs: src
build-depends: base >=4.12 && <5,
bytestring,
cassava,
vector
default-language: Haskell2010