{-# 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 Debug.Trace ( trace )
import Data.SRTree

-- * Data types

-- | Parser of a symbolic regression tree with `Int` variable index and
-- numerical values represented as `Double`. The numerical values type
-- can be changed with `fmap`.
type ParseTree = Parser (SRTree Int Double)

-- * Data types and caller functions

-- | Supported algorithms.
data SRAlgs = TIR | HL | OPERON | BINGO 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)

-- | Supported outputs.
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)

-- | Returns the corresponding function from Data.SRTree.Print for a given `Output`.
showOutput :: Output -> SRTree Int Double -> String
showOutput :: Output -> SRTree Int Double -> String
showOutput Output
PYTHON = forall {ix} {val}. (Show ix, Show val) => SRTree ix val -> String
P.showPython
showOutput Output
MATH   = forall {ix} {val}. (Show ix, Show val) => SRTree ix val -> String
P.showDefault
showOutput Output
TIKZ   = forall ix val.
(Show ix, Show val, RealFrac val) =>
SRTree ix val -> String
P.showTikz
showOutput Output
LATEX  = forall {ix} {val}. (Show ix, Show val) => SRTree ix val -> String
P.showLatex

-- | Calls the corresponding parser for a given `SRAlgs`
parseSR :: SRAlgs -> B.ByteString -> Bool -> B.ByteString -> Either String (SRTree Int Double)
parseSR :: SRAlgs
-> ByteString
-> Bool
-> ByteString
-> Either String (SRTree Int Double)
parseSR SRAlgs
HL     ByteString
header Bool
param = 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
param 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
parseSR SRAlgs
BINGO  ByteString
header Bool
param = 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
param 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
parseSR SRAlgs
TIR    ByteString
header Bool
param = 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
param 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
parseSR SRAlgs
OPERON ByteString
header Bool
param = 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
param 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

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

-- * Parsers

-- | Creates a parser for a binary operator
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
string ByteString
name; forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a -> a
fun })

-- | Creates a parser for a unary function
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
string ByteString
name; forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
fun })

-- | Envelopes the parser in parens
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens Parser a
e = do{ ByteString -> Parser ByteString
string ByteString
"("; a
e' <- Parser a
e; ByteString -> Parser 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"

-- | Parse an expression using a user-defined parser given by the `Operator` lists containing
-- the name of the functions and operators of that SR algorithm, a list of parsers `binFuns` for binary functions
-- a parser `var` for variables, a boolean indicating whether to change floating point values to free
-- parameters variables, and a list of variable names with their corresponding indexes.
parseExpr :: [[Operator B.ByteString (SRTree Int Double)]] -> [ParseTree -> ParseTree] -> ParseTree -> Bool -> [(B.ByteString, Int)] -> ParseTree
parseExpr :: [[Operator ByteString (SRTree Int Double)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr [[Operator ByteString (SRTree Int Double)]]
table [ParseTree -> ParseTree]
binFuns ParseTree
var Bool
param [(ByteString, Int)]
header = do SRTree Int Double
e <- forall ix val. Num ix => SRTree ix val -> SRTree ix val
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 SRTree Int Double
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 (SRTree Int Double)]]
table ParseTree
term
    coef :: ParseTree
coef  = if Bool
param 
              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 ix val. val -> SRTree ix val
Const (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
$ forall ix val. ix -> SRTree ix val
Param Int
0
              else forall ix val. val -> SRTree ix 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
<|> forall {val}. Parser ByteString (SRTree Int val)
varHeader

    varHeader :: Parser ByteString (SRTree Int val)
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 forall {ix} {val}.
ByteString -> ix -> Parser ByteString (SRTree ix val)
getParserVar) [(ByteString, Int)]
header
    getParserVar :: ByteString -> ix -> Parser ByteString (SRTree ix val)
getParserVar ByteString
k ix
v = (ByteString -> Parser 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 ix val. ix -> SRTree ix val
Var ix
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
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)]
splitHeader :: ByteString -> [(ByteString, Int)]
splitHeader = forall a. [a] -> [(a, Int)]
enumerate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
B.split Char
','

-- | Tries to parse as an `Int`, if it fails, 
-- parse as a Double.
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'

-- * Special case functions

-- | analytic quotient
aq :: Floating a => a -> a -> a
aq :: forall a. Floating a => a -> a -> a
aq a
x a
y = a
x forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt (a
1 forall a. Num a => a -> a -> a
+ a
y forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int))

-- Parse `abs` functions as | x |
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

-- | Parser for binary functions
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
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 -- many' space >> char ',' >> many' 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 

-- * Custom parsers for SR algorithms

