a start mainly to share
This commit is contained in:
parent
7a71ac5d09
commit
1b98cb32a1
9 changed files with 375 additions and 0 deletions
5
CHANGELOG.md
Normal file
5
CHANGELOG.md
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
# Revision history for graphSat
|
||||||
|
|
||||||
|
## 0.1.0.0 -- YYYY-mm-dd
|
||||||
|
|
||||||
|
* First version. Released on an unsuspecting world.
|
8
app/Main.hs
Normal file
8
app/Main.hs
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import qualified MyLib (someFunc)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
putStrLn "Hello, Haskell!"
|
||||||
|
MyLib.someFunc
|
2
default.nix
Normal file
2
default.nix
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
{ pkgs , compiler ? "ghc902"}:
|
||||||
|
pkgs.haskell.packages.${compiler}.callPackage ./graphSat.nix { }
|
43
flake.lock
Normal file
43
flake.lock
Normal file
|
@ -0,0 +1,43 @@
|
||||||
|
{
|
||||||
|
"nodes": {
|
||||||
|
"flake-utils": {
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1667395993,
|
||||||
|
"narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "flake-utils",
|
||||||
|
"rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "flake-utils",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"nixpkgs": {
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1671458120,
|
||||||
|
"narHash": "sha256-2+k/OONN4OF21TeoNjKB5sXVZv6Zvm/uEyQIW9OYCg8=",
|
||||||
|
"owner": "NixOS",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"rev": "e37ef84b478fa8da0ced96522adfd956fde9047a",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "NixOS",
|
||||||
|
"ref": "nixpkgs-unstable",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"root": {
|
||||||
|
"inputs": {
|
||||||
|
"flake-utils": "flake-utils",
|
||||||
|
"nixpkgs": "nixpkgs"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"root": "root",
|
||||||
|
"version": 7
|
||||||
|
}
|
82
flake.nix
Normal file
82
flake.nix
Normal file
|
@ -0,0 +1,82 @@
|
||||||
|
{
|
||||||
|
description = "Daniel sat generator";
|
||||||
|
|
||||||
|
inputs = {
|
||||||
|
nixpkgs.url = github:NixOS/nixpkgs/nixpkgs-unstable;
|
||||||
|
flake-utils.url = github:numtide/flake-utils;
|
||||||
|
};
|
||||||
|
|
||||||
|
outputs = {self, nixpkgs, flake-utils} :
|
||||||
|
let
|
||||||
|
# name to be used as identifier for editor environments and such
|
||||||
|
name = "Application";
|
||||||
|
compiler = "ghc902";
|
||||||
|
|
||||||
|
in
|
||||||
|
flake-utils.lib.eachDefaultSystem ( system:
|
||||||
|
let
|
||||||
|
pkgs = import nixpkgs {inherit system;};
|
||||||
|
hpkgs = pkgs.haskell.packages.${compiler};
|
||||||
|
in {
|
||||||
|
packages = { default = (import ./default.nix) {inherit pkgs compiler;};};
|
||||||
|
|
||||||
|
|
||||||
|
devShells =
|
||||||
|
rec {
|
||||||
|
# This sets the default devShell
|
||||||
|
default = kakoune;
|
||||||
|
kakoune =
|
||||||
|
let
|
||||||
|
haskell-language-server = hpkgs.haskell-language-server;
|
||||||
|
myKakoune =
|
||||||
|
let
|
||||||
|
# this could also be done by generating toml with the
|
||||||
|
# nixpkgs lib, but I'm lazy
|
||||||
|
kak-lsp-config = pkgs.writeTextFile {
|
||||||
|
name = "kak-lsp-config.toml";
|
||||||
|
text = ''
|
||||||
|
[language.haskell]
|
||||||
|
filetypes = ["haskell"]
|
||||||
|
roots = ["Setup.hs", "stack.yaml", "*.cabal"]
|
||||||
|
command = "haskell-language-server-wrapper"
|
||||||
|
args = ["--lsp"]
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
config = pkgs.writeTextFile (rec {
|
||||||
|
name = "kakrc.kak";
|
||||||
|
destination = "/share/kak/autoload/${name}";
|
||||||
|
text = ''
|
||||||
|
colorscheme solarized-dark
|
||||||
|
set global tabstop 2
|
||||||
|
set global indentwidth 2
|
||||||
|
eval %sh{kak-lsp --kakoune --session $kak_session -c ${kak-lsp-config}}
|
||||||
|
# eval %sh{kak-lsp --kakoune --session $kak_session -c ${kak-lsp-config} --log /tmp/kak-lpsLog -vvvv}
|
||||||
|
hook global WinSetOption filetype=(haskell|nix) %{
|
||||||
|
lsp-auto-hover-enable
|
||||||
|
lsp-enable-window
|
||||||
|
}
|
||||||
|
add-highlighter global/ number-lines
|
||||||
|
map global normal <c-p> ': fzf-mode<ret>'
|
||||||
|
'';
|
||||||
|
});
|
||||||
|
in
|
||||||
|
pkgs.kakoune.override {
|
||||||
|
plugins = with pkgs.kakounePlugins; [fzf-kak kak-lsp config];
|
||||||
|
};
|
||||||
|
in
|
||||||
|
pkgs.mkShell {
|
||||||
|
inputsFrom = [self.outputs.packages.${system}.default];
|
||||||
|
packages = [myKakoune haskell-language-server pkgs.git pkgs.fzf hpkgs.cabal2nix pkgs.cabal-install pkgs.zlib.dev];
|
||||||
|
# TODO only try to start the kakoune session if no session with that
|
||||||
|
# name exists
|
||||||
|
shellHook = ''
|
||||||
|
alias ..="cd .."
|
||||||
|
export KAKOUNE_CONFIG_DIR="/dev/null/"
|
||||||
|
kak -d -s ${name} &
|
||||||
|
alias vim="kak -c ${name}"
|
||||||
|
'';
|
||||||
|
};
|
||||||
|
};
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
133
graphSat.cabal
Normal file
133
graphSat.cabal
Normal file
|
@ -0,0 +1,133 @@
|
||||||
|
cabal-version: 3.0
|
||||||
|
-- The cabal-version field refers to the version of the .cabal specification,
|
||||||
|
-- and can be different from the cabal-install (the tool) version and the
|
||||||
|
-- Cabal (the library) version you are using. As such, the Cabal (the library)
|
||||||
|
-- version used must be equal or greater than the version stated in this field.
|
||||||
|
-- Starting from the specification version 2.2, the cabal-version field must be
|
||||||
|
-- the first thing in the cabal file.
|
||||||
|
|
||||||
|
-- Initial package description 'graphSat' generated by
|
||||||
|
-- 'cabal init'. For further documentation, see:
|
||||||
|
-- http://haskell.org/cabal/users-guide/
|
||||||
|
--
|
||||||
|
-- The name of the package.
|
||||||
|
name: graphSat
|
||||||
|
|
||||||
|
-- The package version.
|
||||||
|
-- See the Haskell package versioning policy (PVP) for standards
|
||||||
|
-- guiding when and how versions should be incremented.
|
||||||
|
-- https://pvp.haskell.org
|
||||||
|
-- PVP summary: +-+------- breaking API changes
|
||||||
|
-- | | +----- non-breaking API additions
|
||||||
|
-- | | | +--- code changes with no API change
|
||||||
|
version: 0.1.0.0
|
||||||
|
|
||||||
|
-- A short (one-line) description of the package.
|
||||||
|
synopsis: Sat generator for headguessings
|
||||||
|
|
||||||
|
-- A longer description of the package.
|
||||||
|
-- description:
|
||||||
|
|
||||||
|
-- URL for the project homepage or repository.
|
||||||
|
homepage: https://git.nerfingen.de/nerf/graphSat
|
||||||
|
|
||||||
|
-- The license under which the package is released.
|
||||||
|
license: GPL-3.0-or-later
|
||||||
|
|
||||||
|
-- The file containing the license text.
|
||||||
|
license-file: LICENSE
|
||||||
|
|
||||||
|
-- The package author(s).
|
||||||
|
author: nerf van nerfingen
|
||||||
|
|
||||||
|
-- An email address to which users can send suggestions, bug reports, and patches.
|
||||||
|
maintainer: dennis@frieberg.de
|
||||||
|
|
||||||
|
-- A copyright notice.
|
||||||
|
-- copyright:
|
||||||
|
category: Math
|
||||||
|
build-type: Simple
|
||||||
|
|
||||||
|
-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
|
||||||
|
extra-doc-files: CHANGELOG.md
|
||||||
|
|
||||||
|
-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
|
||||||
|
-- extra-source-files:
|
||||||
|
|
||||||
|
common warnings
|
||||||
|
ghc-options: -Wall
|
||||||
|
|
||||||
|
library
|
||||||
|
-- Import common warning flags.
|
||||||
|
import: warnings
|
||||||
|
|
||||||
|
-- Modules exported by the library.
|
||||||
|
exposed-modules: MyLib
|
||||||
|
|
||||||
|
-- Modules included in this library but not exported.
|
||||||
|
-- other-modules:
|
||||||
|
|
||||||
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
|
-- other-extensions:
|
||||||
|
|
||||||
|
-- Other library packages from which modules are imported.
|
||||||
|
build-depends: base ^>=4.15.1.0
|
||||||
|
, containers
|
||||||
|
, array
|
||||||
|
|
||||||
|
-- Directories containing source files.
|
||||||
|
hs-source-dirs: src
|
||||||
|
|
||||||
|
-- Base language which the package is written in.
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable graphSat
|
||||||
|
-- Import common warning flags.
|
||||||
|
import: warnings
|
||||||
|
|
||||||
|
-- .hs or .lhs file containing the Main module.
|
||||||
|
main-is: Main.hs
|
||||||
|
|
||||||
|
-- Modules included in this executable, other than Main.
|
||||||
|
-- other-modules:
|
||||||
|
|
||||||
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
|
-- other-extensions:
|
||||||
|
|
||||||
|
-- Other library packages from which modules are imported.
|
||||||
|
build-depends:
|
||||||
|
base ^>=4.15.1.0,
|
||||||
|
graphSat
|
||||||
|
|
||||||
|
-- Directories containing source files.
|
||||||
|
hs-source-dirs: app
|
||||||
|
|
||||||
|
-- Base language which the package is written in.
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite graphSat-test
|
||||||
|
-- Import common warning flags.
|
||||||
|
import: warnings
|
||||||
|
|
||||||
|
-- Base language which the package is written in.
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
-- Modules included in this executable, other than Main.
|
||||||
|
-- other-modules:
|
||||||
|
|
||||||
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
|
-- other-extensions:
|
||||||
|
|
||||||
|
-- The interface type and version of the test suite.
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
|
||||||
|
-- Directories containing source files.
|
||||||
|
hs-source-dirs: test
|
||||||
|
|
||||||
|
-- The entrypoint to the test suite.
|
||||||
|
main-is: Main.hs
|
||||||
|
|
||||||
|
-- Test dependencies.
|
||||||
|
build-depends:
|
||||||
|
base ^>=4.15.1.0,
|
||||||
|
graphSat
|
15
graphSat.nix
Normal file
15
graphSat.nix
Normal file
|
@ -0,0 +1,15 @@
|
||||||
|
{ mkDerivation, array, base, containers, lib }:
|
||||||
|
mkDerivation {
|
||||||
|
pname = "graphSat";
|
||||||
|
version = "0.1.0.0";
|
||||||
|
src = ./.;
|
||||||
|
isLibrary = true;
|
||||||
|
isExecutable = true;
|
||||||
|
libraryHaskellDepends = [ array base containers ];
|
||||||
|
executableHaskellDepends = [ base ];
|
||||||
|
testHaskellDepends = [ base ];
|
||||||
|
homepage = "https://git.nerfingen.de/nerf/graphSat";
|
||||||
|
description = "Sat generator for headguessings";
|
||||||
|
license = lib.licenses.gpl3Plus;
|
||||||
|
mainProgram = "graphSat";
|
||||||
|
}
|
83
src/MyLib.hs
Normal file
83
src/MyLib.hs
Normal file
|
@ -0,0 +1,83 @@
|
||||||
|
module MyLib where
|
||||||
|
import Data.Graph
|
||||||
|
import Data.Array
|
||||||
|
import Data.Map(Map)
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
newtype Var = Var {vertex :: Vertex}
|
||||||
|
deriving Show
|
||||||
|
data Const = Const Vertex (Maybe Vertex)
|
||||||
|
deriving (Eq,Show,Ord)
|
||||||
|
data Sat = Variable Var
|
||||||
|
| CTrue
|
||||||
|
| CFalse
|
||||||
|
| Or Sat Sat
|
||||||
|
| And Sat Sat
|
||||||
|
| Neg Sat
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
data Expression = Add [SubExpression]
|
||||||
|
deriving Show
|
||||||
|
data SubExpression = Mul Const Var
|
||||||
|
| EConst Const
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
type Formula = (Expression, Var)
|
||||||
|
|
||||||
|
type Coloring = Map Vertex Color
|
||||||
|
|
||||||
|
type Color = Int
|
||||||
|
|
||||||
|
orStuff :: [Sat] -> Sat
|
||||||
|
orStuff = foldr (\x acc -> Or x acc) CTrue
|
||||||
|
|
||||||
|
andStuff :: [Sat] -> Sat
|
||||||
|
andStuff = foldr (\x acc -> And x acc) CFalse
|
||||||
|
|
||||||
|
graphToSat :: Graph -> Int -> Sat
|
||||||
|
graphToSat graph numOfColors= undefined
|
||||||
|
|
||||||
|
vertexToFormula :: Graph -> Vertex -> Formula
|
||||||
|
vertexToFormula graph vert = (vertexToExpression graph vert,Var vert)
|
||||||
|
|
||||||
|
vertexToExpression :: Graph -> Vertex -> Expression
|
||||||
|
vertexToExpression graph vert = Add $ (EConst $ Const vert Nothing) : fmap (vertexToSubExpression vert) (graph ! vert)
|
||||||
|
|
||||||
|
vertexToSubExpression :: Vertex -> Vertex -> SubExpression
|
||||||
|
vertexToSubExpression fromv tov = Mul (Const fromv (Just tov)) (Var tov)
|
||||||
|
|
||||||
|
evaluateExpr :: Int -> Map Const Color -> Coloring -> Expression -> Color
|
||||||
|
evaluateExpr numOfColors constM colo (Add xs) = (sum $ fmap (evaluateSubExpression numOfColors constM colo) xs) `mod` numOfColors
|
||||||
|
|
||||||
|
evaluateSubExpression :: Int -> Map Const Color -> Coloring -> SubExpression -> Color
|
||||||
|
evaluateSubExpression numOfColors constM colo (EConst c) = constM M.! c
|
||||||
|
evaluateSubExpression numOfColors constM colo (Mul c v) = (constM M.! c) * (colo M.! vertex v) `mod` numOfColors
|
||||||
|
|
||||||
|
constants :: Expression -> [Const]
|
||||||
|
constants (Add xs) = helper xs
|
||||||
|
where
|
||||||
|
helper [] = []
|
||||||
|
helper ((EConst x) : xs) = x : helper xs
|
||||||
|
helper ((Mul x _) : xs) = x : helper xs
|
||||||
|
|
||||||
|
formulaToAssigments :: Int -> Formula -> Coloring -> [Map Const Color]
|
||||||
|
formulaToAssigments numOfColors formu col = filter isSatisfied assignments
|
||||||
|
where
|
||||||
|
assignments :: [Map Const Color]
|
||||||
|
assignments = fmap (M.fromList . zip (constants . fst $ formu) . numToAssign numConstants numOfColors) [1..numOfColors^numConstants]
|
||||||
|
numToAssign 0 _ _ = []
|
||||||
|
numToAssign n colors x = x `mod` colors : numToAssign (n-1) colors (x `quot` colors)
|
||||||
|
numConstants = length . constants . fst $ formu
|
||||||
|
isSatisfied assign = evaluateExpr numOfColors assign col (fst formu) == col M.! vertex (snd formu)
|
||||||
|
|
||||||
|
vGuessesCorrect :: Int -> Graph -> Vertex -> Coloring -> Sat
|
||||||
|
vGuessesCorrect numOfColors graph vert coloring = undefined
|
||||||
|
|
||||||
|
numOfVars :: Int -> Int
|
||||||
|
numOfVars = ceiling . logBase 2 . fromIntegral
|
||||||
|
|
||||||
|
testGraph :: Graph
|
||||||
|
testGraph = array (0,2) [(0,[1]),(1,[0,2]),(2,[1])]
|
||||||
|
|
||||||
|
testColoring :: Coloring
|
||||||
|
testColoring = M.fromList [(0,2),(1,1),(2,0)]
|
4
test/Main.hs
Normal file
4
test/Main.hs
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = putStrLn "Test suite not yet implemented."
|
Loading…
Reference in a new issue