Compare commits

..

3 Commits

Author SHA1 Message Date
pingu d04c6c6e26 A bit 2025-10-08 13:00:32 +02:00
pingu e5699025ba Cabal init 2025-10-08 10:07:00 +02:00
pingu d5a64d7596 Initial commit 2025-10-08 07:52:25 +00:00
10 changed files with 33 additions and 133 deletions
+7 -10
View File
@@ -6,12 +6,12 @@ cabal-version: 3.4
-- Starting from the specification version 2.2, the cabal-version field must be -- Starting from the specification version 2.2, the cabal-version field must be
-- the first thing in the cabal file. -- the first thing in the cabal file.
-- Initial package description 'Estinien' generated by -- Initial package description 'Estinen' generated by
-- 'cabal init'. For further documentation, see: -- 'cabal init'. For further documentation, see:
-- http://haskell.org/cabal/users-guide/ -- http://haskell.org/cabal/users-guide/
-- --
-- The name of the package. -- The name of the package.
name: Estinien name: Estinen
-- The package version. -- The package version.
-- See the Haskell package versioning policy (PVP) for standards -- See the Haskell package versioning policy (PVP) for standards
@@ -50,14 +50,12 @@ extra-doc-files: CHANGELOG.md
-- Extra source files to be distributed with the package, such as examples, or a tutorial module. -- Extra source files to be distributed with the package, such as examples, or a tutorial module.
-- extra-source-files: -- extra-source-files:
common default common warnings
ghc-options: -Wall ghc-options: -Wall
-threaded
-rtsopts
library library
-- Import common warning flags. -- Import common warning flags.
import: default import: warnings
-- Modules exported by the library. -- Modules exported by the library.
exposed-modules: Sudoku exposed-modules: Sudoku
@@ -73,7 +71,6 @@ library
, matrix , matrix
, vector , vector
, parallel , parallel
, deepseq
-- Directories containing source files. -- Directories containing source files.
hs-source-dirs: src hs-source-dirs: src
@@ -81,9 +78,9 @@ library
-- Base language which the package is written in. -- Base language which the package is written in.
default-language: GHC2024 default-language: GHC2024
executable Estinien executable Estinen
-- Import common warning flags. -- Import common warning flags.
import: default import: warnings
-- .hs or .lhs file containing the Main module. -- .hs or .lhs file containing the Main module.
main-is: Main.hs main-is: Main.hs
@@ -97,7 +94,7 @@ executable Estinien
-- Other library packages from which modules are imported. -- Other library packages from which modules are imported.
build-depends: build-depends:
base >=4.19.2.0, base >=4.19.2.0,
Estinien Estinen
-- Directories containing source files. -- Directories containing source files.
hs-source-dirs: app hs-source-dirs: app
+1 -1
View File
@@ -219,7 +219,7 @@ If you develop a new program, and you want it to be of the greatest possible use
To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found.
Estinien Estinen
Copyright (C) 2025 pingu Copyright (C) 2025 pingu
This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+1 -1
View File
@@ -1,4 +1,4 @@
# Estinien # Estinen
Sudoku solver written in haskell Sudoku solver written in haskell
+1 -1
View File
@@ -7,5 +7,5 @@ import System.Environment (getArgs)
main :: IO () main :: IO ()
main = getArgs >>= \case main = getArgs >>= \case
[filename] -> readFile filename >>= print . solve . parseStringToGrid [filename] -> readFile filename >>= print . parseStringToGrid
_ -> error "Usage: Estinen filename" _ -> error "Usage: Estinen filename"
-9
View File
@@ -1,9 +0,0 @@
X X 3 1 6 5 7 9 8
6 1 9 X X X 2 4 5
5 8 7 X 4 X 1 X 6
4 X 6 X 1 2 9 8 3
X 9 X 8 X 4 6 X 2
X X X 6 X 3 4 X 1
9 X 2 5 X 7 8 X X
8 X X 4 2 1 3 X 9
1 X X X X 6 5 2 7
+6 -6
View File
@@ -1,5 +1,5 @@
{ {
description = "Estinien goes flakes"; description = "Estinen goes flakes";
inputs = { inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
@@ -34,12 +34,12 @@
in in
{ {
packages = rec { packages = rec {
default = estinien; default = estinen;
estinien = pkgs.haskell.packages.${ghcVer}.estinien; estinen = pkgs.haskell.packages.${ghcVer}.estinen;
}; };
checks = { checks = {
inherit (self.packages.${system}) estinien; inherit (self.packages.${system}) estinen;
}; };
# for debugging # for debugging
@@ -49,7 +49,7 @@
let haskellPackages = pkgs.haskell.packages.${ghcVer}; let haskellPackages = pkgs.haskell.packages.${ghcVer};
in in
haskellPackages.shellFor { haskellPackages.shellFor {
packages = p: [ self.packages.${system}.estinien ]; packages = p: [ self.packages.${system}.estinen ];
withHoogle = true; withHoogle = true;
buildInputs = buildInputs =
(with pkgs; [ (with pkgs; [
@@ -70,7 +70,7 @@
default = makeHaskellOverlay (prev: hfinal: hprev: default = makeHaskellOverlay (prev: hfinal: hprev:
let hlib = prev.haskell.lib; in let hlib = prev.haskell.lib; in
{ {
estinien = hprev.callCabal2nix "estinien" ./. { }; estinen = hprev.callCabal2nix "estinen" ./. { };
rando = hlib.dontCheck hprev.rando; rando = hlib.dontCheck hprev.rando;
}); });
-9
View File
@@ -1,9 +0,0 @@
X 7 3 X X X X X 8
X 5 4 X 3 X X X X
2 8 X X 9 X X X X
X X X 5 6 X 4 X X
X X X X X 4 7 X X
X 6 X 8 X X 9 X X
X 3 X X 8 X X X 2
X 9 X X 5 3 X X X
X 4 X X 7 1 X 9 X
-9
View File
@@ -1,9 +0,0 @@
1 2 3 4 5 6 7 8 9
4 5 6 7 8 9 1 2 3
7 8 9 1 2 3 4 5 6
2 3 4 5 6 7 8 9 1
5 6 7 8 9 1 2 3 4
8 9 1 2 3 4 5 6 7
6 7 8 9 1 2 3 4 5
9 1 2 3 4 5 6 7 8
3 4 5 6 7 8 9 1 2
+8 -78
View File
@@ -1,27 +1,19 @@
{-# LANGUAGE OverloadedStrings, LambdaCase, MultiWayIf #-} {-# LANGUAGE OverloadedStrings, LambdaCase, MultiWayIf #-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module Sudoku ( isValid module Sudoku ( isValid
, Cell(..) , Cell(..)
, Grid(..) , Grid(..)
, updateCell , updateCell
, emptyGrid , emptyGrid
, parseStringToGrid , parseStringToGrid
, solve
, getSquare
) where ) where
import Data.Matrix hiding (getRow, getCol, trace) import Data.Matrix hiding (getRow, getCol)
import Data.Matrix qualified as M import Data.Matrix qualified as M
import Data.Vector (Vector) import Data.Vector (Vector)
import Data.Vector qualified as V import Data.Vector qualified as V
import Data.Coerce import Data.Coerce
import Control.Parallel import Control.Parallel
import Control.Parallel.Strategies import Control.Parallel.Strategies
import Text.Printf
import Data.List
import Control.Monad
import Control.DeepSeq
import GHC.Generics (Generic)
data Cell where data Cell where
One :: Cell One :: Cell
@@ -34,7 +26,7 @@ data Cell where
Eight :: Cell Eight :: Cell
Nine :: Cell Nine :: Cell
Unknown :: Cell Unknown :: Cell
deriving (Eq, Generic, NFData) deriving (Eq)
instance Show Cell where instance Show Cell where
show One = "1" show One = "1"
@@ -46,7 +38,7 @@ instance Show Cell where
show Seven = "7" show Seven = "7"
show Eight = "8" show Eight = "8"
show Nine = "9" show Nine = "9"
show Unknown = "_" show Unknown = " "
cellFromChar :: String -> Cell cellFromChar :: String -> Cell
cellFromChar "1" = One cellFromChar "1" = One
@@ -68,16 +60,12 @@ newtype Column = Column (Vector Cell)
newtype Row = Row (Vector Cell) newtype Row = Row (Vector Cell)
-- Square is 3x3 -- Square is 3x3
newtype Square = Square (Matrix Cell) newtype Square = Square (Matrix Cell)
instance Show Square where
show (Square m) = prettyMatrix m
-- Grid is 9x9 -- Grid is 9x9
newtype Grid = Grid (Matrix Cell) newtype Grid = Grid (Matrix Cell)
deriving (Eq, Generic, NFData)
instance Show Grid where instance Show Grid where
show (Grid m) = prettyMatrix m show (Grid m) = prettyMatrix m
emptyGrid :: Grid emptyGrid :: Grid
emptyGrid = coerce $ matrix 9 9 (const Unknown) emptyGrid = coerce $ matrix 9 9 (const Unknown)
@@ -94,9 +82,6 @@ parseStringToGrid str =
isValidVector :: Vector Cell -> Bool isValidVector :: Vector Cell -> Bool
isValidVector = V.all (<= 1) . (numbers >>=) . (((pure . V.length) .) . (. (==)) . flip V.filter) isValidVector = V.all (<= 1) . (numbers >>=) . (((pure . V.length) .) . (. (==)) . flip V.filter)
hasNoUnknownVector :: Vector Cell -> Bool
hasNoUnknownVector = V.all (/= Unknown)
isValidColumn :: Column -> Bool isValidColumn :: Column -> Bool
isValidColumn = isValidVector . coerce isValidColumn = isValidVector . coerce
@@ -106,23 +91,11 @@ isValidRow = isValidVector . coerce
isValidSquare :: Square -> Bool isValidSquare :: Square -> Bool
isValidSquare = isValidVector . getMatrixAsVector . coerce isValidSquare = isValidVector . getMatrixAsVector . coerce
hasNoUnknownColumn :: Column -> Bool
hasNoUnknownColumn = hasNoUnknownVector . coerce
hasNoUnknownRow :: Row -> Bool
hasNoUnknownRow = hasNoUnknownVector . coerce
hasNoUnknownSquare :: Square -> Bool
hasNoUnknownSquare = hasNoUnknownVector . getMatrixAsVector . coerce
getRow :: Int -> Grid -> Row getRow :: Int -> Grid -> Row
getRow n getRow n
| n > 0 && n <= 9 = Row . M.getRow n . coerce | n > 0 && n <= 9 = Row . M.getRow n . coerce
| otherwise = error "Indexing row outside of grid" | otherwise = error "Indexing row outside of grid"
getRows :: Grid -> [Row]
getRows = (getRow <$> [1..9] <*>) . pure
getColumn :: Int -> Grid -> Column getColumn :: Int -> Grid -> Column
getColumn n getColumn n
| n > 0 && n <= 9 = Column . M.getCol n . coerce | n > 0 && n <= 9 = Column . M.getCol n . coerce
@@ -130,29 +103,20 @@ getColumn n
getSquare :: Int -> Grid -> Square getSquare :: Int -> Grid -> Square
getSquare n getSquare n
| n > 0 && n <= 9 = let !sr = ((n-1) `div` 3) * 3 + 1 | n > 0 && n <= 9 = let !sr = (n+2) `div` 3
!er = sr + 2 !er = sr + 2
!sc = ((n-1) `mod` 3) * 3 + 1 !sc = (n+2) `mod` 3 + 1
!ec = sc + 2 !ec = sc + 2
in Square . submatrix sr er sc ec . coerce in Square . submatrix sr er sc ec . coerce
| otherwise = error "Indexing square outside of grid" | otherwise = error "Indexing square outside of grid"
isValid :: Grid -> Bool isValid :: Grid -> Bool
isValid g = and $ flip map [1..9] isValid g = and $ flip (parMap rpar) [1..9]
(\i -> (\i ->
let row = isValidRow (getRow i g) let row = isValidRow (getRow i g)
col = isValidColumn (getColumn i g) col = isValidColumn (getColumn i g)
square = isValidSquare (getSquare i g) square = isValidSquare (getSquare i g)
in row && col && square in col `par` square `par` row && col && square
)
hasNoUnknown :: Grid -> Bool
hasNoUnknown g = and $ flip map [1..9]
(\i ->
let row = hasNoUnknownRow (getRow i g)
col = hasNoUnknownColumn (getColumn i g)
square = hasNoUnknownSquare (getSquare i g)
in row && col && square
) )
updateCell :: Int -> Int -> Cell -> Grid -> Grid updateCell :: Int -> Int -> Cell -> Grid -> Grid
@@ -163,39 +127,5 @@ updateCell n m
coerce $ setElem c (n,m) mx else coerce $ setElem c (n,m) mx else
error "Updating non unkown value" error "Updating non unkown value"
| otherwise = error "Updating cell outside of grid" | otherwise = error "Updating cell outside of grid"
leftToPlace :: Grid -> [Cell]
leftToPlace =
V.toList .
(\v -> numbers >>= \i -> flip V.replicate i . (9-) . V.length $ V.elemIndices i v) .
getMatrixAsVector .
coerce
leftToPlaceRow :: Row -> [Cell]
leftToPlaceRow =
((V.toList numbers) \\ ) .
V.toList .
coerce
findEmptyRow :: Row -> [(Int)]
findEmptyRow = V.toList . ((+1) <$>) . V.findIndices (== Unknown) . coerce
findEmpty :: Grid -> [(Int,Int)]
findEmpty = V.toList . ((\n -> ((n) `div` 9 + 1, n `mod` 9 + 1)) <$>) . V.findIndices (== Unknown) . getMatrixAsVector . coerce
place :: Cell -> (Int,Int) -> Grid -> Grid
place c pos g = coerce $ setElem c pos (coerce g)
solve :: Grid -> Grid
solve = runEval . go . pure
where go :: [Grid] -> Eval Grid
go gs =
case filter hasNoUnknown gs of
[] ->
parList rpar (gs >>= \g -> zip [(1 :: Int)..9] (getRows g) >>= \(i,v) -> findEmptyRow v >>= \j -> leftToPlaceRow v >>= pure . (i,j,,g)) >>=
parList rdeepseq . (>>= \(i,j,c,g) -> pure $ place c (i,j) g) >>=
filterM (pure . isValid) >>= \case
[] -> error "Uhoh"
xs -> go xs
(x:_) -> () `pseq` pure x
+9 -9
View File
@@ -1,9 +1,9 @@
1 2 3 4 5 X 7 8 9 1 2 3 4 5 6 X 8 9
4 5 6 7 X 9 1 2 3 2 X 4 5 6 X 8 X 1
7 8 X 1 2 X 4 5 6 3 4 5 X 7 8 9 1 2
2 X 4 5 6 7 X 9 1 4 5 6 7 8 X 1 2 3
5 6 X 8 9 X 2 3 4 5 X X 8 9 1 2 3 4
8 9 X 2 X 4 5 6 7 6 7 8 9 X 2 3 X X
6 7 X 9 1 2 X 4 5 7 X 9 1 2 3 X X X
9 X 2 3 4 5 X X 8 8 9 1 X 3 4 5 6 X
3 4 5 6 7 8 X 1 2 9 1 2 3 4 5 6 7 8