sudoku solver haskell first itteration
This commit is contained in:
parent
dd2643ce3a
commit
0b0a55516f
61
src/sudoku-hs/flake.lock
generated
Normal file
61
src/sudoku-hs/flake.lock
generated
Normal 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
26
src/sudoku-hs/flake.nix
Normal 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
88
src/sudoku-hs/src/Main.hs
Normal 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>"
|
||||
13
src/sudoku-hs/sudoku-solver.cabal
Normal file
13
src/sudoku-hs/sudoku-solver.cabal
Normal 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
|
||||
Loading…
x
Reference in New Issue
Block a user