From 396f9615a1e7ae932736b73c2f3c7c93e3606d3b Mon Sep 17 00:00:00 2001 From: hellerve Date: Thu, 6 Feb 2020 09:58:52 +0100 Subject: [PATCH] initial --- .gitignore | 1 + README.md | 63 ++++++++++++++++++++++++++++++++++++++++++++++ Setup.hs | 2 ++ infer.cabal | 27 ++++++++++++++++++++ lib/Infer/Treat.hs | 33 ++++++++++++++++++++++++ src/App.hs | 19 ++++++++++++++ 6 files changed, 145 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 infer.cabal create mode 100644 lib/Infer/Treat.hs create mode 100644 src/App.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c33954f --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +dist-newstyle/ diff --git a/README.md b/README.md new file mode 100644 index 0000000..b4f4057 --- /dev/null +++ b/README.md @@ -0,0 +1,63 @@ +# infer + +is a simple inference engine. It’s inspired by [pgergis’ little +library](https://github.com/pgergis/haskell-inferences). I built my version +based on the initial description and realized I ended up with a super different +internal solution and decided it was interesting enough to be kept around. + +For a problem description read the README of pgergis’ repo. + +## Example Usage + +Using the human/mortal syllogism we end up with the following interaction: + +``` +$ infer '[{"premises": ["mortal", "alive"], "conclusion": "will die"}, {"premises": ["human"], "conclusion": "mortal"}]' human alive +Inferred the following statements: alive, human, mortal, will die +``` + +That seems right! + +As you can see, usage is a little different. Firstly, the premisses are not a +list but instead use the rest of the arguments after the JSON-formatted rules +list. Secondly we pretty-print the results a little. + +## How does it work? + +First we parse the JSON rules. Then we run `infer`, which will try and match +the known premises against all the premises of the rules. If we find a match +we insert it into the new known premises and discard the rule, since we know +we don’t have to apply it anymore. We do this until trying to apply all the +rules does not yield any new results. + +The code I’ve written is fairly terse, so here’s an annotated version of +`infer`: + +```haskell +-- pre are the known premises, env is the rule environment +infer :: S.Set String -> [Rule] -> S.Set String +infer pre env = + -- find will get us a tuple of found premises and the new set of rules + let (found, nenv) = find + -- if the new premises are nothing new we’re done + in if S.isSubsetOf found pre + then pre + -- otherwise we do it all over again with our new premises and env + else infer (S.union found pre) nenv + -- find goes over the environment, building a tuple of premises and + -- still applicable rules + where find = foldr mlook (S.empty, []) env + -- mlook gets a rule, the new found premises, and the new env + mlook r@Rule{premises, conclusion} (f, e) = + if S.isSubsetOf premises pre + -- if the premise matches, we add the conclusion and ignore the + -- rule, since we know it’s been applied + then (S.insert conclusion f, e) + -- otherwise we ignore the conclusion and add the rule for later + -- retesting + else (f, r:e) +``` + +
+ +Have fun! diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/infer.cabal b/infer.cabal new file mode 100644 index 0000000..60949ed --- /dev/null +++ b/infer.cabal @@ -0,0 +1,27 @@ +cabal-version: >=1.10 + +name: infer +version: 0.1.0.0 +license-file: LICENSE +author: hellerve +maintainer: veit@veitheller.de +build-type: Simple +extra-source-files: CHANGELOG.md + +executable infer + main-is: App.hs + build-depends: base >=4.12.0.0 && <4.14.0.0 + , infer-lib + hs-source-dirs: src + default-language: Haskell2010 + +library infer-lib + ghc-options: -Wall + exposed-modules: Infer.Treat + build-depends: base >=4.12.0.0 && <4.14.0.0 + , aeson + , containers + , utf8-string + hs-source-dirs: lib + default-language: Haskell2010 + diff --git a/lib/Infer/Treat.hs b/lib/Infer/Treat.hs new file mode 100644 index 0000000..02d02a2 --- /dev/null +++ b/lib/Infer/Treat.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} +module Infer.Treat where + +import Data.Aeson (ToJSON, FromJSON, eitherDecode) +import Data.ByteString.Lazy.UTF8 (fromString) +import GHC.Generics (Generic) +import qualified Data.Set as S + +data Rule = Rule { + premises :: S.Set String, + conclusion :: String +} + deriving (Eq, Ord, Show, Generic) + +instance ToJSON Rule +instance FromJSON Rule + +run :: String -> [String] -> Either String [String] +run input pre = fmap f (eitherDecode $ fromString input) + where f = S.toList . infer (S.fromList pre) + +infer :: S.Set String -> [Rule] -> S.Set String +infer pre env = + let (found, nenv) = find + in if S.isSubsetOf found pre + then pre + else infer (S.union found pre) nenv + where find = foldr mlook (S.empty, []) env + mlook r@Rule{premises, conclusion} (f, e) = + if S.isSubsetOf premises pre + then (S.insert conclusion f, e) + else (f, r:e) diff --git a/src/App.hs b/src/App.hs new file mode 100644 index 0000000..518faa1 --- /dev/null +++ b/src/App.hs @@ -0,0 +1,19 @@ +module Main where + +import Data.List (intercalate) +import System.Environment (getArgs) +import System.IO (hPutStrLn, stderr) + +import Infer.Treat (run) + +main :: IO () +main = do + args <- getArgs + if length args < 2 + then errln "Expected at least two arguments." + else + case run (head args) (tail args) of + Left e -> errln e + Right v -> + putStrLn $ "Inferred the following statements: " ++ (intercalate ", " v) + where errln = hPutStrLn stderr