pandoc-symreg 0.1.0.1 → 0.2.0.0

raw patch · 6 files changed

+150/−53 lines, 6 filesdep ~srtreePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: srtree

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• README.md +5/−1
• app/Main.hs +5/−1
• pandoc-symreg.cabal +4/−4
• src/Text/ParseSR.hs +104/−41
• src/Text/ParseSR/IO.hs +20/−6

@@ -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

@@ -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* 

@@ -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)

@@ -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

@@ -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"

@@ -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]