Skip to content

Commit 38ebd73

Browse files
herrmannoherrmanno
committed
Improve LazyTree & Add TUI
- improve LazyTree performance (!) - as tradeoff, parallel tree computation seems to be slower - add basic TUI handling for tasks types
1 parent 946aed6 commit 38ebd73

19 files changed

+472
-128
lines changed

‎.vscode/tasks.json

+47
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
2+
{
3+
// Automatically created by phoityne-vscode extension.
4+
5+
"version": "2.0.0",
6+
"presentation": {
7+
"reveal": "always",
8+
"panel": "new"
9+
},
10+
"tasks": [
11+
{
12+
// F7
13+
"group": {
14+
"kind": "build",
15+
"isDefault": true
16+
},
17+
"label": "stack build",
18+
"type": "shell",
19+
"command": "stack build"
20+
},
21+
{
22+
// F6
23+
"group": "build",
24+
"type": "shell",
25+
"label": "stack clean & build",
26+
"command": "stack clean && stack build"
27+
//"command": "stack clean ; stack build" // for powershell
28+
},
29+
{
30+
// F8
31+
"group": {
32+
"kind": "test",
33+
"isDefault": true
34+
},
35+
"type": "shell",
36+
"label": "stack test",
37+
"command": "stack test"
38+
},
39+
{
40+
// F6
41+
"isBackground": true,
42+
"type": "shell",
43+
"label": "stack watch",
44+
"command": "stack build --test --no-run-tests --file-watch"
45+
}
46+
]
47+
}

‎app/App.hs

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
module App ( app, help ) where
2+
3+
import Tasks.Sets as Set
4+
import Tasks.Relations as Relation
5+
6+
app :: String -- ^ task type
7+
-> String -- ^ task description
8+
-> String -- ^ output
9+
app "set" d = Set.runTask d
10+
app "rel" d = Relation.runTask d
11+
app s _ = unlines $ ("Undefined task type '" ++ s ++ "'. Supported task types are:") : taskDescriptions
12+
13+
help = unlines $ "USAGE: <task> <task description file>" : taskDescriptions
14+
15+
taskDescriptions =
16+
[ " - set :: finds an expression matching a target value, given operators and constants"
17+
, " - rel :: finds an expression matching a target value, given operators and constants"
18+
]

‎app/Main.hs

+43-29
Original file line numberDiff line numberDiff line change
@@ -1,32 +1,46 @@
1-
import Prelude hiding ((+), (-), (*))
1+
import System.Environment (getArgs)
2+
import App (app, help)
23

3-
import Autotool.Data.RelOp ( (&), (+), (-), (*) )
4-
import Autotool.Data.LazyTree (showTreeFn, showTree, Tree(Node), Op(Op0) )
5-
import Autotool.Solver.Relations (solve)
6-
import Autotool.Parser.Relation (parseIntRelation)
7-
import Autotool.Data.Parallel.LazyTree (treesP)
84
main = do
9-
let
10-
r = Op0 "r" $ parseIntRelation "{(1,1),(1,2),(2,1)}"
11-
-- s = Set "S" [ V(1 , 3), V(2 , 1), V(2 , 2) ]
12-
s = Op0 "s" $ parseIntRelation "{(1,3),(2,1),(2,2)}"
13-
-- t = S[ V(1 , 2) , V(2 , 3) ]
14-
t = parseIntRelation "{(1,3),(2,3)}"
15-
ops = [(+), (&), (-), (*), r, s]
16-
-- result = Node2 Subtr (Node2 Compose (Node0 r) (Node2 Subtr (Node0 s) (Node0 r))) (Node0 s)
17-
result = Node (-) [
18-
Node (*) [
19-
Node r [],
20-
Node (-) [ Node s [], Node r [] ]
21-
],
22-
Node s []
23-
]
24-
ts = treesP ops
25-
st = let f a
26-
| a == r = "R"
27-
| a == s = "S"
28-
| otherwise = show a
29-
in showTreeFn f
30-
-- mapM_ (putStrLn . st) ts
31-
putStrLn $ showTree $ solve ops t
5+
args <- getArgs
6+
go args >>= putStrLn
7+
where
8+
go [command,filename] = do
9+
input <- readFile filename
10+
return $ app command input
11+
go _ = return help
12+
13+
-- import Prelude hiding ((+), (-), (*))
14+
-- import Autotool.Data.SetOp ( (&), (+), (-), pow )
15+
-- import Autotool.Data.LazyTree (treesLevelCount, termsLength, trees, evalTree, showTreeFn, showTree, Tree(Node), Op(Op0), findTree)
16+
-- import Autotool.Solver.Sets (solve)
17+
-- import Autotool.Parser.NestedSet (parseIntSet)
18+
-- import Autotool.Data.Parallel.LazyTree (treesP)
19+
-- import Autotool.Data.NestedSet (toStr)
20+
21+
-- main = do
22+
-- let
23+
-- a = Op0 "A" $ parseIntSet "{{}, {{}}}"
24+
-- b = Op0 "B" $ parseIntSet "{1, {1}, {2, {}}}"
25+
-- t = parseIntSet "{{}, {{}, {{}}}, {{{}}}}"
26+
-- ops = [(+), (-), (&), pow, a, b]
27+
-- result =
28+
-- Node (-) [
29+
-- Node pow [ Node a [] ],
30+
-- Node (-) [
31+
-- Node a [],
32+
-- Node pow [
33+
-- Node (&) [
34+
-- Node a [],
35+
-- Node b []
36+
-- ]
37+
-- ]
38+
-- ]
39+
-- ]
40+
-- ts = trees ops
41+
-- -- mapM_ (putStrLn . showTree) (take 50000 ts)
42+
-- -- print $ let xs = [0..5] in zip xs $ map (treesLevelCount [2,1,3]) xs
43+
-- -- print $ let xs = [600..700] in zip xs $ map (termsLength [2,1,3]) xs
44+
-- -- print $ toStr $ evalTree result
45+
-- putStrLn $ showTree $ solve ops t
3246

