packages feed

simple-expr (empty) → 0.1.0.0

raw patch · 9 files changed

+887/−0 lines, 9 filesdep +basedep +data-fixdep +doctest

Dependencies added: base, data-fix, doctest, graphite, graphviz, hashable, numhask, simple-expr, text, unicode-show

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Revision history for simple-expr++## 0.1.0.0 -- 2023-05-12++* Basic types `SimpleExpr`, `Expr` and instances for `NumHask` typeclasses.+* Conversion to graphs from `graphite` package.+* Visualization provided by `graphviz`.+* Tutorial+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Alexey Tochin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexey Tochin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ doctests/Main.hs view
@@ -0,0 +1,19 @@+import Test.DocTest (doctest)+import Prelude (IO)++-- This test suite exists only to add dependencies+main :: IO ()+main =+  doctest+    [ "-XHaskell2010",+      "-XNoImplicitPrelude",+      "-XInstanceSigs",+      "-XDeriveFunctor",+      "-XMultiParamTypeClasses",+      "-XFlexibleInstances",+      "-XRankNTypes",+      "-XFlexibleContexts",+      "-XScopedTypeVariables",+      "-XConstraintKinds",+      "src"+    ]
+ simple-expr.cabal view
@@ -0,0 +1,88 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.1.+--+-- see: https://github.com/sol/hpack++name:           simple-expr+version:        0.1.0.0+synopsis:       Minimalistic toolkit for simple mathematical expression.+description:    This is a minimalistic toolkit for simple mathematical expression developed for debug purposes similar to+                'simple-reflect' package+                but based on slightly different principles.+                In particular, we use ordinary syntactic trees instead of turning them into strings.+                There is a primitive manipulation capability like+                .+                @+                  >>> simplify $ (x + 0) * 1 - x * (3 - 2)+                  0+                @+                .+                Besides an expression visualization feature is supported.+                .+                ![image description](doc/images/imaginary_expr_sum.png)+                .+                See [tutorial](Debug-SimpleExpr-Tutorial.html) for details.+category:       Math+author:         Alexey Tochin+maintainer:     Alexey.Tochin@gmail.com+copyright:      2023 Alexey Tochin+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    CHANGELOG.md++library+  exposed-modules:+      Data.Graph.VisualizeAlternative+      Debug.SimpleExpr+      Debug.SimpleExpr.Expr+      Debug.SimpleExpr.GraphUtils+      Debug.SimpleExpr.Tutorial+  other-modules:+      Paths_simple_expr+  hs-source-dirs:+      src+  default-extensions:+      NoImplicitPrelude+      InstanceSigs+      DeriveFunctor+      MultiParamTypeClasses+      FlexibleInstances+      RankNTypes+      FlexibleContexts+      ScopedTypeVariables+      ConstraintKinds+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , data-fix+    , graphite+    , graphviz+    , hashable+    , numhask+    , text+    , unicode-show+  default-language: Haskell2010++test-suite doctests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_simple_expr+  hs-source-dirs:+      doctests+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , data-fix+    , doctest+    , graphite+    , graphviz+    , hashable+    , numhask+    , simple-expr+    , text+    , unicode-show+  default-language: Haskell2010
+ src/Data/Graph/VisualizeAlternative.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK hide #-}++-- | Module    :  Data.Graph.VisualizeAlternative+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Copies of some methods from @graphite@ package with only purpose+-- to replace the parameter 'Sfdp' by 'Dot' in 'plotDGraph' term.+module Data.Graph.VisualizeAlternative (plotDGraph, plotDGraphPng, toDirectedDot, sensibleDotParams) where++import Control.Concurrent (ThreadId, forkIO)+import Data.Graph.DGraph (DGraph, arcs)+import Data.Graph.Types (Arc (Arc), Graph, vertices)+import Data.GraphViz+  ( DotGraph,+    GlobalAttributes (GraphAttrs),+    GraphvizCanvas (Xlib),+    GraphvizCommand (Dot, Sfdp),+    GraphvizOutput (Png),+    GraphvizParams,+    PrintDot,+    addExtension,+    fmtEdge,+    globalAttributes,+    graphElemsToDot,+    isDirected,+    nonClusteredParams,+    runGraphvizCanvas,+    runGraphvizCommand,+  )+import Data.GraphViz.Attributes.Complete (Attribute (Label, Overlap), Label (StrLabel), Overlap (ScaleOverlaps))+import Data.Hashable (Hashable)+import qualified Data.Text.Lazy as TL+import Prelude (Bool (False, True), FilePath, IO, Ord, Show, String, show, ($), (<$>))++-- | A copy of @plotDGraph@ method from 'Data.Graph.Visualize' but the parameter 'Sfdp' is replaced by 'Dot'.+plotDGraph ::+  (Hashable v, Ord v, PrintDot v, Show v, Show e) =>+  DGraph v e ->+  IO ThreadId+plotDGraph g = forkIO $ runGraphvizCanvas Dot (toDirectedDot False g) Xlib++-- | A copy of @toDirectedDot@ method from 'Data.Graph.Visualize' but the parameter 'Sfdp' is replaced by 'Dot'.+plotDGraphPng ::+  (Hashable v, Ord v, PrintDot v, Show v, Show e) =>+  DGraph v e ->+  FilePath ->+  IO FilePath+plotDGraphPng g = addExtension (runGraphvizCommand Dot $ toDirectedDot False g) Png++-- | A copy of @toDirectedDot@ method from 'Data.Graph.Visualize'.+toDirectedDot ::+  (Hashable v, Ord v, Show v, Show e) =>+  Bool ->+  DGraph v e ->+  DotGraph v+toDirectedDot labelEdges g = graphElemsToDot params (labeledNodes g) (labeledArcs g)+  where+    params = sensibleDotParams True labelEdges++-- | A copy of @sensibleDotParams@ method from 'Data.Graph.Visualize'.+sensibleDotParams ::+  Bool ->+  Bool ->+  GraphvizParams t l String () l+sensibleDotParams directed edgeLabeled =+  nonClusteredParams+    { isDirected = directed,+      globalAttributes =+        [ GraphAttrs [Overlap ScaleOverlaps]+        ],+      fmtEdge = edgeFmt+    }+  where+    edgeFmt (_, _, l) =+      [Label $ StrLabel $ TL.pack l | edgeLabeled]++-- | A copy of @labeledNodes@ method from 'Data.Graph.Visualize'.+labeledNodes :: (Graph g, Show v) => g v e -> [(v, String)]+labeledNodes g = (\v -> (v, show v)) <$> vertices g++-- | A copy of @labeledNodes@ method from 'Data.Graph.Visualize'.+labeledArcs :: (Hashable v, Show e) => DGraph v e -> [(v, v, String)]+labeledArcs g = (\(Arc v1 v2 attr) -> (v1, v2, show attr)) <$> arcs g
+ src/Debug/SimpleExpr.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Debug.SimpleExpr+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Minimalistic toolkit for simple mathematical expression developed for debug purposes.+-- See 'Debug.SimpleExpr.Tutorial' for a quick introduction.+module Debug.SimpleExpr+  ( -- * Expression manipulation+    number,+    variable,+    unaryFunc,+    binaryFunc,+    simplify,++    -- * Base types+    SimpleExpr,+    Expr,++    -- * Visualisation+    plotExpr,+    exprToGraph,+    plotDGraph,+    plotDGraphPng,++    -- * Auxiliary functions+    dependencies,+    content,+  )+where++import Data.Graph.VisualizeAlternative (plotDGraph)+import Debug.SimpleExpr.Expr+  ( Expr,+    SimpleExpr,+    binaryFunc,+    content,+    dependencies,+    number,+    simplify,+    unaryFunc,+    variable,+  )+import Debug.SimpleExpr.GraphUtils (exprToGraph, plotDGraphPng, plotExpr)
+ src/Debug/SimpleExpr/Expr.hs view
@@ -0,0 +1,385 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Debug.SimpleExpr.Expr+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Simple expressions base types and manipulations.+module Debug.SimpleExpr.Expr+  ( -- * Expression manipulation+    number,+    variable,+    unaryFunc,+    binaryFunc,+    simplify,+    simplifyStep,++    -- * Base types+    SimpleExprF (NumberF, VariableF, BinaryFuncF, SymbolicFuncF),+    SimpleExpr,+    Expr,++    -- * Auxiliary functions+    ListOf,+    content,+    dependencies,+    showWithBrackets,+  )+where++import Control.Monad.Fix (fix)+import Data.Fix (Fix (Fix, unFix))+import Data.Functor.Classes (Eq1, liftEq)+import Data.List (intercalate, (++))+import NumHask (Additive, Distributive, Divisive, ExpField, Field, Multiplicative, Subtractive, TrigField, one, zero)+import qualified NumHask as NH+import Prelude+  ( Bool (False),+    Eq,+    Functor,+    Integer,+    Num,+    Show,+    String,+    fmap,+    seq,+    show,+    ($),+    (&&),+    (.),+    (<>),+    (==),+  )+import qualified Prelude as P++-- | Expression F-algebra functional.+data SimpleExprF a+  = NumberF Integer+  | VariableF String+  | BinaryFuncF String a a+  | SymbolicFuncF String [a]+  deriving (Functor, Eq)++instance Eq1 SimpleExprF where+  liftEq :: (a -> b -> Bool) -> SimpleExprF a -> SimpleExprF b -> Bool+  liftEq eq e1 e2 = case (e1, e2) of+    (NumberF n1, NumberF n2) -> n1 == n2+    (VariableF v1, VariableF v2) -> v1 == v2+    (BinaryFuncF name1 x1 y1, BinaryFuncF name2 x2 y2) -> (name1 == name2) && eq x1 x2 && eq y1 y2+    (SymbolicFuncF name1 args1, SymbolicFuncF name2 args2) -> (name1 == name2) && liftEq eq args1 args2+    _ -> False++instance NH.FromIntegral (SimpleExprF a) Integer where+  fromIntegral = NumberF++-- | Simple expression type, see+-- [tutorial](Debug.SimpleExpr.Tutorial.hs)+type SimpleExpr = Fix SimpleExprF++-- | Initializes a single integer number expression.+--+-- ==== __Examples of usage__+--+-- >>> a = number 42+-- >>> a+-- 42+-- >>> :t a+-- a :: SimpleExpr+number :: Integer -> SimpleExpr+number n = Fix (NumberF n)++-- | Initializes a single symbolic variable expression.+--+-- ==== __Examples of usage__+--+-- >>> x = variable "x"+-- >>> x+-- x+-- >>> :t x+-- x :: SimpleExpr+variable :: String -> SimpleExpr+variable name = Fix (VariableF name)++-- | Returns the list of head dependencies of an expression.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (($), id)+-- >>> import NumHask ((+), (*))+--+-- >>> dependencies (variable "x" + (variable "y" * variable "z"))+-- [x,y·z]+dependencies :: SimpleExpr -> [SimpleExpr]+dependencies (Fix e) = case e of+  NumberF _ -> []+  VariableF _ -> []+  BinaryFuncF _ leftArg rightArg -> [leftArg, rightArg]+  SymbolicFuncF _ args -> args++instance NH.FromIntegral (Fix SimpleExprF) Integer where+  fromIntegral = Fix . NumberF++-- | Entity that is representable as a list of in general other entities.+-- In particular, @X@ is a list of single @[X]@, see the example below.+--+-- ==== __Examples of usage__+--+-- >>> data Atom = Atom String deriving Show+-- >>> type Particle = ListOf Atom+--+-- >>> content (Atom "He") :: [Atom]+-- [Atom "He"]+--+-- >>> content (Atom "H", Atom "H") :: [Atom]+-- [Atom "H",Atom "H"]+--+-- >>> content [Atom "H", Atom "O", Atom "H"] :: [Atom]+-- [Atom "H",Atom "O",Atom "H"]+class ListOf inner outer where+  -- | Returns a list of entities the argument consists of.+  content :: outer -> [inner]++instance ListOf inner () where+  content = P.const []++instance ListOf inner inner where+  content e = [e]++instance (ListOf inner outer1, ListOf inner outer2) => ListOf inner (outer1, outer2) where+  content (x1, x2) = content x1 ++ content x2++instance (ListOf inner outer1, ListOf inner outer2, ListOf inner outer3) => ListOf inner (outer1, outer2, outer3) where+  content (x1, x2, x3) = content x1 ++ content x2 ++ content x3++instance+  (ListOf inner outer1, ListOf inner outer2, ListOf inner outer3, ListOf inner outer4) =>+  ListOf inner (outer1, outer2, outer3, outer4)+  where+  content (x1, x2, x3, x4) = content x1 ++ content x2 ++ content x3 ++ content x4++instance+  (ListOf inner outer1, ListOf inner outer2, ListOf inner outer3, ListOf inner outer4, ListOf inner outer5) =>+  ListOf inner (outer1, outer2, outer3, outer4, outer5)+  where+  content (x1, x2, x3, x4, x5) = content x1 ++ content x2 ++ content x3 ++ content x4 ++ content x5++instance (ListOf inner outer) => ListOf inner [outer] where+  content = (content P.=<<)++-- | Expression typeclass.+-- It includes `SimpleExpr` as well as list and tuples of `SimpleExpr` etc.+type Expr = ListOf SimpleExpr++---- | Expression typeclass.+-- class Eq a => Expr a where+--  -- | Returns all simple expressions given expression consists of.+--  --+--  -- ==== __Examples of usage__+--  --+--  -- >>> import NumHask ((+), (*))+--  --+--  -- >>> x = variable "x"+--  -- >>> y = variable "y"+--  -- >>> z = variable "z"+--  --+--  -- >>> innerSimpleExprs [x, y + z]+--  -- [x,y+z]+--  --+--  -- >>> innerSimpleExprs (x * (y + z))+--  -- [x·(y+z)]+--  innerSimpleExprs :: a -> [SimpleExpr]+--+-- instance Expr () where+--  innerSimpleExprs = P.const []+--+-- instance Expr SimpleExpr where+--  innerSimpleExprs e = [e]+--+-- instance Expr (SimpleExpr, SimpleExpr) where+--  innerSimpleExprs (e0, e1) = [e0, e1]+--+-- instance Expr (SimpleExpr, SimpleExpr, SimpleExpr) where+--  innerSimpleExprs (e0, e1, e2) = [e0, e1, e2]+--+-- instance Expr [SimpleExpr] where+--  innerSimpleExprs = P.id++instance {-# OVERLAPPING #-} Show SimpleExpr where+  show (Fix e) = case e of+    NumberF n -> show n+    VariableF name -> name+    BinaryFuncF name leftArg rightArg -> showWithBrackets leftArg <> name <> showWithBrackets rightArg+    SymbolicFuncF name args -> name <> "(" <> intercalate "," (fmap show args) <> ")"++-- | Shows expression adding brackets if it is needed for a context.+showWithBrackets :: SimpleExpr -> String+showWithBrackets e = case e of+  n@(Fix NumberF {}) -> show n+  c@(Fix VariableF {}) -> show c+  bf@(Fix BinaryFuncF {}) -> "(" <> show bf <> ")"+  sf@(Fix SymbolicFuncF {}) -> show sf++-- | Inituialize unarry function+--+-- ==== __Examples of usage__+--+-- >>> x = variable "x"+-- >>> f = unaryFunc "f"+-- >>> f x+-- f(x)+-- >>> :t x+-- x :: SimpleExpr+-- >>> :t f+-- f :: SimpleExpr -> SimpleExpr+unaryFunc :: String -> SimpleExpr -> SimpleExpr+unaryFunc name x = Fix (SymbolicFuncF name [x])++-- | Inituialize unarry function+--+-- ==== __Examples of usage__+--+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> (-*-) = binaryFunc "-*-"+-- >>> x -*- y+-- x-*-y+-- >>> :t x+-- x :: SimpleExpr+-- >>> :t (-*-)+-- (-*-) :: SimpleExpr -> SimpleExpr -> SimpleExpr+-- >>> :t x-*-y+-- x-*-y :: SimpleExpr+binaryFunc :: String -> SimpleExpr -> SimpleExpr -> SimpleExpr+binaryFunc name x y = Fix (BinaryFuncF name x y)++instance Additive SimpleExpr where+  zero = number 0+  (+) = binaryFunc "+"++instance Subtractive SimpleExpr where+  negate = unaryFunc "-"+  (-) = binaryFunc "-"++instance Multiplicative SimpleExpr where+  one = number 1+  (*) = binaryFunc "·"++instance Distributive SimpleExpr++instance Divisive SimpleExpr where+  (/) = binaryFunc "/"++instance Field SimpleExpr++instance ExpField SimpleExpr where+  exp = unaryFunc "exp"+  log = unaryFunc "log"+  (**) = binaryFunc "^"+  sqrt = unaryFunc "sqrt"++instance TrigField SimpleExpr where+  pi = variable "π"+  sin = unaryFunc "sin"+  cos = unaryFunc "cos"+  tan = unaryFunc "tg"+  asin = unaryFunc "arcsin"+  acos = unaryFunc "arccos"+  atan = unaryFunc "arctan"+  sinh = unaryFunc "sh"+  cosh = unaryFunc "ch"+  tanh = unaryFunc "th"+  atan2 a b = Fix $ SymbolicFuncF "atan2" [a, b]+  asinh = unaryFunc "arcsh"+  acosh = unaryFunc "arcch"+  atanh = unaryFunc "arcth"++instance Num SimpleExpr where+  (+) = (NH.+)+  (-) = (NH.-)+  (*) = (NH.*)+  negate = NH.negate+  abs = unaryFunc "abs"+  signum = unaryFunc "sign"+  fromInteger = number++-- | Applies a function recursivelly until it has no effect.+-- Strict.+-- Unsafe due to possible inifinite recursion.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Integer, div)+-- >>> iterateUntilEqual (`div` 2) (1000 :: Integer)+-- 0+iterateUntilEqual :: Eq x => (x -> x) -> x -> x+iterateUntilEqual f x =+  let fx = f x+   in if fx == x+        then x+        else seq fx (iterateUntilEqual f fx)++-- | Minimalistic simplification step.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (($), id)+-- >>> import NumHask ((+), (*), (**))+--+-- >>> simplifyStep id (0 + (0 + (0 + 10)))+-- 0+(0+10)+--+-- >>> simplifyStep id (1 * (0 + (10 ** 1)))+-- 0+(10^1)+simplifyStep :: (SimpleExpr -> SimpleExpr) -> SimpleExpr -> SimpleExpr+simplifyStep f e = case e of+  n@(Fix (NumberF _)) -> n+  c@(Fix (VariableF _)) -> c+  Fix (BinaryFuncF name leftArg rightArg) -> case name of+    "+" -> case (unFix leftArg, unFix rightArg) of+      (NumberF 0, _) -> f rightArg+      (_, NumberF 0) -> f leftArg+      (NumberF n, NumberF m) -> Fix (NumberF (n P.+ m))+      _ -> Fix (BinaryFuncF "+" (f leftArg) (f rightArg))+    "-" -> case (unFix leftArg, unFix rightArg) of+      (NumberF 0, _) -> NH.negate f rightArg+      (_, NumberF 0) -> f leftArg+      (NumberF n, NumberF m) -> Fix (NumberF (n P.- m))+      _ ->+        if fX == fY+          then zero+          else Fix (BinaryFuncF "-" fX fY)+        where+          fX = f leftArg+          fY = f rightArg+    "·" -> case (unFix leftArg, unFix rightArg) of+      (NumberF 0, _) -> zero+      (_, NumberF 0) -> zero+      (NumberF 1, _) -> f rightArg+      (_, NumberF 1) -> f leftArg+      (NumberF n, NumberF m) -> Fix (NumberF (n P.* m))+      _ -> Fix (BinaryFuncF "·" (f leftArg) (f rightArg))+    "^" -> case (unFix leftArg, unFix rightArg) of+      (NumberF n, NumberF m) -> Fix (NumberF (n P.^ m))+      (NumberF 0, _) -> zero+      (_, NumberF 0) -> one+      (NumberF 1, _) -> one+      (_, NumberF 1) -> f leftArg+      _ -> Fix (BinaryFuncF "^" (f leftArg) (f rightArg))+    _ -> Fix (BinaryFuncF name (f leftArg) (f rightArg))+  Fix (SymbolicFuncF name args) -> Fix (SymbolicFuncF name (fmap f args))++-- | Simplify expression using some primitive rules like '0 * x -> 0' specified in 'simplifyStep' implementation.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (($))+-- >>> import Debug.SimpleExpr (variable, simplify)+-- >>> import NumHask ((+), (-), (*))+--+-- >>> x = variable "x"+-- >>> simplify $ (x + 0) * 1 - x * (3 - 2)+-- 0+simplify :: SimpleExpr -> SimpleExpr+simplify = fix $ iterateUntilEqual . simplifyStep -- simplify = iterateUntilEqual (simplifyStep simplify)
+ src/Debug/SimpleExpr/GraphUtils.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Debug.SimpleExpr.GraphUtils+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Tools for transforming simple expressions to graphs from @graphite@.+module Debug.SimpleExpr.GraphUtils+  ( -- * Conversion simple expressions to graphs+    exprToGraph,++    -- * Visualisation+    plotExpr,+    plotDGraphPng,++    -- * Auxiliary functions+    simpleExprToGraph,+    appendNodeToGraph,+  )+where++import Control.Concurrent (ThreadId)+import Data.Fix (Fix (..))+import Data.Graph.DGraph (DGraph, insertArc)+import Data.Graph.Types (Arc (..), empty, insertVertex, union)+import Data.Graph.VisualizeAlternative (plotDGraph, plotDGraphPng)+import Debug.SimpleExpr.Expr (Expr, SimpleExpr, SimpleExprF (..), content, dependencies)+import Prelude (IO, String, fmap, foldr, show, ($), (.))++-- | Transforms a simple expression to graph.+simpleExprToGraph :: SimpleExpr -> DGraph String ()+simpleExprToGraph (Fix e) = case e of+  NumberF n -> appendNodeToGraph (show n) [] graph+  VariableF c -> appendNodeToGraph c [] graph+  BinaryFuncF _ a b -> appendNodeToGraph (show (Fix e)) [show a, show b] graph+  SymbolicFuncF _ args' -> appendNodeToGraph (show (Fix e)) (fmap show args') graph+  where+    graph = exprToGraph $ dependencies (Fix e)++-- | Appends a node to a graph using string valued keys.+--+-- The first argumet is the new node name.+--+-- The second argument is the list of dependent nodes.+appendNodeToGraph :: String -> [String] -> DGraph String () -> DGraph String ()+appendNodeToGraph newNodeName depNodeNames graph = foldr addArc initGraph depNodeNames+  where+    addArc depName = insertArc (Arc depName newNodeName ())+    initGraph = insertVertex newNodeName graph++-- | Transforms an expression to graph.+--+-- ==== __Examples of usage__+--+-- >>> import Debug.SimpleExpr (variable)+-- >>> import NumHask ((+), (-))+--+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> exprToGraph [x + y, x - y]+-- fromList [("x",[("x+y",()),("x-y",())]),("x+y",[]),("x-y",[]),("y",[("x+y",()),("x-y",())])]+exprToGraph :: Expr d => d -> DGraph String ()+exprToGraph d = case content d of+  [] -> empty -- insertVertex (name e) empty+  [v] -> simpleExprToGraph v+  (v : vs) -> simpleExprToGraph v `union` exprToGraph vs -- insertArc newArcV addedV where++-- | Visualizes an expression.+--+-- ==== __Examples of usage__+--+-- >>> import Debug.SimpleExpr (number, variable)+-- >>> import NumHask ((+), (-))+-- >>> import Data.Graph.VisualizeAlternative (plotDGraphPng)+--+-- @>>> plotExpr (number 1 + variable "x")@+--+-- ![1+x](doc/images/demo1.png)+--+-- >>> x = variable "x"+-- >>> y = variable "y"+--+-- @>>> plotExpr [x + y, x - y]@+--+-- ![x+y,x-y](doc/images/demo2.png)+plotExpr :: Expr d => d -> IO ThreadId+plotExpr = plotDGraph . exprToGraph
+ src/Debug/SimpleExpr/Tutorial.hs view
@@ -0,0 +1,135 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Debug.SimpleExpr.Tutorial+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Tutorial, Quick start or Demo for 'simple-expr' package.+module Debug.SimpleExpr.Tutorial+  ( -- * Quick start+    -- $quick_start2++    -- * Expression simplification+    -- $expression_simplification++    -- * Visualisation+    -- $visualisation+  )+where++import Control.Concurrent (ThreadId)+import Data.Graph.DGraph (DGraph)+import Debug.SimpleExpr+import Debug.SimpleExpr.GraphUtils+import NumHask (sin, (**))+import Prelude (FilePath, IO, String)++-- $quick_start2 #simple_expr_tutorial_head#+--+-- >>> import Prelude (String)+-- >>> import Debug.SimpleExpr (variable, unaryFunc, binaryFunc)+-- >>> import NumHask (sin, (**))+--+-- Let us build an example symbolic expression for+--+-- \[+--   f(x) := \sin x^2+-- \]+--+-- It can be done as follows+--+-- >>> x = variable "x"+-- >>> sin (x ** 2)+-- sin(x^2)+--+-- where terms @x@ and @sin (x ** 2)@ have type 'SimpleExpr'.+-- It is just a syntactic tree where the role of leaves is played by+-- variables and numbers.+-- We used+-- 'variable'@ :: @'String'@ -> @'SimpleExpr'+-- to build the expression for variable @x@.+-- For the sine function we attracted a predefined term+-- 'sin'@ :: @'SimpleExpr'@ -> @'SimpleExpr'.+--+-- As well we can define a custom function using 'unaryFunc' and binary functoins using 'binaryFunc' as follows+--+-- >>> f = unaryFunc "f"+-- >>> (-*-) = binaryFunc "-*-"+-- >>> f x -*- f x+-- f(x)-*-f(x)+--+-- There is also a typeclass 'Expr' that includes `SimpleExpr` as well as it's tuples and lists.++-- $expression_simplification+-- >>> import Prelude (($))+-- >>> import Debug.SimpleExpr (variable, simplify)+-- >>> import NumHask ((+), (-), (*))+--+-- We can try to simplify an expressions with the aid of quite a primitive 'simplify' method+--+-- >>> x = variable "x"+-- >>> simplify $ (x + 0) * 1 - x * (3 - 2)+-- 0++-- $visualisation+-- >>> import Debug.SimpleExpr (variable, unaryFunc)+-- >>> import Debug.SimpleExpr.GraphUtils (plotExpr, plotDGraphPng, exprToGraph)+-- >>> import NumHask (exp, (*), (+), (-))+--+-- There is a built-in tool to visualize expression that attracts+-- [graphite](https://hackage.haskell.org/package/graphite)+-- package to transform expressions to+-- [graphs](https://hackage.haskell.org/package/graphs)+-- and+-- [graphviz](https://hackage.haskell.org/package/graphviz)+-- to render the images.+--+-- Consider first a simple composition for two functions @f@ and @g@+--+-- >>> x = variable "x"+-- >>> f = unaryFunc "f"+-- >>> g = unaryFunc "g"+-- >>> expr = g (f x)+-- >>> expr+-- g(f(x))+--+-- This symbolic expression can be plotted by+-- 'plotExpr'@ :: @'Expr'@ d => d -> @'IO' 'ThreadId'+-- like+--+-- @ plotExpr expr @+--+-- ![image description](/home/alexey/Dropbox/projects/deep-ml/simple-expr/doc/images/composition.png)+--+-- To save the image as a file use, for example,+--+-- 'plotDGraphPng'@ (@'exprToGraph'@ expr) pathToFile @,+--+-- where+--+-- 'exprToGraph'@ :: @'Expr'@ d => d -> @'DGraph' 'String'@ () @+--+-- transforms an expression to a graph+-- and+--+-- 'plotDGraphPng'@ :: @'DGraph'@ v e -> @'FilePath'@ -> @'IO' 'FilePath'.+--+-- plats the graph.+--+-- Consider now a more representative example+--+-- \[+--   e^{i k x} + e^{ - i k x}+-- \]+--+-- >>> :{+--   x, k, i, expr :: SimpleExpr+--   x = variable "x"+--   k = variable "k"+--   i = variable "i"+--   expr = exp (i * k * x) + exp (-(i * k * x))+-- :}+--+-- ![image description](doc/images/imaginary_expr_sum.png)