{-# language OverloadedStrings #-}
module Text.ParseSR ( parseSR, showOutput, SRAlgs(..), Output(..) )
where
import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.Expr
import qualified Data.ByteString.Char8 as B
import Control.Applicative ( (<|>) )
import qualified Data.SRTree.Print as P
import Data.List ( sortOn )
import Debug.Trace ( trace )
import Data.SRTree
type ParseTree = Parser (Fix SRTree)
data SRAlgs = TIR | HL | OPERON | BINGO | GOMEA | PYSR | SBP | EPLEX deriving (Int -> SRAlgs -> ShowS
[SRAlgs] -> ShowS
SRAlgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SRAlgs] -> ShowS
$cshowList :: [SRAlgs] -> ShowS
show :: SRAlgs -> String
$cshow :: SRAlgs -> String
showsPrec :: Int -> SRAlgs -> ShowS
$cshowsPrec :: Int -> SRAlgs -> ShowS
Show, ReadPrec [SRAlgs]
ReadPrec SRAlgs
Int -> ReadS SRAlgs
ReadS [SRAlgs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SRAlgs]
$creadListPrec :: ReadPrec [SRAlgs]
readPrec :: ReadPrec SRAlgs
$creadPrec :: ReadPrec SRAlgs
readList :: ReadS [SRAlgs]
$creadList :: ReadS [SRAlgs]
readsPrec :: Int -> ReadS SRAlgs
$creadsPrec :: Int -> ReadS SRAlgs
Read, Int -> SRAlgs
SRAlgs -> Int
SRAlgs -> [SRAlgs]
SRAlgs -> SRAlgs
SRAlgs -> SRAlgs -> [SRAlgs]
SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs]
$cenumFromThenTo :: SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs]
enumFromTo :: SRAlgs -> SRAlgs -> [SRAlgs]
$cenumFromTo :: SRAlgs -> SRAlgs -> [SRAlgs]
enumFromThen :: SRAlgs -> SRAlgs -> [SRAlgs]
$cenumFromThen :: SRAlgs -> SRAlgs -> [SRAlgs]
enumFrom :: SRAlgs -> [SRAlgs]
$cenumFrom :: SRAlgs -> [SRAlgs]
fromEnum :: SRAlgs -> Int
$cfromEnum :: SRAlgs -> Int
toEnum :: Int -> SRAlgs
$ctoEnum :: Int -> SRAlgs
pred :: SRAlgs -> SRAlgs
$cpred :: SRAlgs -> SRAlgs
succ :: SRAlgs -> SRAlgs
$csucc :: SRAlgs -> SRAlgs
Enum, SRAlgs
forall a. a -> a -> Bounded a
maxBound :: SRAlgs
$cmaxBound :: SRAlgs
minBound :: SRAlgs
$cminBound :: SRAlgs
Bounded)
data Output = PYTHON | MATH | TIKZ | LATEX deriving (Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show, ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Output]
$creadListPrec :: ReadPrec [Output]
readPrec :: ReadPrec Output
$creadPrec :: ReadPrec Output
readList :: ReadS [Output]
$creadList :: ReadS [Output]
readsPrec :: Int -> ReadS Output
$creadsPrec :: Int -> ReadS Output
Read, Int -> Output
Output -> Int
Output -> [Output]
Output -> Output
Output -> Output -> [Output]
Output -> Output -> Output -> [Output]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Output -> Output -> Output -> [Output]
$cenumFromThenTo :: Output -> Output -> Output -> [Output]
enumFromTo :: Output -> Output -> [Output]
$cenumFromTo :: Output -> Output -> [Output]
enumFromThen :: Output -> Output -> [Output]
$cenumFromThen :: Output -> Output -> [Output]
enumFrom :: Output -> [Output]
$cenumFrom :: Output -> [Output]
fromEnum :: Output -> Int
$cfromEnum :: Output -> Int
toEnum :: Int -> Output
$ctoEnum :: Int -> Output
pred :: Output -> Output
$cpred :: Output -> Output
succ :: Output -> Output
$csucc :: Output -> Output
Enum, Output
forall a. a -> a -> Bounded a
maxBound :: Output
$cmaxBound :: Output
minBound :: Output
$cminBound :: Output
Bounded)
showOutput :: Output -> Fix SRTree -> String
showOutput :: Output -> Fix SRTree -> String
showOutput Output
PYTHON = Fix SRTree -> String
P.showPython
showOutput Output
MATH = Fix SRTree -> String
P.showExpr
showOutput Output
TIKZ = Fix SRTree -> String
P.showTikz
showOutput Output
LATEX = Fix SRTree -> String
P.showLatex
parseSR :: SRAlgs -> B.ByteString -> Bool -> B.ByteString -> Either String (Fix SRTree)
parseSR :: SRAlgs
-> ByteString -> Bool -> ByteString -> Either String (Fix SRTree)
parseSR SRAlgs
HL ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseHL Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
BINGO ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseBingo Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
TIR ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseTIR Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
OPERON ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseOperon Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
GOMEA ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseGOMEA Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
SBP ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseGOMEA Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
EPLEX ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parseGOMEA Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
PYSR ByteString
header Bool
reparam = forall r. Result r -> Either String r
eitherResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> ParseTree
parsePySR Bool
reparam forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
eitherResult' :: Show r => Result r -> Either String r
eitherResult' :: forall r. Show r => Result r -> Either String r
eitherResult' Result r
res = forall a. String -> a -> a
trace (forall a. Show a => a -> String
show Result r
res) forall a b. (a -> b) -> a -> b
$ forall r. Result r -> Either String r
eitherResult Result r
res
binary :: B.ByteString -> (a -> a -> a) -> Assoc -> Operator B.ByteString a
binary :: forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
name a -> a -> a
fun = forall t a. Parser t (a -> a -> a) -> Assoc -> Operator t a
Infix (do{ ByteString -> Parser ByteString ByteString
string (Char -> ByteString -> ByteString
B.cons Char
' ' (ByteString -> Char -> ByteString
B.snoc ByteString
name Char
' ')) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
string ByteString
name; forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a -> a
fun })
prefix :: B.ByteString -> (a -> a) -> Operator B.ByteString a
prefix :: forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix ByteString
name a -> a
fun = forall t a. Parser t (a -> a) -> Operator t a
Prefix (do{ ByteString -> Parser ByteString ByteString
string ByteString
name; forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
fun })
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens Parser a
e = do{ ByteString -> Parser ByteString ByteString
string ByteString
"("; a
e' <- Parser a
e; ByteString -> Parser ByteString ByteString
string ByteString
")"; forall (f :: * -> *) a. Applicative f => a -> f a
pure a
e' } forall i a. Parser i a -> String -> Parser i a
<?> String
"parens"
parseExpr :: [[Operator B.ByteString (Fix SRTree)]] -> [ParseTree -> ParseTree] -> ParseTree -> Bool -> [(B.ByteString, Int)] -> ParseTree
parseExpr :: [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr [[Operator ByteString (Fix SRTree)]]
table [ParseTree -> ParseTree]
binFuns ParseTree
var Bool
reparam [(ByteString, Int)]
header = do Fix SRTree
e <- Fix SRTree -> Fix SRTree
relabelParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseTree
expr
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Char
space
forall (f :: * -> *) a. Applicative f => a -> f a
pure Fix SRTree
e
where
term :: ParseTree
term = forall a. Parser a -> Parser a
parens ParseTree
expr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Num a => Parser a -> Parser a
enclosedAbs ParseTree
expr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> a -> b
$ ParseTree
expr) [ParseTree -> ParseTree]
binFuns) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseTree
coef forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseTree
varC forall i a. Parser i a -> String -> Parser i a
<?> String
"term"
expr :: ParseTree
expr = forall t b.
Monoid t =>
[[Operator t b]] -> Parser t b -> Parser t b
buildExpressionParser [[Operator ByteString (Fix SRTree)]]
table ParseTree
term
coef :: ParseTree
coef = if Bool
reparam
then do Either Int Double
eNumber <- Parser (Either Int Double)
intOrDouble
case Either Int Double
eNumber of
Left Int
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
Right Double
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Fix SRTree
param Int
0
else forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall val. Double -> SRTree val
Const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser a -> Parser a
signed Parser Double
double forall i a. Parser i a -> String -> Parser i a
<?> String
"const"
varC :: ParseTree
varC = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, Int)]
header
then ParseTree
var
else ParseTree
var forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseTree
varHeader
varHeader :: ParseTree
varHeader = forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Int -> ParseTree
getParserVar) forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ByteString, Int)]
header
getParserVar :: ByteString -> Int -> ParseTree
getParserVar ByteString
k Int
v = (ByteString -> Parser ByteString ByteString
string ByteString
k forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {b}. IsString b => ByteString -> Parser ByteString b
enveloped ByteString
k) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var Int
v)
enveloped :: ByteString -> Parser ByteString b
enveloped ByteString
s = (Char -> Parser Char
char Char
' ' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
'(') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString ByteString
string ByteString
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Parser Char
char Char
' ' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Char
char Char
')') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
""
enumerate :: [a] -> [(a, Int)]
enumerate :: forall a. [a] -> [(a, Int)]
enumerate = (forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0..])
splitHeader :: B.ByteString -> [(B.ByteString, Int)]
= forall a. [a] -> [(a, Int)]
enumerate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
B.split Char
','
intOrDouble :: Parser (Either Int Double)
intOrDouble :: Parser (Either Int Double)
intOrDouble = forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherP Parser Int
parseInt (forall a. Num a => Parser a -> Parser a
signed Parser Double
double)
where
parseInt :: Parser Int
parseInt :: Parser Int
parseInt = do Int
x <- forall a. Num a => Parser a -> Parser a
signed forall a. Integral a => Parser a
decimal
Maybe Char
c <- Parser (Maybe Char)
peekChar
case Maybe Char
c of
Just Char
'.' -> Parser Char
digit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
Just Char
'e' -> Parser Char
digit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
Just Char
'E' -> Parser Char
digit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
Maybe Char
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
x
putEOL :: B.ByteString -> B.ByteString
putEOL :: ByteString -> ByteString
putEOL ByteString
bs | ByteString -> Char
B.last ByteString
bs forall a. Eq a => a -> a -> Bool
== Char
'\n' = ByteString
bs
| Bool
otherwise = ByteString -> Char -> ByteString
B.snoc ByteString
bs Char
'\n'
aq :: Fix SRTree -> Fix SRTree -> Fix SRTree
aq :: Fix SRTree -> Fix SRTree -> Fix SRTree
aq Fix SRTree
x Fix SRTree
y = Fix SRTree
x forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt (Fix SRTree
1 forall a. Num a => a -> a -> a
+ Fix SRTree
y forall a. Floating a => a -> a -> a
** Fix SRTree
2)
log1p :: Fix SRTree -> Fix SRTree
log1p :: Fix SRTree -> Fix SRTree
log1p Fix SRTree
x = forall a. Floating a => a -> a
log (Fix SRTree
1 forall a. Num a => a -> a -> a
+ Fix SRTree
x)
log10 :: Fix SRTree -> Fix SRTree
log10 :: Fix SRTree -> Fix SRTree
log10 Fix SRTree
x = forall a. Floating a => a -> a
log Fix SRTree
x forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
log Fix SRTree
10
log2 :: Fix SRTree -> Fix SRTree
log2 :: Fix SRTree -> Fix SRTree
log2 Fix SRTree
x = forall a. Floating a => a -> a
log Fix SRTree
x forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
log Fix SRTree
2
cbrt :: Fix SRTree -> Fix SRTree
cbrt :: Fix SRTree -> Fix SRTree
cbrt Fix SRTree
x = Fix SRTree
x forall a. Floating a => a -> a -> a
** (Fix SRTree
1forall a. Fractional a => a -> a -> a
/Fix SRTree
3)
enclosedAbs :: Num a => Parser a -> Parser a
enclosedAbs :: forall a. Num a => Parser a -> Parser a
enclosedAbs Parser a
expr = do Char -> Parser Char
char Char
'|'
a
e <- Parser a
expr
Char -> Parser Char
char Char
'|'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs a
e
binFun :: B.ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun :: forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
name a -> a -> a
f Parser a
expr = do ByteString -> Parser ByteString ByteString
string ByteString
name
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Char
space
a
e1 <- Parser a
expr
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
',' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Char
space
a
e2 <- Parser a
expr
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
char Char
')'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
e1 a
e2
parseTIR :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseTIR :: Bool -> [(ByteString, Int)] -> ParseTree
parseTIR = [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) forall {a}. [a]
binFuns ParseTree
var
where
binFuns :: [a]
binFuns = [ ]
prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
[ (ByteString
"Id", forall a. a -> a
id), (ByteString
"Abs", forall a. Num a => a -> a
abs)
, (ByteString
"Sinh", forall a. Floating a => a -> a
sinh), (ByteString
"Cosh", forall a. Floating a => a -> a
cosh), (ByteString
"Tanh", forall a. Floating a => a -> a
tanh)
, (ByteString
"Sin", forall a. Floating a => a -> a
sin), (ByteString
"Cos", forall a. Floating a => a -> a
cos), (ByteString
"Tan", forall a. Floating a => a -> a
tan)
, (ByteString
"ASinh", forall a. Floating a => a -> a
asinh), (ByteString
"ACosh", forall a. Floating a => a -> a
acosh), (ByteString
"ATanh", forall a. Floating a => a -> a
atanh)
, (ByteString
"ASin", forall a. Floating a => a -> a
asin), (ByteString
"ACos", forall a. Floating a => a -> a
acos), (ByteString
"ATan", forall a. Floating a => a -> a
atan)
, (ByteString
"Sqrt", forall a. Floating a => a -> a
sqrt), (ByteString
"Cbrt", Fix SRTree -> Fix SRTree
cbrt), (ByteString
"Square", (forall a. Floating a => a -> a -> a
**Fix SRTree
2))
, (ByteString
"Log", forall a. Floating a => a -> a
log), (ByteString
"Exp", forall a. Floating a => a -> a
exp)
]
binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft], [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"**" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft]
]
var :: ParseTree
var = do Char -> Parser Char
char Char
'x'
Int
ix <- forall a. Integral a => Parser a
decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var Int
ix
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"
parseOperon :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseOperon :: Bool -> [(ByteString, Int)] -> ParseTree
parseOperon = [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [ParseTree -> ParseTree]
binFuns ParseTree
var
where
binFuns :: [ParseTree -> ParseTree]
binFuns = [ forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"pow" forall a. Floating a => a -> a -> a
(**) ]
prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
[ (ByteString
"abs", forall a. Num a => a -> a
abs), (ByteString
"cbrt", Fix SRTree -> Fix SRTree
cbrt)
, (ByteString
"acos", forall a. Floating a => a -> a
acos), (ByteString
"cosh", forall a. Floating a => a -> a
cosh), (ByteString
"cos", forall a. Floating a => a -> a
cos)
, (ByteString
"asin", forall a. Floating a => a -> a
asin), (ByteString
"sinh", forall a. Floating a => a -> a
sinh), (ByteString
"sin", forall a. Floating a => a -> a
sin)
, (ByteString
"exp", forall a. Floating a => a -> a
exp), (ByteString
"log", forall a. Floating a => a -> a
log)
, (ByteString
"sqrt", forall a. Floating a => a -> a
sqrt), (ByteString
"square", (forall a. Floating a => a -> a -> a
**Fix SRTree
2))
, (ByteString
"atan", forall a. Floating a => a -> a
atan), (ByteString
"tanh", forall a. Floating a => a -> a
tanh), (ByteString
"tan", forall a. Floating a => a -> a
tan)
]
binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
]
var :: ParseTree
var = do Char -> Parser Char
char Char
'X'
Int
ix <- forall a. Integral a => Parser a
decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var (Int
ix forall a. Num a => a -> a -> a
- Int
1)
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"
parseHL :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseHL :: Bool -> [(ByteString, Int)] -> ParseTree
parseHL = [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [ParseTree -> ParseTree]
binFuns ParseTree
var
where
binFuns :: [ParseTree -> ParseTree]
binFuns = [ forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"aq" Fix SRTree -> Fix SRTree -> Fix SRTree
aq ]
prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
[ (ByteString
"logabs", forall a. Floating a => a -> a
logforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs), (ByteString
"sqrtabs", forall a. Floating a => a -> a
sqrtforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs)
, (ByteString
"abs", forall a. Num a => a -> a
abs), (ByteString
"exp", forall a. Floating a => a -> a
exp), (ByteString
"log", forall a. Floating a => a -> a
log)
, (ByteString
"sqrt", forall a. Floating a => a -> a
sqrt), (ByteString
"sqr", (forall a. Floating a => a -> a -> a
**Fix SRTree
2)), (ByteString
"cube", (forall a. Floating a => a -> a -> a
**Fix SRTree
3))
, (ByteString
"cbrt", Fix SRTree -> Fix SRTree
cbrt), (ByteString
"sin", forall a. Floating a => a -> a
sin), (ByteString
"cos", forall a. Floating a => a -> a
cos)
, (ByteString
"tan", forall a. Floating a => a -> a
tan), (ByteString
"tanh", forall a. Floating a => a -> a
tanh)
]
binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
]
var :: ParseTree
var = do Char -> Parser Char
char Char
'x'
Int
ix <- forall a. Integral a => Parser a
decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var Int
ix
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"
parseBingo :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseBingo :: Bool -> [(ByteString, Int)] -> ParseTree
parseBingo = [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) forall {a}. [a]
binFuns ParseTree
var
where
binFuns :: [a]
binFuns = []
prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
[ (ByteString
"abs", forall a. Num a => a -> a
abs), (ByteString
"exp", forall a. Floating a => a -> a
exp), (ByteString
"log", forall a. Floating a => a -> a
logforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs)
, (ByteString
"sqrt", forall a. Floating a => a -> a
sqrtforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs)
, (ByteString
"sinh", forall a. Floating a => a -> a
sinh), (ByteString
"cosh", forall a. Floating a => a -> a
cosh)
, (ByteString
"sin", forall a. Floating a => a -> a
sin), (ByteString
"cos", forall a. Floating a => a -> a
cos)
]
binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"" forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
]
var :: ParseTree
var = do ByteString -> Parser ByteString ByteString
string ByteString
"X_"
Int
ix <- forall a. Integral a => Parser a
decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var Int
ix
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"
parseGOMEA :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseGOMEA :: Bool -> [(ByteString, Int)] -> ParseTree
parseGOMEA = [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) forall {a}. [a]
binFuns ParseTree
var
where
binFuns :: [a]
binFuns = []
prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
[ (ByteString
"exp", forall a. Floating a => a -> a
exp), (ByteString
"plog", forall a. Floating a => a -> a
logforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs)
, (ByteString
"sqrt", forall a. Floating a => a -> a
sqrtforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs)
, (ByteString
"sin", forall a. Floating a => a -> a
sin), (ByteString
"cos", forall a. Floating a => a -> a
cos)
]
binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"aq" Fix SRTree -> Fix SRTree -> Fix SRTree
aq Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
]
var :: ParseTree
var = do ByteString -> Parser ByteString ByteString
string ByteString
"x"
Int
ix <- forall a. Integral a => Parser a
decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var Int
ix
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"
parsePySR :: Bool -> [(B.ByteString, Int)] -> ParseTree
parsePySR :: Bool -> [(ByteString, Int)] -> ParseTree
parsePySR = [[Operator ByteString (Fix SRTree)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [ParseTree -> ParseTree]
binFuns ParseTree
var
where
binFuns :: [ParseTree -> ParseTree]
binFuns = [ forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"pow" forall a. Floating a => a -> a -> a
(**) ]
prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
[ (ByteString
"abs", forall a. Num a => a -> a
abs), (ByteString
"exp", forall a. Floating a => a -> a
exp)
, (ByteString
"square", (forall a. Floating a => a -> a -> a
**Fix SRTree
2)), (ByteString
"cube", (forall a. Floating a => a -> a -> a
**Fix SRTree
3)), (ByteString
"neg", forall a. Num a => a -> a
negate)
, (ByteString
"acosh_abs", forall a. Floating a => a -> a
acosh forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Fix SRTree
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs), (ByteString
"acosh", forall a. Floating a => a -> a
acosh), (ByteString
"asinh", forall a. Floating a => a -> a
asinh)
, (ByteString
"acos", forall a. Floating a => a -> a
acos), (ByteString
"asin", forall a. Floating a => a -> a
asin), (ByteString
"atan", forall a. Floating a => a -> a
atan)
, (ByteString
"sqrt_abs", forall a. Floating a => a -> a
sqrtforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs), (ByteString
"sqrt", forall a. Floating a => a -> a
sqrt)
, (ByteString
"sinh", forall a. Floating a => a -> a
sinh), (ByteString
"cosh", forall a. Floating a => a -> a
cosh), (ByteString
"tanh", forall a. Floating a => a -> a
tanh)
, (ByteString
"sin", forall a. Floating a => a -> a
sin), (ByteString
"cos", forall a. Floating a => a -> a
cos), (ByteString
"tan", forall a. Floating a => a -> a
tan)
, (ByteString
"log10", Fix SRTree -> Fix SRTree
log10), (ByteString
"log2", Fix SRTree -> Fix SRTree
log2), (ByteString
"log1p", Fix SRTree -> Fix SRTree
log1p)
, (ByteString
"log_abs", forall a. Floating a => a -> a
logforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
abs), (ByteString
"log10_abs", Fix SRTree -> Fix SRTree
log10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs)
, (ByteString
"log", forall a. Floating a => a -> a
log)
]
binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft]
, [forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
]
var :: ParseTree
var = do ByteString -> Parser ByteString ByteString
string ByteString
"x"
Int
ix <- forall a. Integral a => Parser a
decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall val. Int -> SRTree val
Var Int
ix
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"