‎app/Tasks/Relations.hs

+45
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
module Tasks.Relations (runTask) where
2+
3+
import Prelude hiding ((+), (-), (*))
4+
import Data.List (intercalate)
5+
import Text.Parsec ((<|>))
6+
import qualified Text.Parsec as P
7+
import Data.Set (Set)
8+
import Autotool.Data.LazyTree (isOp0, Op(..), showTree, eval, trees)
9+
import Autotool.Parser.Relation ( parseRelation )
10+
import Autotool.Data.RelOp ((+), (&), (-), (*))
11+
import Autotool.Solver.Relations (solve)
12+
13+
runTask :: String -> String
14+
runTask input = case parseSetDescription input of
15+
(Right d@(RelationDescription ops t)) -> showTree $ solve ops t
16+
(Left err) -> show err
17+
18+
data RelationDescription = RelationDescription
19+
{ ops :: [Op (Set (Integer,Integer))]
20+
, target :: Set (Integer,Integer)
21+
}
22+
23+
instance Show RelationDescription where
24+
show (RelationDescription ops t) =
25+
let target = "Target: " ++ show t
26+
sets = "Relations: " ++ intercalate ", " (map (\cnst -> show cnst ++ " = " ++ show (eval cnst [])) $ filter isOp0 ops)
27+
ops' = "Operators: " ++ intercalate ", " (map show $ filter (not . isOp0) ops)
28+
in unlines [ops', sets, target]
29+
30+
parseSetDescription :: String -> Either P.ParseError RelationDescription
31+
parseSetDescription = P.parse parse ""
32+
where
33+
parse = let
34+
f ops ss = RelationDescription (ss ++ ops)
35+
in f <$> parseOPs <*> parseRelations <*> parseTarget
36+
parseOPs = (P.string "#OPS" >> P.spaces) *> P.many1 parseOp <* P.spaces
37+
parseOp = parseOpCup <|> parseOpDiff <|> parseOpCap <|> parseOpCompose
38+
parseOpCup = P.char '+' >> P.spaces >> return (+)
39+
parseOpDiff = P.char '-' >> P.spaces >> return (-)
40+
parseOpCap = P.char '&' >> P.spaces >> return (&)
41+
parseOpCompose = P.string "." >> P.spaces >> return (*)
42+
parseTarget = (P.string "#TARGET" >> P.spaces) *> parseRelation <* P.spaces
43+
parseRelations = (P.string "#RELATIONS" >> P.spaces) *> P.many1 parseConst <* P.spaces
44+
parseConst = Op0 <$> (P.many1 P.alphaNum <* parseEq) <*> (parseRelation <* P.spaces)
45+
parseEq = P.spaces >> P.char '=' >> P.spaces

‎app/Tasks/Sets.hs

+42
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
module Tasks.Sets (runTask) where
2+
3+
import Prelude hiding ((+), (-))
4+
import Data.List (intercalate)
5+
import Text.Parsec ((<|>))
6+
import qualified Text.Parsec as P
7+
import Autotool.Data.LazyTree (isOp0, Op(..), showTree, eval, trees)
8+
import Autotool.Data.NestedSet (toStr, NSet, ø)
9+
import Autotool.Parser.NestedSet ( parseSet )
10+
import Autotool.Data.SetOp ((+), (&), (-), pow)
11+
import Autotool.Solver.Sets (solve)
12+
13+
runTask :: String -> String
14+
runTask input = case parseSetDescription input of
15+
(Right d@(SetDescription ops t)) -> showTree $ solve ops t
16+
(Left err) -> show err
17+
18+
data SetDescription = SetDescription { ops :: [Op (NSet Integer)] , target :: NSet Integer }
19+
20+
instance Show SetDescription where
21+
show (SetDescription ops t) =
22+
let target = "Target: " ++ toStr t
23+
sets = "Sets: " ++ intercalate ", " (map (\cnst -> show cnst ++ " = " ++ toStr (eval cnst [])) $ filter isOp0 ops)
24+
ops' = "Operators: " ++ intercalate ", " (map show $ filter (not . isOp0) ops)
25+
in unlines [ops', sets, target]
26+
27+
parseSetDescription :: String -> Either P.ParseError SetDescription
28+
parseSetDescription = P.parse parse ""
29+
where
30+
parse = let
31+
f ops ss = SetDescription (ss ++ ops)
32+
in f <$> parseOPs <*> parseSets <*> parseTarget
33+
parseOPs = (P.string "#OPS" >> P.spaces) *> P.many1 parseOp <* P.spaces
34+
parseOp = parseOpCup <|> parseOpDiff <|> parseOpCap <|> parseOpPow
35+
parseOpCup = P.char '+' >> P.spaces >> return (+)
36+
parseOpDiff = P.char '-' >> P.spaces >> return (-)
37+
parseOpCap = P.char '&' >> P.spaces >> return (&)
38+
parseOpPow = P.string "pow" >> P.spaces >> return pow
39+
parseTarget = (P.string "#TARGET" >> P.spaces) *> parseSet <* P.spaces
40+
parseSets = (P.string "#SETS" >> P.spaces) *> P.many1 parseConst <* P.spaces
41+
parseConst = Op0 <$> (P.many1 P.alphaNum <* parseEq) <*> (parseSet <* P.spaces)
42+
parseEq = P.spaces >> P.char '=' >> P.spaces

‎autotool-solver.cabal

+4-1
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ cabal-version: 1.12
44
--
55
-- see: https://github.com/sol/hpack
66
--
7-
-- hash: 68eb0ea8db4f4934b21483dbda2709d48e5097b2f5184842aabac3248bb78783
7+
-- hash: fd7b13f51c976974ba5a29dce4dd884552e150d911ddea921fd1b23c5f9a8fe3
88

99
name: autotool-solver
1010
version: 0.1.0.0
@@ -59,6 +59,9 @@ library
5959
executable autotool-solver-exe
6060
main-is: Main.hs
6161
other-modules:
62+
App
63+
Tasks.Relations
64+
Tasks.Sets
6265
Paths_autotool_solver
6366
hs-source-dirs:
6467
app

‎examples/rel1.txt

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
#OPS
2+
3+
+
4+
&
5+
-
6+
.
7+
8+
#RELATIONS
9+
10+
R = {(1 , 4) , (2 , 4) , (3 , 2) , (4 , 1)}
11+
S = {(1 , 4) , (2 , 2) , (2 , 3) , (4 , 4)}
12+
13+
#TARGET
14+
15+
{(1 , 1) , (1 , 4) , (2 , 1) , (2 , 2) , (2 , 4) , (4 , 1) , (4 , 4)}

‎examples/rel2.txt

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
#OPS
2+
3+
+
4+
&
5+
-
6+
.
7+
8+
#RELATIONS
9+
10+
R = {(1,1),(1,2),(2,1)}
11+
S = {(1,3),(2,1),(2,2)}
12+
13+
#TARGET
14+
15+
{(1,3),(2,3)}

‎examples/set1.txt

+16
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
#OPS
2+
3+
+
4+
-
5+
&
6+
pow
7+
8+
#SETS
9+
10+
A = {{}, {{}}}
11+
B = {1, {1}, {2, {}}}
12+
13+
14+
#TARGET
15+
16+
{{}, {{}, {{}}}, {{{}}}}

‎examples/set2.txt

+15
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
#OPS
2+
3+
+
4+
&
5+
-
6+
pow
7+
8+
#SETS
9+
10+
A = {1, 2}
11+
B = {{3}}
12+
13+
#TARGET
14+
15+
{{}, {1, 2, {3}}, {1, {3}}, {2, {3}}, {{3}}}

0 commit comments

Comments
 (0)