diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/doctests/Main.hs b/doctests/Main.hs new file mode 100644 --- /dev/null +++ b/doctests/Main.hs @@ -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" + ] diff --git a/simple-expr.cabal b/simple-expr.cabal new file mode 100644 --- /dev/null +++ b/simple-expr.cabal @@ -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 diff --git a/src/Data/Graph/VisualizeAlternative.hs b/src/Data/Graph/VisualizeAlternative.hs new file mode 100644 --- /dev/null +++ b/src/Data/Graph/VisualizeAlternative.hs @@ -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 +-- +-- 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 diff --git a/src/Debug/SimpleExpr.hs b/src/Debug/SimpleExpr.hs new file mode 100644 --- /dev/null +++ b/src/Debug/SimpleExpr.hs @@ -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 +-- +-- 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) diff --git a/src/Debug/SimpleExpr/Expr.hs b/src/Debug/SimpleExpr/Expr.hs new file mode 100644 --- /dev/null +++ b/src/Debug/SimpleExpr/Expr.hs @@ -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 +-- +-- 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) diff --git a/src/Debug/SimpleExpr/GraphUtils.hs b/src/Debug/SimpleExpr/GraphUtils.hs new file mode 100644 --- /dev/null +++ b/src/Debug/SimpleExpr/GraphUtils.hs @@ -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 +-- +-- 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 diff --git a/src/Debug/SimpleExpr/Tutorial.hs b/src/Debug/SimpleExpr/Tutorial.hs new file mode 100644 --- /dev/null +++ b/src/Debug/SimpleExpr/Tutorial.hs @@ -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 +-- +-- 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)