-- | parser for Transformation-Interaction-Rational.
parseTIR :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseTIR :: Bool -> [(ByteString, Int)] -> ParseTree
parseTIR = [[Operator ByteString (SRTree Int Double)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (SRTree Int Double)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (SRTree Int Double)]]
binOps) forall {a}. [a]
binFuns forall {val}. Parser ByteString (SRTree Int val)
var
  where
    binFuns :: [a]
binFuns   = [ ]
    prefixOps :: [Operator ByteString (SRTree Int Double)]
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", forall ix val. Function -> SRTree ix val -> SRTree ix val
Fun Function
Cbrt), (ByteString
"Square", (forall a. Floating a => a -> a -> a
**SRTree Int Double
2))
                  , (ByteString
"Log", forall a. Floating a => a -> a
log), (ByteString
"Exp", forall a. Floating a => a -> a
exp)
                ]
    binOps :: [[Operator ByteString (SRTree Int Double)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall ix val. SRTree ix val -> SRTree ix val -> SRTree ix val
Power 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]
            ]
    var :: Parser ByteString (SRTree Int val)
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 ix val. ix -> SRTree ix val
Var Int
ix
          forall i a. Parser i a -> String -> Parser i a
<?> String
"var"

-- | parser for Operon.
parseOperon :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseOperon :: Bool -> [(ByteString, Int)] -> ParseTree
parseOperon = [[Operator ByteString (SRTree Int Double)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (SRTree Int Double)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (SRTree Int Double)]]
binOps) forall {ix} {val}.
[Parser (SRTree ix val) -> Parser (SRTree ix val)]
binFuns forall {val}. Parser ByteString (SRTree Int val)
var
  where
    binFuns :: [Parser (SRTree ix val) -> Parser (SRTree ix val)]
binFuns   = [ forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"pow" forall ix val. SRTree ix val -> SRTree ix val -> SRTree ix val
Power ]
    prefixOps :: [Operator ByteString (SRTree Int Double)]
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", forall ix val. Function -> SRTree ix val -> SRTree ix val
Fun Function
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
**SRTree Int Double
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 (SRTree Int Double)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall ix val. SRTree ix val -> SRTree ix val -> SRTree ix val
Power 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 :: Parser ByteString (SRTree Int val)
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 ix val. ix -> SRTree ix val
Var (Int
ix forall a. Num a => a -> a -> a
- Int
1) -- Operon is not 0-based
          forall i a. Parser i a -> String -> Parser i a
<?> String
"var"

-- | parser for HeuristicLab.
parseHL :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseHL :: Bool -> [(ByteString, Int)] -> ParseTree
parseHL = [[Operator ByteString (SRTree Int Double)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (SRTree Int Double)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (SRTree Int Double)]]
binOps) [ParseTree -> ParseTree]
binFuns forall {val}. Parser ByteString (SRTree Int val)
var
  where
    binFuns :: [ParseTree -> ParseTree]
binFuns   = [ forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"aq" forall a. Floating a => a -> a -> a
aq ]
    prefixOps :: [Operator ByteString (SRTree Int Double)]
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) -- the longer versions should come first
                , (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
**SRTree Int Double
2)), (ByteString
"cube", (forall a. Floating a => a -> a -> a
**SRTree Int Double
3))
                , (ByteString
"cbrt", forall ix val. Function -> SRTree ix val -> SRTree ix val
Fun Function
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 (SRTree Int Double)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall ix val. SRTree ix val -> SRTree ix val -> SRTree ix val
Power 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 :: Parser ByteString (SRTree Int val)
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 ix val. ix -> SRTree ix val
Var Int
ix
          forall i a. Parser i a -> String -> Parser i a
<?> String
"var"

-- | parser for Bingo
parseBingo :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseBingo :: Bool -> [(ByteString, Int)] -> ParseTree
parseBingo = [[Operator ByteString (SRTree Int Double)]]
-> [ParseTree -> ParseTree]
-> ParseTree
-> Bool
-> [(ByteString, Int)]
-> ParseTree
parseExpr ([Operator ByteString (SRTree Int Double)]
prefixOps forall a. a -> [a] -> [a]
: [[Operator ByteString (SRTree Int Double)]]
binOps) forall {a}. [a]
binFuns forall {val}. Parser ByteString (SRTree Int val)
var
  where
    binFuns :: [a]
binFuns = []
    prefixOps :: [Operator ByteString (SRTree Int Double)]
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 (SRTree Int Double)]]
binOps = [[forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" forall ix val. SRTree ix val -> SRTree ix val -> SRTree ix val
Power 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 :: Parser ByteString (SRTree Int val)
var = do ByteString -> Parser 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 ix val. ix -> SRTree ix val
Var Int
ix
          forall i a. Parser i a -> String -> Parser i a
<?> String
"var"