{-# language OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.ParseSR
-- Copyright   :  (c) Fabricio Olivetti 2021 - 2024
-- License     :  BSD3
-- Maintainer  :  fabricio.olivetti@gmail.com
-- Stability   :  experimental
-- Portability :  ConstraintKinds
--
-- Functions to parse a string representing an expression
--
-----------------------------------------------------------------------------
module Text.ParseSR ( parseSR, showOutput, SRAlgs(..), Output(..) ) 
    where

import Control.Applicative ((<|>))
import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.Expr
import qualified Data.ByteString.Char8 as B
import Data.Char (toLower)
import Data.List (sortOn)
import Data.SRTree
import qualified Data.SRTree.Print as P
import Debug.Trace (trace)

-- * 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 (Fix SRTree)

-- * Data types and caller functions

-- | Supported algorithms.
data SRAlgs = TIR | HL | OPERON | BINGO | GOMEA | PYSR | SBP | EPLEX deriving (Int -> SRAlgs -> ShowS
[SRAlgs] -> ShowS
SRAlgs -> String
(Int -> SRAlgs -> ShowS)
-> (SRAlgs -> String) -> ([SRAlgs] -> ShowS) -> Show SRAlgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SRAlgs -> ShowS
showsPrec :: Int -> SRAlgs -> ShowS
$cshow :: SRAlgs -> String
show :: SRAlgs -> String
$cshowList :: [SRAlgs] -> ShowS
showList :: [SRAlgs] -> ShowS
Show, ReadPrec [SRAlgs]
ReadPrec SRAlgs
Int -> ReadS SRAlgs
ReadS [SRAlgs]
(Int -> ReadS SRAlgs)
-> ReadS [SRAlgs]
-> ReadPrec SRAlgs
-> ReadPrec [SRAlgs]
-> Read SRAlgs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SRAlgs
readsPrec :: Int -> ReadS SRAlgs
$creadList :: ReadS [SRAlgs]
readList :: ReadS [SRAlgs]
$creadPrec :: ReadPrec SRAlgs
readPrec :: ReadPrec SRAlgs
$creadListPrec :: ReadPrec [SRAlgs]
readListPrec :: ReadPrec [SRAlgs]
Read, Int -> SRAlgs
SRAlgs -> Int
SRAlgs -> [SRAlgs]
SRAlgs -> SRAlgs
SRAlgs -> SRAlgs -> [SRAlgs]
SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs]
(SRAlgs -> SRAlgs)
-> (SRAlgs -> SRAlgs)
-> (Int -> SRAlgs)
-> (SRAlgs -> Int)
-> (SRAlgs -> [SRAlgs])
-> (SRAlgs -> SRAlgs -> [SRAlgs])
-> (SRAlgs -> SRAlgs -> [SRAlgs])
-> (SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs])
-> Enum 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
$csucc :: SRAlgs -> SRAlgs
succ :: SRAlgs -> SRAlgs
$cpred :: SRAlgs -> SRAlgs
pred :: SRAlgs -> SRAlgs
$ctoEnum :: Int -> SRAlgs
toEnum :: Int -> SRAlgs
$cfromEnum :: SRAlgs -> Int
fromEnum :: SRAlgs -> Int
$cenumFrom :: SRAlgs -> [SRAlgs]
enumFrom :: SRAlgs -> [SRAlgs]
$cenumFromThen :: SRAlgs -> SRAlgs -> [SRAlgs]
enumFromThen :: SRAlgs -> SRAlgs -> [SRAlgs]
$cenumFromTo :: SRAlgs -> SRAlgs -> [SRAlgs]
enumFromTo :: SRAlgs -> SRAlgs -> [SRAlgs]
$cenumFromThenTo :: SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs]
enumFromThenTo :: SRAlgs -> SRAlgs -> SRAlgs -> [SRAlgs]
Enum, SRAlgs
SRAlgs -> SRAlgs -> Bounded SRAlgs
forall a. a -> a -> Bounded a
$cminBound :: SRAlgs
minBound :: SRAlgs
$cmaxBound :: SRAlgs
maxBound :: SRAlgs
Bounded)

