Compare commits
3 Commits
main
..
d04c6c6e26
| Author | SHA1 | Date | |
|---|---|---|---|
| d04c6c6e26 | |||
| e5699025ba | |||
| d5a64d7596 |
@@ -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
|
||||||
@@ -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,4 +1,4 @@
|
|||||||
# Estinien
|
# Estinen
|
||||||
|
|
||||||
Sudoku solver written in haskell
|
Sudoku solver written in haskell
|
||||||
|
|
||||||
|
|||||||
+1
-1
@@ -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"
|
||||||
|
|||||||
@@ -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
|
|
||||||
@@ -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;
|
||||||
});
|
});
|
||||||
|
|||||||
@@ -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
|
|
||||||
@@ -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
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user