From 1b98cb32a1dcbc7b855e27dc153f147cccadee27 Mon Sep 17 00:00:00 2001 From: nerf van nerfingen Date: Wed, 21 Dec 2022 00:33:56 +0100 Subject: [PATCH] a start mainly to share --- CHANGELOG.md | 5 ++ app/Main.hs | 8 +++ default.nix | 2 + flake.lock | 43 ++++++++++++++++ flake.nix | 82 ++++++++++++++++++++++++++++++ graphSat.cabal | 133 +++++++++++++++++++++++++++++++++++++++++++++++++ graphSat.nix | 15 ++++++ src/MyLib.hs | 83 ++++++++++++++++++++++++++++++ test/Main.hs | 4 ++ 9 files changed, 375 insertions(+) create mode 100644 CHANGELOG.md create mode 100644 app/Main.hs create mode 100644 default.nix create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 graphSat.cabal create mode 100644 graphSat.nix create mode 100644 src/MyLib.hs create mode 100644 test/Main.hs diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..4785353 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for graphSat + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..60d904e --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import qualified MyLib (someFunc) + +main :: IO () +main = do + putStrLn "Hello, Haskell!" + MyLib.someFunc diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..ef14e05 --- /dev/null +++ b/default.nix @@ -0,0 +1,2 @@ +{ pkgs , compiler ? "ghc902"}: + pkgs.haskell.packages.${compiler}.callPackage ./graphSat.nix { } diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..a76323a --- /dev/null +++ b/flake.lock @@ -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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..867fe4e --- /dev/null +++ b/flake.nix @@ -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 ': fzf-mode' + ''; + }); + 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}" + ''; + }; + }; + } + ); +} diff --git a/graphSat.cabal b/graphSat.cabal new file mode 100644 index 0000000..fb2601e --- /dev/null +++ b/graphSat.cabal @@ -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 diff --git a/graphSat.nix b/graphSat.nix new file mode 100644 index 0000000..644dafc --- /dev/null +++ b/graphSat.nix @@ -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"; +} diff --git a/src/MyLib.hs b/src/MyLib.hs new file mode 100644 index 0000000..bdda05a --- /dev/null +++ b/src/MyLib.hs @@ -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)] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..3e2059e --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = putStrLn "Test suite not yet implemented."