-- | Supported outputs.
data Output = PYTHON | MATH | TIKZ | LATEX deriving (Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> String
show :: Output -> String
$cshowList :: [Output] -> ShowS
showList :: [Output] -> ShowS
Show, ReadPrec [Output]
ReadPrec Output
Int -> ReadS Output
ReadS [Output]
(Int -> ReadS Output)
-> ReadS [Output]
-> ReadPrec Output
-> ReadPrec [Output]
-> Read Output
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Output
readsPrec :: Int -> ReadS Output
$creadList :: ReadS [Output]
readList :: ReadS [Output]
$creadPrec :: ReadPrec Output
readPrec :: ReadPrec Output
$creadListPrec :: ReadPrec [Output]
readListPrec :: ReadPrec [Output]
Read, Int -> Output
Output -> Int
Output -> [Output]
Output -> Output
Output -> Output -> [Output]
Output -> Output -> Output -> [Output]
(Output -> Output)
-> (Output -> Output)
-> (Int -> Output)
-> (Output -> Int)
-> (Output -> [Output])
-> (Output -> Output -> [Output])
-> (Output -> Output -> [Output])
-> (Output -> Output -> Output -> [Output])
-> Enum 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
$csucc :: Output -> Output
succ :: Output -> Output
$cpred :: Output -> Output
pred :: Output -> Output
$ctoEnum :: Int -> Output
toEnum :: Int -> Output
$cfromEnum :: Output -> Int
fromEnum :: Output -> Int
$cenumFrom :: Output -> [Output]
enumFrom :: Output -> [Output]
$cenumFromThen :: Output -> Output -> [Output]
enumFromThen :: Output -> Output -> [Output]
$cenumFromTo :: Output -> Output -> [Output]
enumFromTo :: Output -> Output -> [Output]
$cenumFromThenTo :: Output -> Output -> Output -> [Output]
enumFromThenTo :: Output -> Output -> Output -> [Output]
Enum, Output
Output -> Output -> Bounded Output
forall a. a -> a -> Bounded a
$cminBound :: Output
minBound :: Output
$cmaxBound :: Output
maxBound :: Output
Bounded)

-- | Returns the corresponding function from Data.SRTree.Print for a given `Output`.
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

