diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,18 @@ - Simplification with Equality Saturation - Added CI tests +## 0.2.1.0 - 2023-04-30 + +- Changed to srtree-1.0.0.1 +- Fixed not parsing white spaces between operators +- Simplification disabled for now + +## 0.1.1.0 - 2023-02-13 + +- Added support to GP-GOMEA +- Added support to PySR +- Added `-simplify` flag to apply `SRTree` simplification + ## 0.1.0.1 - 2023-01-13 ### Changed diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ [![hackage release](https://img.shields.io/hackage/v/pandoc-symreg.svg?label=hackage)](https://hackage.haskell.org/package/pandoc-symreg) [![stackage LTS -package](https://stackage.org/package/pandoc-symreg/badge/lts)](https://www.stackage.org/lts/package/pandoc-symreg-types) +package](https://www.stackage.org/package/pandoc-symreg/badge/nightly)](https://www.stackage.org/nightly/package/pandoc-symreg) [![CI tests](https://github.com/folivetti/pandoc-symreg/workflows/CI%20tests/badge.svg)](https://github.com/folivetti/pandoc-symreg/actions) [![license](https://img.shields.io/badge/license-GPLv3+-lightgray.svg)](https://www.gnu.org/licenses/gpl.html) @@ -18,6 +18,10 @@ - `HL` ([HeuristicLab](https://github.com/heal-research/HeuristicLab)) - `Operon` ([Operon](https://github.com/heal-research/operon)) - `Bingo` ([Bingo](https://github.com/nasa/bingo/tree/master/bingo)) +- `GP-GOMEA` ([GP-GOMEA](https://github.com/marcovirgolin/GP-GOMEA)) +- `PySR` ([PySR](https://github.com/MilesCranmer/PySR)) +- `SBP` ([SBP](https://github.com/marcovirgolin/GP-GOMEA)) +- `EPLEX` And it can convert *to* diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -38,6 +38,7 @@ , outfile :: String , varnames :: String , parameters :: Bool + , simpl :: Bool } deriving Show opt :: Parser Args @@ -77,11 +78,14 @@ ( long "parameters" <> short 'p' <> help "Convert floating point numbers to free parameters." ) + <*> switch + ( long "simplify" + <> help "Apply basic simplification." ) main :: IO () main = do args <- execParser opts - withInput (infile args) (from args) (varnames args) (parameters args) + withInput (infile args) (from args) (varnames args) (parameters args) (simpl args) >>= withOutput (outfile args) (to args) where opts = info (opt <**> helper) diff --git a/pandoc-symreg.cabal b/pandoc-symreg.cabal --- a/pandoc-symreg.cabal +++ b/pandoc-symreg.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: pandoc-symreg -version: 0.1.0.1 +version: 0.2.0.0 synopsis: A tool to convert symbolic regression expressions into different formats. description: A pandoc-like cli tool and library to convert symbolic regression expressions to convenient formats category: Text, Math @@ -41,7 +41,7 @@ , bytestring ==0.11.* , mtl ==2.2.* , optparse-applicative ==0.17.* - , srtree >=0.1.2.1 && <0.1.3 + , srtree >=1.0.0.1 && <1.1 default-language: Haskell2010 executable pandoc-symreg @@ -59,7 +59,7 @@ , mtl ==2.2.* , optparse-applicative ==0.17.* , pandoc-symreg - , srtree >=0.1.2.1 && <0.1.3 + , srtree >=1.0.0.1 && <1.1 default-language: Haskell2010 test-suite pandoc-symreg-test @@ -78,5 +78,5 @@ , mtl ==2.2.* , optparse-applicative ==0.17.* , pandoc-symreg - , srtree >=0.1.2.1 && <0.1.3 + , srtree >=1.0.0.1 && <1.1 default-language: Haskell2010 diff --git a/src/Text/ParseSR.hs b/src/Text/ParseSR.hs --- a/src/Text/ParseSR.hs +++ b/src/Text/ParseSR.hs @@ -7,38 +7,44 @@ import qualified Data.ByteString.Char8 as B import Control.Applicative ( (<|>) ) import qualified Data.SRTree.Print as P +import Data.List ( sortOn ) import Debug.Trace ( trace ) import Data.SRTree +import Data.SRTree.Recursion (Fix(..)) -- * 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) +type ParseTree = Parser (Fix SRTree) -- * Data types and caller functions -- | Supported algorithms. -data SRAlgs = TIR | HL | OPERON | BINGO deriving (Show, Read, Enum, Bounded) +data SRAlgs = TIR | HL | OPERON | BINGO | GOMEA | PYSR | SBP | EPLEX deriving (Show, Read, Enum, Bounded) -- | Supported outputs. data Output = PYTHON | MATH | TIKZ | LATEX deriving (Show, Read, Enum, Bounded) -- | Returns the corresponding function from Data.SRTree.Print for a given `Output`. -showOutput :: Output -> SRTree Int Double -> String +showOutput :: Output -> Fix SRTree -> String showOutput PYTHON = P.showPython -showOutput MATH = P.showDefault +showOutput MATH = P.showExpr showOutput TIKZ = P.showTikz showOutput LATEX = P.showLatex -- | Calls the corresponding parser for a given `SRAlgs` -parseSR :: SRAlgs -> B.ByteString -> Bool -> B.ByteString -> Either String (SRTree Int Double) -parseSR HL header param = eitherResult . (`feed` "") . parse (parseHL param $ splitHeader header) . putEOL -parseSR BINGO header param = eitherResult . (`feed` "") . parse (parseBingo param $ splitHeader header) . putEOL -parseSR TIR header param = eitherResult . (`feed` "") . parse (parseTIR param $ splitHeader header) . putEOL -parseSR OPERON header param = eitherResult . (`feed` "") . parse (parseOperon param $ splitHeader header) . putEOL +parseSR :: SRAlgs -> B.ByteString -> Bool -> B.ByteString -> Either String (Fix SRTree) +parseSR HL header reparam = eitherResult . (`feed` "") . parse (parseHL reparam $ splitHeader header) . putEOL . B.strip +parseSR BINGO header reparam = eitherResult . (`feed` "") . parse (parseBingo reparam $ splitHeader header) . putEOL . B.strip +parseSR TIR header reparam = eitherResult . (`feed` "") . parse (parseTIR reparam $ splitHeader header) . putEOL . B.strip +parseSR OPERON header reparam = eitherResult . (`feed` "") . parse (parseOperon reparam $ splitHeader header) . putEOL . B.strip +parseSR GOMEA header reparam = eitherResult . (`feed` "") . parse (parseGOMEA reparam $ splitHeader header) . putEOL . B.strip +parseSR SBP header reparam = eitherResult . (`feed` "") . parse (parseGOMEA reparam $ splitHeader header) . putEOL . B.strip +parseSR EPLEX header reparam = eitherResult . (`feed` "") . parse (parseGOMEA reparam $ splitHeader header) . putEOL . B.strip +parseSR PYSR header reparam = eitherResult . (`feed` "") . parse (parsePySR reparam $ splitHeader header) . putEOL . B.strip eitherResult' :: Show r => Result r -> Either String r eitherResult' res = trace (show res) $ eitherResult res @@ -47,7 +53,7 @@ -- | Creates a parser for a binary operator binary :: B.ByteString -> (a -> a -> a) -> Assoc -> Operator B.ByteString a -binary name fun = Infix (do{ string name; pure fun }) +binary name fun = Infix (do{ string (B.cons ' ' (B.snoc name ' ')) <|> string name; pure fun }) -- | Creates a parser for a unary function prefix :: B.ByteString -> (a -> a) -> Operator B.ByteString a @@ -61,25 +67,25 @@ -- 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 table binFuns var param header = do e <- relabelParams <$> expr - many1' space - pure e +parseExpr :: [[Operator B.ByteString (Fix SRTree)]] -> [ParseTree -> ParseTree] -> ParseTree -> Bool -> [(B.ByteString, Int)] -> ParseTree +parseExpr table binFuns var reparam header = do e <- relabelParams <$> expr + many1' space + pure e where term = parens expr <|> enclosedAbs expr <|> choice (map ($ expr) binFuns) <|> coef <|> varC "term" expr = buildExpressionParser table term - coef = if param + coef = if reparam then do eNumber <- intOrDouble case eNumber of - Left x -> pure $ Const (fromIntegral x) - Right _ -> pure $ Param 0 - else Const <$> signed double "const" + Left x -> pure $ fromIntegral x + Right _ -> pure $ param 0 + else Fix . Const <$> signed double "const" varC = if null header then var else var <|> varHeader - varHeader = choice $ map (uncurry getParserVar) header - getParserVar k v = (string k <|> enveloped k) >> pure (Var v) + varHeader = choice $ map (uncurry getParserVar) $ sortOn (negate . B.length . fst) header + getParserVar k v = (string k <|> enveloped k) >> pure (Fix $ Var v) enveloped s = (char ' ' <|> char '(') >> string s >> (char ' ' <|> char ')') >> pure "" enumerate :: [a] -> [(a, Int)] @@ -109,9 +115,21 @@ -- * Special case functions -- | analytic quotient -aq :: Floating a => a -> a -> a -aq x y = x / sqrt (1 + y ^ (2 :: Int)) +aq :: Fix SRTree -> Fix SRTree -> Fix SRTree +aq x y = x / sqrt (1 + y ** 2) +log1p :: Fix SRTree -> Fix SRTree +log1p x = log (1 + x) + +log10 :: Fix SRTree -> Fix SRTree +log10 x = log x / log 10 + +log2 :: Fix SRTree -> Fix SRTree +log2 x = log x / log 2 + +cbrt :: Fix SRTree -> Fix SRTree +cbrt x = x ** (1/3) + -- Parse `abs` functions as | x | enclosedAbs :: Num a => Parser a -> Parser a enclosedAbs expr = do char '|' @@ -142,38 +160,38 @@ , ("Sin", sin), ("Cos", cos), ("Tan", tan) , ("ASinh", asinh), ("ACosh", acosh), ("ATanh", atanh) , ("ASin", asin), ("ACos", acos), ("ATan", atan) - , ("Sqrt", sqrt), ("Cbrt", Fun Cbrt), ("Square", (**2)) + , ("Sqrt", sqrt), ("Cbrt", cbrt), ("Square", (**2)) , ("Log", log), ("Exp", exp) ] - binOps = [[binary "^" Power AssocLeft] - , [binary " * " (*) AssocLeft, binary " / " (/) AssocLeft] - , [binary " + " (+) AssocLeft] + binOps = [[binary "^" (**) AssocLeft], [binary "**" (**) AssocLeft] + , [binary "*" (*) AssocLeft, binary "/" (/) AssocLeft] + , [binary "+" (+) AssocLeft, binary "-" (+) AssocLeft] ] var = do char 'x' ix <- decimal - pure $ Var ix + pure $ Fix $ Var ix "var" -- | parser for Operon. parseOperon :: Bool -> [(B.ByteString, Int)] -> ParseTree parseOperon = parseExpr (prefixOps : binOps) binFuns var where - binFuns = [ binFun "pow" Power ] + binFuns = [ binFun "pow" (**) ] prefixOps = map (uncurry prefix) - [ ("abs", abs), ("cbrt", Fun Cbrt) + [ ("abs", abs), ("cbrt", cbrt) , ("acos", acos), ("cosh", cosh), ("cos", cos) , ("asin", asin), ("sinh", sinh), ("sin", sin) , ("exp", exp), ("log", log) , ("sqrt", sqrt), ("square", (**2)) , ("atan", atan), ("tanh", tanh), ("tan", tan) ] - binOps = [[binary "^" Power AssocLeft] - , [binary " * " (*) AssocLeft, binary " / " (/) AssocLeft] - , [binary " + " (+) AssocLeft, binary " - " (-) AssocLeft] + binOps = [[binary "^" (**) AssocLeft] + , [binary "*" (*) AssocLeft, binary "/" (/) AssocLeft] + , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft] ] var = do char 'X' ix <- decimal - pure $ Var (ix - 1) -- Operon is not 0-based + pure $ Fix $ Var (ix - 1) -- Operon is not 0-based "var" -- | parser for HeuristicLab. @@ -185,16 +203,16 @@ [ ("logabs", log.abs), ("sqrtabs", sqrt.abs) -- the longer versions should come first , ("abs", abs), ("exp", exp), ("log", log) , ("sqrt", sqrt), ("sqr", (**2)), ("cube", (**3)) - , ("cbrt", Fun Cbrt), ("sin", sin), ("cos", cos) + , ("cbrt", cbrt), ("sin", sin), ("cos", cos) , ("tan", tan), ("tanh", tanh) ] - binOps = [[binary "^" Power AssocLeft] - , [binary " * " (*) AssocLeft, binary " / " (/) AssocLeft] - , [binary " + " (+) AssocLeft, binary " - " (-) AssocLeft] + binOps = [[binary "^" (**) AssocLeft] + , [binary "*" (*) AssocLeft, binary "/" (/) AssocLeft] + , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft] ] var = do char 'x' ix <- decimal - pure $ Var ix + pure $ Fix $ Var ix "var" -- | parser for Bingo @@ -208,11 +226,56 @@ , ("sinh", sinh), ("cosh", cosh) , ("sin", sin), ("cos", cos) ] - binOps = [[binary "^" Power AssocLeft] + binOps = [[binary "^" (**) AssocLeft] , [binary "/" (/) AssocLeft, binary "" (*) AssocLeft] - , [binary " + " (+) AssocLeft, binary " - " (-) AssocLeft] + , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft] ] var = do string "X_" ix <- decimal - pure $ Var ix + pure $ Fix $ Var ix + "var" + +-- | parser for GOMEA +parseGOMEA :: Bool -> [(B.ByteString, Int)] -> ParseTree +parseGOMEA = parseExpr (prefixOps : binOps) binFuns var + where + binFuns = [] + prefixOps = map (uncurry prefix) + [ ("exp", exp), ("plog", log.abs) + , ("sqrt", sqrt.abs) + , ("sin", sin), ("cos", cos) + ] + binOps = [[binary "^" (**) AssocLeft] + , [binary "/" (/) AssocLeft, binary "*" (*) AssocLeft, binary "aq" aq AssocLeft] + , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft] + ] + var = do string "x" + ix <- decimal + pure $ Fix $ Var ix + "var" + +-- | parser for PySR +parsePySR :: Bool -> [(B.ByteString, Int)] -> ParseTree +parsePySR = parseExpr (prefixOps : binOps) binFuns var + where + binFuns = [ binFun "pow" (**) ] + prefixOps = map (uncurry prefix) + [ ("abs", abs), ("exp", exp) + , ("square", (**2)), ("cube", (**3)), ("neg", negate) + , ("acosh_abs", acosh . (+1) . abs), ("acosh", acosh), ("asinh", asinh) + , ("acos", acos), ("asin", asin), ("atan", atan) + , ("sqrt_abs", sqrt.abs), ("sqrt", sqrt) + , ("sinh", sinh), ("cosh", cosh), ("tanh", tanh) + , ("sin", sin), ("cos", cos), ("tan", tan) + , ("log10", log10), ("log2", log2), ("log1p", log1p) + , ("log_abs", log.abs), ("log10_abs", log10 . abs) + , ("log", log) + ] + binOps = [[binary "^" (**) AssocLeft] + , [binary "/" (/) AssocLeft, binary "*" (*) AssocLeft] + , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft] + ] + var = do string "x" + ix <- decimal + pure $ Fix $ Var ix "var" diff --git a/src/Text/ParseSR/IO.hs b/src/Text/ParseSR/IO.hs --- a/src/Text/ParseSR/IO.hs +++ b/src/Text/ParseSR/IO.hs @@ -1,28 +1,42 @@ {-# language LambdaCase #-} -module Text.ParseSR.IO ( withInput, withOutput ) +module Text.ParseSR.IO ( withInput, withOutput, withOutputDebug ) where import Control.Monad ( unless, forM_ ) import System.IO import qualified Data.ByteString.Char8 as B import Data.SRTree +import Data.SRTree.Recursion (Fix(..)) import Text.ParseSR ( SRAlgs, Output, parseSR, showOutput ) -withInput :: String -> SRAlgs -> String -> Bool -> IO [Either String (SRTree Int Double)] -withInput fname sr hd param = do +withInput :: String -> SRAlgs -> String -> Bool -> Bool -> IO [Either String (Fix SRTree)] +withInput fname sr hd param simpl = do h <- if null fname then pure stdin else openFile fname ReadMode contents <- hGetLines h - let myParser = parseSR sr (B.pack hd) param . B.pack - es = map myParser contents + let myParserFun = parseSR sr (B.pack hd) param . B.pack + myParser = if simpl then fmap simplify . myParserFun else myParserFun + es = map myParser $ filter (not . null) contents unless (null fname) $ hClose h pure es + where simplify = id -withOutput :: String -> Output -> [Either String (SRTree Int Double)] -> IO () +withOutput :: String -> Output -> [Either String (Fix SRTree)] -> IO () withOutput fname output exprs = do h <- if null fname then pure stdout else openFile fname WriteMode forM_ exprs $ \case Left err -> hPutStrLn h $ "invalid expression: " <> err Right ex -> hPutStrLn h (showOutput output ex) + unless (null fname) $ hClose h + +withOutputDebug :: String -> Output -> [Either String (Fix SRTree, Fix SRTree)] -> IO () +withOutputDebug fname output exprs = do + h <- if null fname then pure stdout else openFile fname WriteMode + forM_ exprs $ \case + Left err -> hPutStrLn h $ "invalid expression: " <> err + Right (t1, t2) -> do + hPutStrLn h ("First: " <> showOutput output t1) + hPutStrLn h ("Second: " <> showOutput output t2) + hFlush h unless (null fname) $ hClose h hGetLines :: Handle -> IO [String]