-- | Calls the corresponding parser for a given `SRAlgs`
--
-- >>> fmap (showOutput MATH) $ parseSR OPERON "lambda,theta" False "lambda ^ 2 - sin(theta*3*lambda)"
-- Right "((x0 ^ 2.0) - Sin(((x1 * 3.0) * x0)))"
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 = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseHL Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
BINGO  ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseBingo Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
TIR    ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseTIR Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
OPERON ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseOperon Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
GOMEA  ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseGOMEA Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
SBP    ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseGOMEA Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
EPLEX  ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseGOMEA Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.strip
parseSR SRAlgs
PYSR   ByteString
header Bool
reparam = Result (Fix SRTree) -> Either String (Fix SRTree)
forall r. Result r -> Either String r
eitherResult (Result (Fix SRTree) -> Either String (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Either String (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` ByteString
"") (Result (Fix SRTree) -> Result (Fix SRTree))
-> (ByteString -> Result (Fix SRTree))
-> ByteString
-> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Fix SRTree) -> ByteString -> Result (Fix SRTree)
forall a. Parser a -> ByteString -> Result a
parse (Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parsePySR Bool
reparam ([(ByteString, Int)] -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, Int)]
splitHeader ByteString
header) (ByteString -> Result (Fix SRTree))
-> (ByteString -> ByteString) -> ByteString -> Result (Fix SRTree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
putEOL (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
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 = String -> Either String r -> Either String r
forall a. String -> a -> a
trace (Result r -> String
forall a. Show a => a -> String
show Result r
res) (Either String r -> Either String r)
-> Either String r -> Either String r
forall a b. (a -> b) -> a -> b
$ Result r -> Either String r
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  = Parser ByteString (a -> a -> a) -> Assoc -> Operator ByteString a
forall t a. Parser t (a -> a -> a) -> Assoc -> Operator t a
Infix (do{ ByteString -> Parser ByteString
string (Char -> ByteString -> ByteString
B.cons Char
' ' (ByteString -> Char -> ByteString
B.snoc ByteString
name Char
' ')) Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
string ByteString
name; (a -> a -> a) -> Parser ByteString (a -> a -> a)
forall a. a -> Parser ByteString a
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 = Parser ByteString (a -> a) -> Operator ByteString a
forall t a. Parser t (a -> a) -> Operator t a
Prefix (do{ ByteString -> Parser ByteString
string ByteString
name; (a -> a) -> Parser ByteString (a -> a)
forall a. a -> Parser ByteString a
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
"("; e' <- Parser a
e; string ")"; pure e' } Parser a -> String -> Parser a
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 (Fix SRTree)]] -> [ParseTree -> ParseTree] -> ParseTree -> Bool -> [(B.ByteString, Int)] -> ParseTree
parseExpr :: [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr [[Operator ByteString (Fix SRTree)]]
table [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns Parser (Fix SRTree)
var Bool
reparam [(ByteString, Int)]
header = do e <- Fix SRTree -> Fix SRTree
relabelParams (Fix SRTree -> Fix SRTree)
-> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Fix SRTree)
expr
                                                many1' space
                                                pure e
  where
    term :: Parser (Fix SRTree)
term  = Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a. Parser a -> Parser a
parens Parser (Fix SRTree)
expr Parser (Fix SRTree) -> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a. Num a => Parser a -> Parser a
enclosedAbs Parser (Fix SRTree)
expr Parser (Fix SRTree) -> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Parser (Fix SRTree)] -> Parser (Fix SRTree)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice (((Parser (Fix SRTree) -> Parser (Fix SRTree))
 -> Parser (Fix SRTree))
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> [Parser (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((Parser (Fix SRTree) -> Parser (Fix SRTree))
-> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ Parser (Fix SRTree)
expr) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns) Parser (Fix SRTree) -> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Fix SRTree)
coef Parser (Fix SRTree) -> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Fix SRTree)
varC Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
forall i a. Parser i a -> String -> Parser i a
<?> String
"term"
    expr :: Parser (Fix SRTree)
expr  = [[Operator ByteString (Fix SRTree)]]
-> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall t b.
Monoid t =>
[[Operator t b]] -> Parser t b -> Parser t b
buildExpressionParser [[Operator ByteString (Fix SRTree)]]
table Parser (Fix SRTree)
term
    coef :: Parser (Fix SRTree)
coef  = if Bool
reparam 
              then do eNumber <- Parser (Either Int Double)
intOrDouble
                      case eNumber of
                        Left Int
x  -> Fix SRTree -> Parser (Fix SRTree)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fix SRTree -> Parser (Fix SRTree))
-> Fix SRTree -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ Int -> Fix SRTree
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
                        Right Double
_ -> Fix SRTree -> Parser (Fix SRTree)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fix SRTree -> Parser (Fix SRTree))
-> Fix SRTree -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ Int -> Fix SRTree
param Int
0
              else SRTree (Fix SRTree) -> Fix SRTree
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SRTree (Fix SRTree) -> Fix SRTree)
-> (Double -> SRTree (Fix SRTree)) -> Double -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> SRTree (Fix SRTree)
forall val. Double -> SRTree val
Const (Double -> Fix SRTree)
-> Parser ByteString Double -> Parser (Fix SRTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double -> Parser ByteString Double
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Double
double Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
forall i a. Parser i a -> String -> Parser i a
<?> String
"const"
    varC :: Parser (Fix SRTree)
varC = if [(ByteString, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ByteString, Int)]
header
             then Parser (Fix SRTree)
var
             else Parser (Fix SRTree)
var Parser (Fix SRTree) -> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Fix SRTree)
varHeader

    varHeader :: Parser (Fix SRTree)
varHeader        = [Parser (Fix SRTree)] -> Parser (Fix SRTree)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice ([Parser (Fix SRTree)] -> Parser (Fix SRTree))
-> [Parser (Fix SRTree)] -> Parser (Fix SRTree)
forall a b. (a -> b) -> a -> b
$ ((ByteString, Int) -> Parser (Fix SRTree))
-> [(ByteString, Int)] -> [Parser (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Int -> Parser (Fix SRTree))
-> (ByteString, Int) -> Parser (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> Int -> Parser (Fix SRTree)
getParserVar) ([(ByteString, Int)] -> [Parser (Fix SRTree)])
-> [(ByteString, Int)] -> [Parser (Fix SRTree)]
forall a b. (a -> b) -> a -> b
$ ((ByteString, Int) -> Int)
-> [(ByteString, Int)] -> [(ByteString, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int)
-> ((ByteString, Int) -> Int) -> (ByteString, Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Int)
-> ((ByteString, Int) -> ByteString) -> (ByteString, Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Int) -> ByteString
forall a b. (a, b) -> a
fst) [(ByteString, Int)]
header
    getParserVar :: ByteString -> Int -> Parser (Fix SRTree)
getParserVar ByteString
k Int
v = (ByteString -> Parser ByteString
string ByteString
k Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
forall {b}. IsString b => ByteString -> Parser ByteString b
enveloped ByteString
k) Parser ByteString -> Parser (Fix SRTree) -> Parser (Fix SRTree)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fix SRTree -> Parser (Fix SRTree)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SRTree (Fix SRTree) -> Fix SRTree
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SRTree (Fix SRTree) -> Fix SRTree)
-> SRTree (Fix SRTree) -> Fix SRTree
forall a b. (a -> b) -> a -> b
$ Int -> SRTree (Fix SRTree)
forall val. Int -> SRTree val
Var Int
v)
    enveloped :: ByteString -> Parser ByteString b
enveloped ByteString
s      = (Char -> Parser ByteString Char
char Char
' ' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
char Char
'(') Parser ByteString Char -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString
string ByteString
s Parser ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Parser ByteString Char
char Char
' ' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
char Char
')') Parser ByteString Char
-> Parser ByteString b -> Parser ByteString b
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Parser ByteString b
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
""

enumerate :: [a] -> [(a, Int)]
enumerate :: forall a. [a] -> [(a, Int)]
enumerate = ([a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
0..])

splitHeader :: B.ByteString -> [(B.ByteString, Int)]
splitHeader :: ByteString -> [(ByteString, Int)]
splitHeader = [ByteString] -> [(ByteString, Int)]
forall a. [a] -> [(a, Int)]
enumerate ([ByteString] -> [(ByteString, Int)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(ByteString, Int)]
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 = Parser ByteString Int
-> Parser ByteString Double -> Parser (Either Int Double)
forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherP Parser ByteString Int
parseInt (Parser ByteString Double -> Parser ByteString Double
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Double
double)
  where
      parseInt :: Parser Int
      parseInt :: Parser ByteString Int
parseInt = do x <- Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal
                    c <- peekChar
                    case c of                      
                      Just Char
'.' -> Parser ByteString Char
digit Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
                      Just Char
'e' -> Parser ByteString Char
digit Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
                      Just Char
'E' -> Parser ByteString Char
digit Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
                      Maybe Char
_   -> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
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 Char -> Char -> Bool
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 :: Fix SRTree -> Fix SRTree -> Fix SRTree
aq :: Fix SRTree -> Fix SRTree -> Fix SRTree
aq Fix SRTree
x Fix SRTree
y = Fix SRTree
x Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
/ Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt (Fix SRTree
1 Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
+ Fix SRTree
y Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
** Fix SRTree
2)

log1p :: Fix SRTree -> Fix SRTree
log1p :: Fix SRTree -> Fix SRTree
log1p Fix SRTree
x = Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log (Fix SRTree
1 Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
+ Fix SRTree
x)

log10 :: Fix SRTree -> Fix SRTree
log10 :: Fix SRTree -> Fix SRTree
log10 Fix SRTree
x = Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log Fix SRTree
x Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
/ Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log Fix SRTree
10

log2 :: Fix SRTree -> Fix SRTree
log2 :: Fix SRTree -> Fix SRTree
log2 Fix SRTree
x = Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log Fix SRTree
x Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
/ Fix SRTree -> Fix SRTree
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 Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
** (Fix SRTree
1Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
/Fix SRTree
3)

-- 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 ByteString Char
char Char
'|'
                      e <- Parser a
expr
                      char '|'
                      pure $ abs 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
                        Parser ByteString Char -> Parser ByteString String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ByteString Char
space Parser ByteString String
-> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser ByteString Char
char Char
'(' Parser ByteString Char
-> Parser ByteString String -> Parser ByteString String
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Char -> Parser ByteString String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ByteString Char
space
                        e1 <- Parser a
expr
                        many' space >> char ',' >> many' space -- many' space >> char ',' >> many' space
                        e2 <- expr
                        many' space >> char ')'
                        pure $ f e1 e2 

-- * Custom parsers for SR algorithms

-- | parser for Transformation-Interaction-Rational.
parseTIR :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseTIR :: Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseTIR = [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps [Operator ByteString (Fix SRTree)]
-> [[Operator ByteString (Fix SRTree)]]
-> [[Operator ByteString (Fix SRTree)]]
forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
forall {a}. [a]
binFuns Parser (Fix SRTree)
var
  where
    binFuns :: [a]
binFuns   = [ ]
    prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = ((ByteString, Fix SRTree -> Fix SRTree)
 -> Operator ByteString (Fix SRTree))
-> [(ByteString, Fix SRTree -> Fix SRTree)]
-> [Operator ByteString (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
 -> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree))
-> (ByteString, Fix SRTree -> Fix SRTree)
-> Operator ByteString (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString
-> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree)
forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
                [   (ByteString
"id", Fix SRTree -> Fix SRTree
forall a. a -> a
id), (ByteString
"abs", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                  , (ByteString
"sinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sinh), (ByteString
"cosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cosh), (ByteString
"tanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tanh)
                  , (ByteString
"sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin), (ByteString
"cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos), (ByteString
"tan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tan)
                  , (ByteString
"asinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asinh), (ByteString
"acosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acosh), (ByteString
"atanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
atanh)
                  , (ByteString
"asin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asin), (ByteString
"acos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acos), (ByteString
"atan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
atan)
                  , (ByteString
"sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt), (ByteString
"cbrt", Fix SRTree -> Fix SRTree
cbrt), (ByteString
"square", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
2))
                  , (ByteString
"log", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log), (ByteString
"exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp)
                  , (ByteString
"Id", Fix SRTree -> Fix SRTree
forall a. a -> a
id), (ByteString
"Abs", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                  , (ByteString
"Sinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sinh), (ByteString
"Cosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cosh), (ByteString
"Tanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tanh)
                  , (ByteString
"Sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin), (ByteString
"Cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos), (ByteString
"Tan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tan)
                  , (ByteString
"ASinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asinh), (ByteString
"ACosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acosh), (ByteString
"ATanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
atanh)
                  , (ByteString
"ASin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asin), (ByteString
"ACos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acos), (ByteString
"ATan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
atan)
                  , (ByteString
"Sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt), (ByteString
"Cbrt", Fix SRTree -> Fix SRTree
cbrt), (ByteString
"Square", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
2))
                  , (ByteString
"Log", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log), (ByteString
"Exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp)
                ]
    binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft], [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"**" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
            ]
    var :: Parser (Fix SRTree)
var = do Char -> Parser ByteString Char
char Char
'x'
             ix <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
             pure $ Fix $ Var ix
          Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
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)] -> Parser (Fix SRTree)
parseOperon = [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps [Operator ByteString (Fix SRTree)]
-> [[Operator ByteString (Fix SRTree)]]
-> [[Operator ByteString (Fix SRTree)]]
forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns Parser (Fix SRTree)
var
  where
    binFuns :: [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns   = [ ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Parser (Fix SRTree)
-> Parser (Fix SRTree)
forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"pow" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) ]
    prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = ((ByteString, Fix SRTree -> Fix SRTree)
 -> Operator ByteString (Fix SRTree))
-> [(ByteString, Fix SRTree -> Fix SRTree)]
-> [Operator ByteString (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
 -> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree))
-> (ByteString, Fix SRTree -> Fix SRTree)
-> Operator ByteString (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString
-> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree)
forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
                [ (ByteString
"abs", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"cbrt", Fix SRTree -> Fix SRTree
cbrt)
                , (ByteString
"acos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acos), (ByteString
"cosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cosh), (ByteString
"cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos)
                , (ByteString
"asin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asin), (ByteString
"sinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sinh), (ByteString
"sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin)
                , (ByteString
"exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp), (ByteString
"log", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log)
                , (ByteString
"sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt), (ByteString
"square", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
2))
                , (ByteString
"atan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
atan), (ByteString
"tanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tanh), (ByteString
"tan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tan)
                ]
    binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
            ]
    var :: Parser (Fix SRTree)
var = do Char -> Parser ByteString Char
char Char
'X'
             ix <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
             pure $ Fix $ Var (ix - 1) -- Operon is not 0-based
          Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
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)] -> Parser (Fix SRTree)
parseHL = [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps [Operator ByteString (Fix SRTree)]
-> [[Operator ByteString (Fix SRTree)]]
-> [[Operator ByteString (Fix SRTree)]]
forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns Parser (Fix SRTree)
var
  where
    binFuns :: [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns   = [ ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Parser (Fix SRTree)
-> Parser (Fix SRTree)
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 = ((ByteString, Fix SRTree -> Fix SRTree)
 -> Operator ByteString (Fix SRTree))
-> [(ByteString, Fix SRTree -> Fix SRTree)]
-> [Operator ByteString (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
 -> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree))
-> (ByteString, Fix SRTree -> Fix SRTree)
-> Operator ByteString (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString
-> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree)
forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
                [ (ByteString
"logabs", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"sqrtabs", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs) -- the longer versions should come first
                , (ByteString
"abs", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp), (ByteString
"log", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log)
                , (ByteString
"sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt), (ByteString
"sqr", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
2)), (ByteString
"cube", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
3))
                , (ByteString
"cbrt", Fix SRTree -> Fix SRTree
cbrt), (ByteString
"sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin), (ByteString
"cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos)
                , (ByteString
"tan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tan), (ByteString
"tanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tanh)
                ]
    binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
            ]
    var :: Parser (Fix SRTree)
var = do Char -> Parser ByteString Char
char Char
'x'
             ix <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
             pure $ Fix $ Var ix
          Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
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)] -> Parser (Fix SRTree)
parseBingo = [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps [Operator ByteString (Fix SRTree)]
-> [[Operator ByteString (Fix SRTree)]]
-> [[Operator ByteString (Fix SRTree)]]
forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
forall {a}. [a]
binFuns Parser (Fix SRTree)
var
  where
    binFuns :: [a]
binFuns = []
    prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = ((ByteString, Fix SRTree -> Fix SRTree)
 -> Operator ByteString (Fix SRTree))
-> [(ByteString, Fix SRTree -> Fix SRTree)]
-> [Operator ByteString (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
 -> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree))
-> (ByteString, Fix SRTree -> Fix SRTree)
-> Operator ByteString (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString
-> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree)
forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
                [ (ByteString
"abs", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp), (ByteString
"log", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                , (ByteString
"sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                , (ByteString
"sinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sinh), (ByteString
"cosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cosh)
                , (ByteString
"sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin), (ByteString
"cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos)
                ]
    binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
            ]
    var :: Parser (Fix SRTree)
var = do ByteString -> Parser ByteString
string ByteString
"X_"
             ix <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
             pure $ Fix $ Var ix
          Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"

-- | parser for GOMEA
parseGOMEA :: Bool -> [(B.ByteString, Int)] -> ParseTree
parseGOMEA :: Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parseGOMEA = [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps [Operator ByteString (Fix SRTree)]
-> [[Operator ByteString (Fix SRTree)]]
-> [[Operator ByteString (Fix SRTree)]]
forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
forall {a}. [a]
binFuns Parser (Fix SRTree)
var
  where
    binFuns :: [a]
binFuns = []
    prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = ((ByteString, Fix SRTree -> Fix SRTree)
 -> Operator ByteString (Fix SRTree))
-> [(ByteString, Fix SRTree -> Fix SRTree)]
-> [Operator ByteString (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
 -> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree))
-> (ByteString, Fix SRTree -> Fix SRTree)
-> Operator ByteString (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString
-> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree)
forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
                [ (ByteString
"exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp), (ByteString
"plog", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                , (ByteString
"sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                , (ByteString
"sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin), (ByteString
"cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos)
                ]
    binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"aq" Fix SRTree -> Fix SRTree -> Fix SRTree
aq Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
            ]
    var :: Parser (Fix SRTree)
var = do ByteString -> Parser ByteString
string ByteString
"x"
             ix <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
             pure $ Fix $ Var ix
          Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"

-- | parser for PySR
parsePySR :: Bool -> [(B.ByteString, Int)] -> ParseTree
parsePySR :: Bool -> [(ByteString, Int)] -> Parser (Fix SRTree)
parsePySR = [[Operator ByteString (Fix SRTree)]]
-> [Parser (Fix SRTree) -> Parser (Fix SRTree)]
-> Parser (Fix SRTree)
-> Bool
-> [(ByteString, Int)]
-> Parser (Fix SRTree)
parseExpr ([Operator ByteString (Fix SRTree)]
prefixOps [Operator ByteString (Fix SRTree)]
-> [[Operator ByteString (Fix SRTree)]]
-> [[Operator ByteString (Fix SRTree)]]
forall a. a -> [a] -> [a]
: [[Operator ByteString (Fix SRTree)]]
binOps) [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns Parser (Fix SRTree)
var
  where
    binFuns :: [Parser (Fix SRTree) -> Parser (Fix SRTree)]
binFuns   = [ ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Parser (Fix SRTree)
-> Parser (Fix SRTree)
forall a. ByteString -> (a -> a -> a) -> Parser a -> Parser a
binFun ByteString
"pow" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) ]
    prefixOps :: [Operator ByteString (Fix SRTree)]
prefixOps = ((ByteString, Fix SRTree -> Fix SRTree)
 -> Operator ByteString (Fix SRTree))
-> [(ByteString, Fix SRTree -> Fix SRTree)]
-> [Operator ByteString (Fix SRTree)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
 -> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree))
-> (ByteString, Fix SRTree -> Fix SRTree)
-> Operator ByteString (Fix SRTree)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString
-> (Fix SRTree -> Fix SRTree) -> Operator ByteString (Fix SRTree)
forall a. ByteString -> (a -> a) -> Operator ByteString a
prefix)
                [ (ByteString
"abs", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"exp", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
exp)
                , (ByteString
"square", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
2)), (ByteString
"cube", (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
**Fix SRTree
3)), (ByteString
"neg", Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
negate)
                , (ByteString
"acosh_abs", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acosh (Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
+Fix SRTree
1) (Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"acosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acosh), (ByteString
"asinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asinh)
                , (ByteString
"acos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
acos), (ByteString
"asin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
asin), (ByteString
"atan", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
atan)
                , (ByteString
"sqrt_abs", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"sqrt", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sqrt)
                , (ByteString
"sinh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sinh), (ByteString
"cosh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cosh), (ByteString
"tanh", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
tanh)
                , (ByteString
"sin", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
sin), (ByteString
"cos", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
cos), (ByteString
"tan", Fix SRTree -> Fix SRTree
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", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log(Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs), (ByteString
"log10_abs", Fix SRTree -> Fix SRTree
log10 (Fix SRTree -> Fix SRTree)
-> (Fix SRTree -> Fix SRTree) -> Fix SRTree -> Fix SRTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix SRTree -> Fix SRTree
forall a. Num a => a -> a
abs)
                , (ByteString
"log", Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a
log)
                ]
    binOps :: [[Operator ByteString (Fix SRTree)]]
binOps = [[ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"^" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Floating a => a -> a -> a
(**) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"/" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Fractional a => a -> a -> a
(/) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"*" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(*) Assoc
AssocLeft]
            , [ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"+" Fix SRTree -> Fix SRTree -> Fix SRTree
forall a. Num a => a -> a -> a
(+) Assoc
AssocLeft, ByteString
-> (Fix SRTree -> Fix SRTree -> Fix SRTree)
-> Assoc
-> Operator ByteString (Fix SRTree)
forall a.
ByteString -> (a -> a -> a) -> Assoc -> Operator ByteString a
binary ByteString
"-" (-) Assoc
AssocLeft]
            ]
    var :: Parser (Fix SRTree)
var = do ByteString -> Parser ByteString
string ByteString
"x"
             ix <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
             pure $ Fix $ Var ix
          Parser (Fix SRTree) -> String -> Parser (Fix SRTree)
forall i a. Parser i a -> String -> Parser i a
<?> String
"var"