packages feed

simple-expr 0.1.1.0 → 0.2.0.0

raw patch · 11 files changed

+1397/−118 lines, 11 filesdep +Streamdep +combinatorialdep +compositiondep −simple-exprdep ~basedep ~data-fixdep ~graphite

Dependencies added: Stream, combinatorial, composition, mtl, unordered-containers, vector, vector-sized

Dependencies removed: simple-expr

Dependency ranges changed: base, data-fix, graphite, graphviz, hashable, numhask, text, unicode-show

Files

CHANGELOG.md view
@@ -1,5 +1,20 @@ # Revision history for simple-expr +## [0.2.0.0] -- 2025-11-13++### Changed++* Compatibility with `inf-backprop` 0.2.0.0+* Removed `BinaryFuncF`+* Switched form `String` to `Text`+* Instances of `FromIntegral` for `SimpleExpr` type.++## [0.1.1.0] -- 2023-08-05++### Fixed++* Compatibility up to LTS 21.6+ ## [0.1.0.0] -- 2023-05-12  ### Added@@ -9,8 +24,3 @@ * Visualization provided by `graphviz`. * Tutorial -## [0.1.1.0] -- 2023-08-05--### Fixed--* Compatibility up to LTS 21.6
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2023, Alexey Tochin+Copyright (c) 2023-2025, Alexey Tochin  All rights reserved.
simple-expr.cabal view
@@ -1,37 +1,39 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           simple-expr-version:        0.1.1.0+version:        0.2.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+description:    This is a minimalistic toolkit for simple mathematical expression developed for debug purposes similar to [simple-reflect](https://hackage.haskell.org/package/simple-reflect) package but based on slightly different principles. In particular, we use ordinary syntactic trees instead of turning them into strings.                  .-                @-                  >>> simplify $ (x + 0) * 1 - x * (3 - 2)-                  0-                @+                 There is a primitive manipulation capability like                  .-                Besides an expression visualization feature is also provided.+                 @ +                 >>> simplify $ (x + 0) * 1 - x * (3 - 2) +                 0 +                 @                  .-                ![image description](docs/doc/images/imaginary_expr_sum.png)+                 Besides an expression visualization feature is also provided.                  .-                See [tutorial](docs/Debug-SimpleExpr-Tutorial.html) for details.+                 ![image description](docs/doc/images/imaginary_expr_sum.png) +                .+                 See [tutorial](docs/Debug-SimpleExpr-Tutorial.html) for details. category:       Mathematics author:         Alexey Tochin maintainer:     Alexey.Tochin@gmail.com-copyright:      2023 Alexey Tochin+copyright:      2024 Alexey Tochin license:        BSD3 license-file:   LICENSE build-type:     Simple extra-source-files:     CHANGELOG.md+    doc/images/composition.png+    doc/images/demo1.png+    doc/images/demo2.png+    doc/images/imaginary_expr_sum.png extra-doc-files:     doc/images/composition.png     doc/images/demo1.png@@ -40,11 +42,14 @@  library   exposed-modules:+      Control.ExtendableMap       Data.Graph.VisualizeAlternative       Debug.SimpleExpr       Debug.SimpleExpr.Expr       Debug.SimpleExpr.GraphUtils       Debug.SimpleExpr.Tutorial+      Debug.SimpleExpr.Utils.Algebra+      Debug.SimpleExpr.Utils.Traced   other-modules:       Paths_simple_expr   hs-source-dirs:@@ -61,14 +66,21 @@       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+      Stream <0.5+    , base >=4.19 && <5+    , combinatorial <0.2+    , composition <1.1+    , data-fix <0.4+    , graphite <0.11+    , graphviz <2999.21+    , hashable <1.6+    , mtl <2.4+    , numhask <0.14+    , text <2.2+    , unicode-show <0.2+    , unordered-containers <0.3+    , vector <0.14+    , vector-sized <1.7   default-language: Haskell2010  test-suite doctests@@ -80,14 +92,20 @@       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+      Stream <0.5+    , base >=4.19 && <5+    , combinatorial+    , composition+    , data-fix <0.4     , doctest-    , graphite-    , graphviz-    , hashable-    , numhask-    , simple-expr-    , text-    , unicode-show+    , graphite <0.11+    , graphviz <2999.21+    , hashable <1.6+    , mtl+    , numhask <0.14+    , text <2.2+    , unicode-show <0.2+    , unordered-containers+    , vector <0.14+    , vector-sized <1.7   default-language: Haskell2010
+ src/Control/ExtendableMap.hs view
@@ -0,0 +1,83 @@+-- | Module    :  Numeric.InfBackprop.Instances.NumHask+-- Copyright   :  (C) 2025 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- `ExtandableMap` class and its instances.+module Control.ExtendableMap+  ( ExtandableMap (extendMap),+  )+where++import Data.Bifunctor (bimap)+import Data.Stream (Stream)+import qualified Data.Vector as DV+import qualified Data.Vector.Generic.Sized as DVGS+import GHC.Base (fmap, id, (.))++-- | Type is similar to `fmap`, but it can extend the function application.+-- It can apply a function to each element and subelements+-- of a tuple, list, sized vector, stream, etc.+--+-- ==== __Examples__+--+-- >>> import GHC.Base (Bool(True, False), Int)+-- >>> import GHC.Show (show)+-- >>> import GHC.Num ((*))+-- >>> import Data.String (String)+--+-- >>> extendMap (show :: Int -> String) (42 :: Int) :: String+-- "42"+--+-- >>> extendMap (show :: Bool -> String) (True, False) :: (String, String)+-- ("True","False")+--+-- >>> extendMap ((*2) :: Int -> Int) (1 :: Int, (2 :: Int, 3 :: Int)) :: (Int, (Int, Int))+-- (2,(4,6))+--+-- >>> extendMap ((*2) :: Int -> Int) ([1, 2, 3] :: [Int], (4 :: Int, 5 :: Int)) :: ([Int], (Int, Int))+-- ([2,4,6],(8,10))+class ExtandableMap a b c d where+  extendMap :: (a -> b) -> c -> d++-- | Trivial instance of `ExtandableMap`.+instance ExtandableMap a b a b where+  extendMap = id++-- | Tuple instance of `ExtandableMap`.+instance+  (ExtandableMap a b c0 d0, ExtandableMap a b c1 d1) =>+  ExtandableMap a b (c0, c1) (d0, d1)+  where+  extendMap :: (a -> b) -> (c0, c1) -> (d0, d1)+  extendMap f = bimap (extendMap f) (extendMap f)++-- | Triple instance of `ExtandableMap`.+instance+  (ExtandableMap a b c0 d0, ExtandableMap a b c1 d1, ExtandableMap a b c2 d2) =>+  ExtandableMap a b (c0, c1, c2) (d0, d1, d2)+  where+  extendMap f (x0, x1, x2) = (extendMap f x0, extendMap f x1, extendMap f x2)++-- | List `[]` instance of `ExtandableMap`.+instance (ExtandableMap a b c d) => ExtandableMap a b [c] [d] where+  extendMap f = fmap (extendMap f)++-- | Sized vector instance of `ExtandableMap`.+instance+  (ExtandableMap a b c d) =>+  ExtandableMap a b (DVGS.Vector DV.Vector n c) (DVGS.Vector DV.Vector n d)+  where+  extendMap f = fmap (extendMap f)++-- | Stream instance of `ExtandableMap`.+instance (ExtandableMap a b c d) => ExtandableMap a b (Stream c) (Stream d) where+  extendMap f = fmap (extendMap f)++-- | Function `(->) r` instance of `ExtandableMap`.+instance+  (ExtandableMap a b c d) =>+  ExtandableMap a b (r -> c) (r -> d)+  where+  extendMap :: (a -> b) -> (r -> c) -> (r -> d)+  extendMap f = (.) (extendMap f)
src/Data/Graph/VisualizeAlternative.hs view
@@ -6,7 +6,9 @@ -- License     :  BSD3 (see the file LICENSE) -- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com> ----- Copies of some methods from @graphite@ package with only purpose+-- Copies of some methods from+-- [graphite](https://hackage.haskell.org/package/graphite)+-- package with only purpose -- to replace the parameter 'Sfdp' by 'Dot' in 'plotDGraph' term. module Data.Graph.VisualizeAlternative (plotDGraph, plotDGraphPng, toDirectedDot, sensibleDotParams) where
src/Debug/SimpleExpr.hs view
@@ -1,7 +1,8 @@ {-# OPTIONS_HADDOCK show-extensions #-} --- | Module    :  Debug.SimpleExpr--- Copyright   :  (C) 2023 Alexey Tochin+-- |+-- Module    :  Debug.SimpleExpr+-- Copyright   :  (C) 2023-2025 Alexey Tochin -- License     :  BSD3 (see the file LICENSE) -- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com> --@@ -13,10 +14,13 @@     variable,     unaryFunc,     binaryFunc,+    simplifyExpr,     simplify,      -- * Base types     SimpleExpr,+    SE,+    SimpleExprF,     Expr,      -- * Visualisation@@ -34,12 +38,15 @@ import Data.Graph.VisualizeAlternative (plotDGraph) import Debug.SimpleExpr.Expr   ( Expr,+    SE,     SimpleExpr,+    SimpleExprF,     binaryFunc,     content,     dependencies,     number,     simplify,+    simplifyExpr,     unaryFunc,     variable,   )
src/Debug/SimpleExpr/Expr.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wcpp-undef #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK show-extensions #-}@@ -15,12 +17,14 @@     variable,     unaryFunc,     binaryFunc,-    simplify,+    simplifyExpr,     simplifyStep,+    simplify,      -- * Base types-    SimpleExprF (NumberF, VariableF, BinaryFuncF, SymbolicFuncF),+    SimpleExprF (NumberF, VariableF, SymbolicFuncF),     SimpleExpr,+    SE,     Expr,      -- * Auxiliary functions@@ -31,55 +35,89 @@   ) where +import Control.ExtendableMap (ExtandableMap, extendMap)+import Control.Monad (guard) import Control.Monad.Fix (fix) import Data.Fix (Fix (Fix, unFix)) import Data.Functor.Classes (Eq1, liftEq)-import Data.List (intercalate, (++))-import NumHask (Additive, Divisive, ExpField, Multiplicative, Subtractive, TrigField, one, zero)-import qualified NumHask as NH-import Prelude-  ( Bool (False),-    Eq,-    Functor,-    Integer,-    Num,-    Show,+import Data.Hashable (Hashable(hashWithSalt))+import Data.Hashable.Lifted (Hashable1(liftHashWithSalt))+import Data.Hashable.Generic (genericLiftHashWithSalt)+import Data.List (intercalate, null, uncons, unsnoc, (++))+import Data.Maybe (isJust)+import GHC.Base+  ( Applicative (pure),+    Bool(False),+    Eq ((==)),+    Functor (fmap),+    Maybe (Just, Nothing),     String,-    fmap,+    not,     seq,-    show,     ($),     (&&),     (.),     (<>),-    (==),+    (>=)   )+import GHC.Generics (Generic1)+import GHC.Natural (Natural)+import GHC.Num (Num)+import GHC.Show (Show (show))+import NumHask+  ( Additive,+    Divisive,+    ExpField,+    FromInteger,+    Multiplicative,+    Subtractive,+    TrigField,+    fromIntegral,+    one,+    zero,+  )+import qualified NumHask as NH import qualified Prelude as P  -- | Expression F-algebra functional. data SimpleExprF a-  = NumberF Integer+  = NumberF Natural   | VariableF String-  | BinaryFuncF String a a   | SymbolicFuncF String [a]-  deriving (Functor, Eq)+  deriving (Functor, Eq, Generic1) +instance Hashable1 SimpleExprF where+  liftHashWithSalt = genericLiftHashWithSalt++instance Hashable a => Hashable (SimpleExprF a) where+  hashWithSalt salt (NumberF n) = hashWithSalt salt n+  hashWithSalt salt (VariableF s) = hashWithSalt salt s+  hashWithSalt salt (SymbolicFuncF name xs) =+    salt `hashWithSalt` name `hashWithSalt` xs++-- | Equality comparison for `SimpleExprF` lifted over its parameter. 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+-- | `SimpleExprF` instance of `NumHask.FromIntegral` typeclass.+instance+  (NH.FromIntegral Natural n) =>+  NH.FromIntegral (SimpleExprF a) n+  where+  fromIntegral = NumberF . fromIntegral  -- | Simple expression type, see -- [tutorial](Debug.SimpleExpr.Tutorial.hs) type SimpleExpr = Fix SimpleExprF +-- | Short type alias for `SimpleExpr`.+type SE = SimpleExpr+ -- | Initializes a single integer number expression. -- -- ==== __Examples of usage__@@ -89,7 +127,7 @@ -- 42 -- >>> :t a -- a :: SimpleExpr-number :: Integer -> SimpleExpr+number :: Natural -> SimpleExpr number n = Fix (NumberF n)  -- | Initializes a single symbolic variable expression.@@ -112,16 +150,19 @@ -- >>> import NumHask ((+), (*)) -- -- >>> dependencies (variable "x" + (variable "y" * variable "z"))--- [x,y·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+-- | `SimpleExpr` instance of `NumHask.FromIntegral` typeclass.+instance+  (NH.FromIntegral Natural n) =>+  NH.FromIntegral SimpleExpr n+  where+  fromIntegral = number . fromIntegral  -- | 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.@@ -143,30 +184,43 @@   -- | Returns a list of entities the argument consists of.   content :: outer -> [inner] +-- | Base case instance of `ListOf`. instance ListOf inner () where   content = P.const [] +-- | Identity instance of `ListOf`. instance ListOf inner inner where   content e = [e] -instance (ListOf inner outer1, ListOf inner outer2) => ListOf inner (outer1, outer2) where+-- | Tuple instance of `ListOf`.+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+-- | Triple instance of `ListOf`.+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 +-- | 4-tuple instance of `ListOf`. 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 +-- | 5-tuple instance of `ListOf`. 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 +-- | List `[]` instance of `ListOf`. instance (ListOf inner outer) => ListOf inner [outer] where   content = (content P.=<<) @@ -174,21 +228,37 @@ -- It includes `SimpleExpr` as well as list and tuples of `SimpleExpr` etc. type Expr = ListOf SimpleExpr +-- | `SimpleExpr` instance of `Show` typeclass. 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) <> ")"+    sf@(SymbolicFuncF name args) -> case matchBinnaryFuncPattern (Fix sf) of+      Just (name', leftArg, rightArg) -> showWithBrackets leftArg <> name' <> showWithBrackets rightArg+      Nothing -> name <> "(" <> intercalate "," (fmap show args) <> ")" +-- | Checks whether expression needs brackets in a context like binary function argument.+needBrackets :: SimpleExpr -> Bool+needBrackets = isJust . matchBinnaryFuncPattern+ -- | 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+showWithBrackets e =+  if needBrackets e+    then "(" <> show e <> ")"+    else show e +-- | Matches binary function pattern.+matchBinnaryFuncPattern :: SimpleExpr -> Maybe (String, SimpleExpr, SimpleExpr)+matchBinnaryFuncPattern (Fix (SymbolicFuncF name [x, y])) = do+  (first, rest1) <- uncons name+  (body, lastCh) <- unsnoc rest1+  guard $ first == '('+  guard $ lastCh == ')'+  guard $ not (null body)+  pure (body, x, y)+matchBinnaryFuncPattern _ = Nothing+ -- | Inituialize unarry function -- -- ==== __Examples of usage__@@ -220,41 +290,44 @@ -- >>> :t x-*-y -- x-*-y :: SimpleExpr binaryFunc :: String -> SimpleExpr -> SimpleExpr -> SimpleExpr-binaryFunc name x y = Fix (BinaryFuncF name x y)+binaryFunc name x y = Fix $ SymbolicFuncF ("(" <> name <> ")") [x, y] +-- | `SimpleExpr` instance of `NumHask.FromInteger` typeclass.+instance FromInteger SimpleExpr where+  fromInteger n =+    if n >= 0+      then number $ fromIntegral n+      else NH.negate $ number $ fromIntegral $ P.abs n++-- | `SimpleExpr` instance of `NumHask.Additive` typeclass. instance Additive SimpleExpr where   zero = number 0   (+) = binaryFunc "+" +-- | `SimpleExpr` instance of `NumHask.Subtractive` typeclass. instance Subtractive SimpleExpr where   negate = unaryFunc "-"   (-) = binaryFunc "-" +-- | `SimpleExpr` instance of `NumHask.Multiplicative` typeclass. instance Multiplicative SimpleExpr where   one = number 1-  (*) = binaryFunc "·"--#if MIN_VERSION_numhask(0,11,0)-#else-instance NH.Distributive SimpleExpr-#endif+  (*) = binaryFunc "*" +-- | `SimpleExpr` instance of `NumHask.Divisive` typeclass. instance Divisive SimpleExpr where   (/) = binaryFunc "/" -#if MIN_VERSION_numhask(0,11,0)-#else-instance NH.Field SimpleExpr-#endif-+-- | `SimpleExpr` instance of `NumHask.ExpField` typeclass. instance ExpField SimpleExpr where   exp = unaryFunc "exp"   log = unaryFunc "log"   (**) = binaryFunc "^"   sqrt = unaryFunc "sqrt" +-- | `SimpleExpr` instance of `NumHask.TrigField` typeclass. instance TrigField SimpleExpr where-  pi = variable "π"+  pi = variable "pi"   sin = unaryFunc "sin"   cos = unaryFunc "cos"   tan = unaryFunc "tg"@@ -269,6 +342,27 @@   acosh = unaryFunc "arcch"   atanh = unaryFunc "arcth" +-- | Numeric typeclass instance for `SimpleExpr`.+--+-- This instance enables standard numeric operations on symbolic expressions,+-- allowing for more natural mathematical notation in symbolic computations.+--+-- ==== __Examples of usage__+--+-- >>> import GHC.Num ((+))+--+-- The primary benefit of this instance is enabling direct use of numeric+-- literals in symbolic expressions without explicit conversion. This allows+-- you to write natural mathematical expressions:+--+-- >>> x = variable "x"+-- >>> x + 1+-- x+1+--+-- This concise notation is equivalent to the more verbose explicit form:+--+-- >>> x + (number 1)+-- x+1 instance Num SimpleExpr where   (+) = (NH.+)   (-) = (NH.-)@@ -276,7 +370,7 @@   negate = NH.negate   abs = unaryFunc "abs"   signum = unaryFunc "sign"-  fromInteger = number+  fromInteger = fromIntegral  -- | Applies a function recursivelly until it has no effect. -- Strict.@@ -287,7 +381,7 @@ -- >>> import Prelude (Integer, div) -- >>> iterateUntilEqual (`div` 2) (1000 :: Integer) -- 0-iterateUntilEqual :: Eq x => (x -> x) -> x -> x+iterateUntilEqual :: (Eq x) => (x -> x) -> x -> x iterateUntilEqual f x =   let fx = f x    in if fx == x@@ -310,41 +404,55 @@ 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+  Fix (SymbolicFuncF name [arg]) -> case name of+    "-" -> case unFix (f arg) of+      NumberF 0 -> Fix $ NumberF 0+      SymbolicFuncF "-" [arg'] -> f arg'+      SymbolicFuncF "(-)" [leftArg, rightArg] -> Fix $ SymbolicFuncF "(-)" [f rightArg, f leftArg]+      _ -> Fix $ SymbolicFuncF "-" [f arg]+    _ -> Fix $ SymbolicFuncF name [f arg]+  Fix (SymbolicFuncF 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+      _ -> Fix (SymbolicFuncF "(+)" [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)+          else Fix (SymbolicFuncF "(-)" [fX, fY])         where           fX = f leftArg           fY = f rightArg-    "·" -> case (unFix leftArg, unFix rightArg) of+    "(*)" -> 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+      (SymbolicFuncF "-" [leftArg'], SymbolicFuncF "-" [rightArg']) ->+        Fix $ SymbolicFuncF "(*)" [f leftArg', f rightArg']+      (SymbolicFuncF "-" [leftArg'], rightArg') ->+        Fix $ SymbolicFuncF "-" [Fix $ SymbolicFuncF "(*)" [leftArg', Fix rightArg']]+      (leftArg', SymbolicFuncF "-" [rightArg']) ->+        Fix $ SymbolicFuncF "-" [Fix $ SymbolicFuncF "(*)" [Fix leftArg', rightArg']]+      _ -> Fix (SymbolicFuncF "(*)" [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 "(^)" [f leftArg, f rightArg])+    _ -> Fix (SymbolicFuncF 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.+-- | Simplify expression using some primitive rules+-- like '0 * x -> 0' specified in 'simplifyStep' implementation. -- -- ==== __Examples of usage__ --@@ -353,7 +461,12 @@ -- >>> import NumHask ((+), (-), (*)) -- -- >>> x = variable "x"--- >>> simplify $ (x + 0) * 1 - x * (3 - 2)+-- >>> simplifyExpr $ (x + 0) * 1 - x * (3 - 2) -- 0-simplify :: SimpleExpr -> SimpleExpr-simplify = fix $ iterateUntilEqual . simplifyStep -- simplify = iterateUntilEqual (simplifyStep simplify)+simplifyExpr :: SimpleExpr -> SimpleExpr+simplifyExpr = fix $ iterateUntilEqual . simplifyStep++-- | Simplify expression using some primitive rules+-- like '0 * x -> 0' specified in `simplifyStep` implementation.+simplify :: (ExtandableMap SimpleExpr SimpleExpr a a) => a -> a+simplify = extendMap simplifyExpr
src/Debug/SimpleExpr/GraphUtils.hs view
@@ -33,7 +33,7 @@ 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+  --  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)@@ -64,7 +64,7 @@ -- We expect something like -- @fromList [("y",[("x-y",()),("x+y",())]),("x-y",[]),("x",[("x-y",()),("x+y",())]),("x+y",[])]@ -- depending on the packages version version.-exprToGraph :: Expr d => d -> DGraph String ()+exprToGraph :: (Expr d) => d -> DGraph String () exprToGraph d = case content d of   [] -> empty -- insertVertex (name e) empty   [v] -> simpleExprToGraph v@@ -88,5 +88,5 @@ -- @>>> plotExpr [x + y, x - y]@ -- -- ![x+y,x-y](doc/images/demo2.png)-plotExpr :: Expr d => d -> IO ThreadId+plotExpr :: (Expr d) => d -> IO ThreadId plotExpr = plotDGraph . exprToGraph
src/Debug/SimpleExpr/Tutorial.hs view
@@ -9,7 +9,7 @@ -- Tutorial, Quick start or Demo for 'simple-expr' package. module Debug.SimpleExpr.Tutorial   ( -- * Quick start-    -- $quick_start2+    -- $quick_start      -- * Expression simplification     -- $expression_simplification@@ -26,7 +26,7 @@ import NumHask (sin, (**)) import Prelude (FilePath, IO, String) --- $quick_start2 #simple_expr_tutorial_head#+-- $quick_start #simple_expr_tutorial_head# -- -- >>> import Prelude (String) -- >>> import Debug.SimpleExpr (variable, unaryFunc, binaryFunc)@@ -53,14 +53,16 @@ -- 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+-- 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.+-- There is also a typeclass `Expr` that includes `SimpleExpr`+-- as well as it's tuples and lists.  -- $expression_simplification -- >>> import Prelude (($))@@ -70,7 +72,7 @@ -- 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)+-- >>> simplify $ (x + 0) * 1 - x * (3 - 2) :: SimpleExpr -- 0  -- $visualisation@@ -111,12 +113,11 @@ -- -- 'exprToGraph'@ :: @'Expr'@ d => d -> @'DGraph' 'String'@ () @ ----- transforms an expression to a graph--- and+-- transforms an expression to a graph and -- -- 'plotDGraphPng'@ :: @'DGraph'@ v e -> @'FilePath'@ -> @'IO' 'FilePath'. ----- plats the graph.+-- plots the graph. -- -- Consider now a more representative example --@@ -132,4 +133,4 @@ --   expr = exp (i * k * x) + exp (-(i * k * x)) -- :} ----- ![image description](doc/images/imaginary_expr_sum.png)+-- ![image description](main_page_images/imaginary_expr_sum.png)
+ src/Debug/SimpleExpr/Utils/Algebra.hs view
@@ -0,0 +1,668 @@+-- | Module    :  Debug.SimpleExpr.Utils.Algebra+-- Copyright   :  (C) 2025 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Inegral power type class and instances.+module Debug.SimpleExpr.Utils.Algebra+  ( MultiplicativeAction,+    (*|),+    Convolution,+    (|*|),+    AlgebraicPower,+    IntPower,+    IntegerPower,+    NaturalPower,+    FloatPower,+    DoublePower,+    (^^),+    (^),+    square,+    qube,+    splitIntoN,+    splitInto4,+  )+where++import Combinatorics (binomialSeq)+import Data.Functor (Functor (fmap))+import Data.Functor.Identity (Identity (Identity))+import Data.Int (Int, Int16, Int32, Int64, Int8)+import qualified Data.List as DL+import qualified Data.Stream as DS+import qualified Data.Vector as DV+import qualified Data.Vector.Generic as DVG+import qualified Data.Vector.Generic.Sized as DVGS+import qualified Data.Vector.Unboxed as DVU+import Data.Word (Word, Word16, Word32, Word64, Word8)+import Debug.SimpleExpr (SimpleExpr)+import GHC.Base (Double, Eq ((==)), Float, Maybe, otherwise, ($), (.), (>=))+import GHC.Integer (Integer)+import GHC.Natural (naturalFromInteger)+import qualified GHC.Num as GHCN+import GHC.Real (Integral, Real, fromIntegral, mod, realToFrac, toInteger)+import qualified GHC.Real+import GHC.TypeLits (Natural)+import NumHask+  ( Complex (Complex),+    Field,+    Multiplicative,+    Ring,+    Subtractive,+    negate,+    recip,+    (*),+    (-),+  )+import qualified NumHask as NH++-- | Type class for multiplicative actions.+-- This class defines a method for multiplying a value of type @b@+-- by a value of type @a@ producing a value of type @b@.+--+-- ==== __Examples__+--+-- >>> (2 :: Int) *| (3 :: Float) :: Float+-- 6.0+--+-- >>> (2 :: Int) *| (3 :: Float, 4 :: Double) :: (Float, Double)+-- (6.0,8.0)+--+-- >>> (2 :: Natural) *| [3, 4, 5] :: [Int]+-- [6,8,10]+--+-- >>> (2 :: Natural) *| Data.Vector.fromList [3, 4, 5] :: Data.Vector.Vector Int+-- [6,8,10]+--+-- >>> (2 :: Natural) *| [(3, 4), (5, 6), (7, 8)] :: [(Int, Int)]+-- [(6,8),(10,12),(14,16)]+--+-- >>> (2 :: Natural) *| Data.Vector.fromList [[3, 4], [], [5]] :: Data.Vector.Vector [Int]+-- [[6,8],[],[10]]+class MultiplicativeAction a b where+  -- | Left multiplicative action operator that preserve+  -- the type on the right hand side.+  (*|) :: a -> b -> b++-- | `Int` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Int+  where+  (*|) c = (fromIntegral c *)++-- | `Int8` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Int8+  where+  (*|) c = (fromIntegral c *)++-- | `Int16` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Int16+  where+  (*|) c = (fromIntegral c *)++-- | `Int32` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Int32+  where+  (*|) c = (fromIntegral c *)++-- | `Int64` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Int64+  where+  (*|) c = (fromIntegral c *)++-- | `Word` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Word+  where+  (*|) c = (fromIntegral c *)++-- | `Word8` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Word8+  where+  (*|) c = (fromIntegral c *)++-- | `Word16` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Word16+  where+  (*|) c = (fromIntegral c *)++-- | `Word32` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Word32+  where+  (*|) c = (fromIntegral c *)++-- | `Word64` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Word64+  where+  (*|) c = (fromIntegral c *)++-- | `Integer` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Integer+  where+  (*|) c = (fromIntegral c *)++-- | `Natural` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a Natural+  where+  (*|) c = (fromIntegral c *)++-- | `Float` instance of `MultiplicativeAction`@ a@.+instance+  (Real a) =>+  MultiplicativeAction a Float+  where+  (*|) c = (realToFrac c *)++-- | `Double` instance of `MultiplicativeAction`@ a@.+instance+  (Real a) =>+  MultiplicativeAction a Double+  where+  (*|) c = (realToFrac c *)++-- | `SimpleExpr` instance of `MultiplicativeAction`@ a@.+instance+  (Integral a) =>+  MultiplicativeAction a SimpleExpr+  where+  (*|) c = (*) (NH.fromInteger $ toInteger c)++-- | Tuple instance of `MultiplicativeAction`@ a@.+instance+  (MultiplicativeAction a b0, MultiplicativeAction a b1) =>+  MultiplicativeAction a (b0, b1)+  where+  (*|) c (x0, x1) = (c *| x0, c *| x1)++-- | Triple instance of `MultiplicativeAction`@ a@.+instance+  ( MultiplicativeAction a b0,+    MultiplicativeAction a b1,+    MultiplicativeAction a b2+  ) =>+  MultiplicativeAction a (b0, b1, b2)+  where+  (*|) c (x0, x1, x2) = (c *| x0, c *| x1, c *| x2)++-- | `Data.Functor.Identity` instance of `MultiplicativeAction`@ a@.+instance+  (MultiplicativeAction a b) =>+  MultiplicativeAction a (Identity b)+  where+  (*|) = fmap . (*|)++-- | List `[]` instance of `MultiplicativeAction`@ a@.+instance+  (MultiplicativeAction a b) =>+  MultiplicativeAction a [b]+  where+  (*|) = fmap . (*|)++-- | Boxed vector `Data.Vector.Vector` instance of `MultiplicativeAction`@ a@.+instance+  (MultiplicativeAction a b) =>+  MultiplicativeAction a (DV.Vector b)+  where+  (*|) = DV.map . (*|)++-- | Unboxed vector `Data.Vector.Unboxed.Vector` instance+-- of `MultiplicativeAction`@ a@.+instance+  (MultiplicativeAction a b) =>+  MultiplicativeAction a (DVGS.Vector DV.Vector n b)+  where+  (*|) = DVGS.map . (*|)++-- | `Data.Stream.Stream` instance of `MultiplicativeAction`@ a@.+instance+  (MultiplicativeAction a b) =>+  MultiplicativeAction a (DS.Stream b)+  where+  (*|) = DS.map . (*|)++-- | Type class for convolution operations that support nested structures.+--+-- ==== __Examples__+--+-- >>> [1,1,1] |*| [1,2,0] :: Int+-- 3+--+-- >>> ([1,1,1], Data.Vector.fromList [1, 2]) |*| ([1,2,0], Data.Vector.fromList [0, 2]) :: Int+-- 7+class Convolution a b c where+  -- | The convolution operator that combines values of type @a@ and @b@.+  (|*|) :: a -> b -> c++-- | `Int` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Int Int a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Int8` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Int8 Int8 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Int16` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Int16 Int16 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Int32` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Int32 Int32 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Int64` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Int64 Int64 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Word` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Word Word a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Word8` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Word8 Word8 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Word16` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Word16 Word16 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Word32` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Word32 Word32 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Word64` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Word64 Word64 a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Integer` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Integer Integer a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Natural` instance of `Convolution`.+instance+  (GHCN.Num a) =>+  Convolution Natural Natural a+  where+  x |*| y = fromIntegral x GHCN.* fromIntegral y++-- | `Float` instance of `Convolution`.+instance+  (GHC.Real.Fractional a) =>+  Convolution Float Float a+  where+  x |*| y = realToFrac x GHCN.* realToFrac y++-- | `Double` instance of `Convolution`.+instance+  (GHC.Real.Fractional a) =>+  Convolution Double Double a+  where+  x |*| y = realToFrac x GHCN.* realToFrac y++-- | Tuple instance of `Convolution`.+instance+  (Convolution a0 b0 c, Convolution a1 b1 c, NH.Additive c) =>+  Convolution (a0, a1) (b0, b1) c+  where+  (x0, x1) |*| (y0, y1) = x0 |*| y0 NH.+ x1 |*| y1++-- | Triple instance of `Convolution`.+instance+  (Convolution a0 b0 c, Convolution a1 b1 c, Convolution a2 b2 c, NH.Additive c) =>+  Convolution (a0, a1, a2) (b0, b1, b2) c+  where+  (x0, x1, x2) |*| (y0, y1, y2) = x0 |*| y0 NH.+ x1 |*| y1 NH.+ x2 |*| y2++-- | `Data.Functor.Identity` instance of `Convolution`.+instance+  (Convolution a b c) =>+  Convolution (Identity a) (Identity b) c+  where+  (Identity x) |*| (Identity y) = x |*| y++-- | List `[]` instance of `Convolution`.+-- Shorter list is efficently treated as padded with zeros.+instance+  (Convolution a b c, NH.Additive c) =>+  Convolution [a] [b] c+  where+  lx |*| ly = DL.foldl' (NH.+) NH.zero $ DL.zipWith (|*|) lx ly++-- | Boxed vector `Data.Vector.Vector` instance of `Convolution`.+-- Smaller vector is efficently treated as padded with zeros.+instance+  (Convolution a b c, NH.Additive c) =>+  Convolution (DV.Vector a) (DV.Vector b) c+  where+  vx |*| vy = DV.foldl' (NH.+) NH.zero $ DV.zipWith (|*|) vx vy++-- | Unboxed vector `Data.Vector.Unboxed.Vector` instance of `Convolution`.+-- Smaller vector is efficently treated as padded with zeros.+instance+  (Convolution a b c, NH.Additive c) =>+  Convolution (DVGS.Vector DV.Vector n a) (DVGS.Vector DV.Vector n b) c+  where+  vx |*| vy = DVGS.foldl' (NH.+) NH.zero $ DVGS.zipWith (|*|) vx vy++-- instance+--   MultiplicativeAction a b c =>+--   MultiplicativeAction (FiniteSupportStream a) (DS.Stream b) c+--   where+--   vx |*| vy = undefined --   foldl' zero (+) $ DVGS.zipwith (|*|) lx ly+--   -- (*|) = DS.map . (*|)++-- instance+--   MultiplicativeAction a b c =>+--   MultiplicativeAction (DS.Stream a) (FiniteSupportStream b) c+--   where+--   vx |*| vy = undefined --   foldl' zero (+) $ DVGS.zipwith (|*|) lx ly++-- instance+--   MultiplicativeAction a b c =>+--   MultiplicativeAction (FiniteSupportStream a) (FiniteSupportStream b) c+--   where+--   vx |*| vy = undefined --   foldl' zero (+) $ DVGS.zipwith (|*|) lx ly++-- | Type class for power operations.+-- This class defines a method for raising a value of type @a@ to a power+-- of type @b@.+-- It is usefull to deistinguish, for example,+-- the integral power defined as a repetative multiplication+-- `(^^)` or `(^)` from the general power operation.+--+-- ==== __Examples__+--+-- >>> import Debug.SimpleExpr (variable, SE, simplify)+-- >>> import GHC.Base (($))+-- >>> import GHC.Real (Rational)+-- >>> import qualified NumHask+--+-- >>> x = variable "x"+--+-- >>> (^^ 2) x+-- x^2+--+-- >>> (NumHask.^^ 2) (x)+-- x*x+--+-- >>> (^^ 2) (3 :: Float)+-- 9.0+--+-- >>> (2.0 :: Double) ^^ (3.5 :: Float)+-- 11.313708498984761+--+-- For lists, vectors and other containers, the power operation is applied element-wise:+-- >>> (^^ 2) [0, 1, 2, 3] :: [Int]+-- [0,1,4,9]+class AlgebraicPower a b where+  (^^) :: b -> a -> b++-- | `Int` type alias for `AlgebraicPower`.+type IntPower a = AlgebraicPower Int a++-- | `Integer` type alias for `AlgebraicPower`.+type IntegerPower a = AlgebraicPower Integer a++-- | `Natural` type alias for `AlgebraicPower`.+type NaturalPower a = AlgebraicPower Natural a++-- | `Float` type alias for `AlgebraicPower`.+type FloatPower a = AlgebraicPower Float a++-- | `Double` type alias for `AlgebraicPower`.+type DoublePower a = AlgebraicPower Double a++-- | Infix synonym for `(^^)`.+(^) :: (AlgebraicPower Integer a) => a -> Integer -> a+(^) = (^^)++-- | Square a value.+square :: (AlgebraicPower Integer a) => a -> a+square x = x ^ 2++-- | Qube a value.+qube :: (AlgebraicPower Integer a) => a -> a+qube x = x ^ 2++-- | `Int` instance of `AlgebraicPower` typeclass.+instance+  (Integral a) =>+  AlgebraicPower a Int+  where+  x ^^ n = x GHC.Real.^ n++-- | `Int8` instance of `AlgebraicPower` typeclass.+instance+  (Integral a) =>+  AlgebraicPower a Int8+  where+  x ^^ n = x GHC.Real.^ n++-- | `Integer` instance of `AlgebraicPower` typeclass.+instance+  (Integral a) =>+  AlgebraicPower a Integer+  where+  x ^^ n = x GHC.Real.^ n++-- | `Float` instace of `AlgebraicPower` typeclass.+instance+  (Real a) =>+  AlgebraicPower a Float+  where+  x ^^ n = x NH.** realToFrac n++-- | `Double` instance of `AlgebraicPower` typeclass+-- for raising `Double` values to `Real` exponents.+instance+  (Real a) =>+  AlgebraicPower a Double+  where+  x ^^ n = x NH.** realToFrac n++-- | `AlgebraicPower` instance for raising `SimpleExpr` values to `Integer` exponents.+instance AlgebraicPower Integer SimpleExpr where+  x ^^ n = x NH.** NH.fromInteger n++-- | `Data.Functor.Identity` instance of `AlgebraicPower` typeclass.+instance+  (AlgebraicPower b a) =>+  AlgebraicPower b (Identity a)+  where+  (Identity x0) ^^ n = Identity $ x0 ^^ n++-- | `Maybe` instance of `AlgebraicPower` typeclass.+instance+  (AlgebraicPower b a) =>+  AlgebraicPower b (Maybe a)+  where+  x ^^ n = fmap (^^ n) x++-- | Generate the list of terms of the binomial expansion of+-- \( (x + y)^n \).+--+-- ==== __Examples__+--+-- >>> import Debug.SimpleExpr (variable, simplify)+--+-- >>> simplify $ biniminalList 3 (variable "x") (variable "y")+-- [y^3,3*(x*(y^2)),3*((x^2)*y),x^3]+biniminalList ::+  ( Multiplicative a,+    AlgebraicPower b a,+    MultiplicativeAction b a,+    Subtractive b,+    Integral b+  ) =>+  b ->+  a ->+  a ->+  [a]+biniminalList n x y =+  DL.zipWith+    (*|)+    (binomialSeq n)+    ([x ^^ i * y ^^ (n - i) | i <- [0 ..]])++-- | Interleave two lists.+--+-- ==== __Examples__+--+-- >>> interleave [1,3,5] [2,4,6]+-- [1,2,3,4,5,6]+interleave :: [a] -> [a] -> [a]+interleave [] ys = ys+interleave xs [] = xs+interleave (x : xs) (y : ys) = x : y : interleave xs ys++-- | Take every n-th element from a list starting from a given index.+--+-- ==== __Examples__+--+-- >>> takeEveryNth 3 0 [0..11]+-- [0,3,6,9]+takeEveryNth :: Int -> Int -> [a1] -> [a1]+takeEveryNth n start ys = [y | (y, j) <- DL.zip ys [0 ..], j `mod` n == start]++-- | Split a list into n lists by taking every n-th element.+--+-- ==== __Examples__+--+-- >>> splitIntoN 3 [0..11]+-- [[0,3,6,9],[1,4,7,10],[2,5,8,11]]+splitIntoN :: Int -> [a] -> [[a]]+splitIntoN n xs = [takeEveryNth n i xs | i <- [0 .. n - 1]]++-- | Split a list into n lists by taking every n-th element.+--+-- ==== __Examples__+--+-- >>> splitInto4 [0..11]+-- ([0,4,8],[1,5,9],[2,6,10],[3,7,11])+splitInto4 :: [a] -> ([a], [a], [a], [a])+splitInto4 xs = (takeEveryNth 4 0 xs, takeEveryNth 4 1 xs, takeEveryNth 4 2 xs, takeEveryNth 4 3 xs)++-- | Complex number `NumHask.Complex` instance of `AlgebraicPower`+-- for raising to `Natural` exponents.+instance+  (Ring a, AlgebraicPower Natural a, MultiplicativeAction Natural a) =>+  AlgebraicPower Natural (Complex a)+  where+  (Complex (x, y)) ^^ n = Complex (r, i)+    where+      r = NH.sum $ interleave split0 (fmap negate split2)+      i = NH.sum $ interleave split1 (fmap negate split3)+      (split0, split1, split2, split3) = splitInto4 (biniminalList n x y)++-- | Complex number `NumHask.Complex` instance of `AlgebraicPower`+-- for raising to `Integer` exponents.+instance+  (Field a, AlgebraicPower Natural a, MultiplicativeAction Natural a) =>+  AlgebraicPower Integer (Complex a)+  where+  x ^^ n+    | n >= 0 = x ^^ naturalFromInteger n+    | otherwise = recip $ x ^^ naturalFromInteger (-n)++-- | `AlgebraicPower` instance for raising tuples to powers.+instance+  (AlgebraicPower b a0, AlgebraicPower b a1) =>+  AlgebraicPower b (a0, a1)+  where+  (x0, x1) ^^ n = (x0 ^^ n, x1 ^^ n)++-- | `AlgebraicPower` instance for raising triples to powers.+instance+  (AlgebraicPower b a0, AlgebraicPower b a1, AlgebraicPower b a2) =>+  AlgebraicPower b (a0, a1, a2)+  where+  (x0, x1, x2) ^^ n = (x0 ^^ n, x1 ^^ n, x2 ^^ n)++-- | `AlgebraicPower` instance for raising lists to powers.+instance+  (AlgebraicPower b a) =>+  AlgebraicPower b [a]+  where+  x ^^ n = fmap (^^ n) x++-- | `AlgebraicPower` instance for raising boxed vectors to powers.+instance+  (AlgebraicPower b a) =>+  AlgebraicPower b (DV.Vector a)+  where+  x ^^ n = DV.map (^^ n) x++-- | `AlgebraicPower` instance for raising unboxed vectors to powers.+instance+  (AlgebraicPower b a, DVU.Unbox a) =>+  AlgebraicPower b (DVU.Vector a)+  where+  x ^^ n = DVU.map (^^ n) x++-- | `AlgebraicPower` instance for raising sized vectors to powers.+instance+  (AlgebraicPower b a, DVG.Vector v a) =>+  AlgebraicPower b (DVGS.Vector v n a)+  where+  x ^^ n = DVGS.map (^^ n) x++-- | `AlgebraicPower` instance for raising streams to powers.+instance+  (AlgebraicPower b a) =>+  AlgebraicPower b (DS.Stream a)+  where+  x ^^ n = DS.map (^^ n) x
+ src/Debug/SimpleExpr/Utils/Traced.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-export-lists #-}++-- | Module    :  Debug.SimpleExpr.Utils.Traced+-- Copyright   :  (C) 2025 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- This module provides a `Traced` type that wraps values with and adds automatic+-- tracing functionality from+-- 'Debug.Trace'+-- for debugging purposes. When operations are performed+-- on `Traced` values, they output trace messages showing what computations+-- are being performed.+--+-- = Overview+--+-- The `Traced` type is particularly useful for:+--+--   * Debugging complex mathematical computations+--   * Understanding the order of operations in lazy evaluation+--   * Tracking intermediate values in symbolic computations+--   * Educational purposes to visualize computation flow+--+-- = Basic Usage+--+-- >>> import Debug.SimpleExpr.Utils.Traced (traced)+--+-- * Create traced values+--+-- >>> x = traced 3+-- >>> y = traced 4+--+-- * Operations automatically trace+--+-- >>> x + y+--  <<< TRACING: Calculating (+) of 3 and 4 >>>+-- 7+--+-- = Integration with NumHask+--+-- This module integrates with the+-- [numhask](https://hackage.haskell.org/package/numhask)+-- hierarchy, providing instances for:+--+-- >>> import NumHask (Additive, Subtractive, Multiplicative, Divisive, ExpField, TrigField)+--+--   * `Additive` - addition and zero+--   * `Subtractive` - subtraction and negation+--   * `Multiplicative` - multiplication and one+--   * `Divisive` - division+--   * `ExpField` - exponential, logarithm, and power+--   * `TrigField` - trigonometric functions+module Debug.SimpleExpr.Utils.Traced+  ( -- * The Traced Type+    Traced (MkTraced, getTraced),++    -- * Creating Traced Values+    traced,+    untraced,++    -- * Tracing Combinators+    addTraceUnary,+    addTraceBinary,+    addTraceTernary,++    -- * Utility Functions+    withTrace,+    traceShow,+  )+where++import Control.ExtendableMap (ExtandableMap (extendMap))+import Data.Hashable (Hashable)+import Debug.SimpleExpr.Utils.Algebra (AlgebraicPower ((^^)), MultiplicativeAction ((*|)))+import Debug.Trace (trace)+import GHC.Base (Eq, Functor (fmap), String, ($), (.), (<>))+import GHC.Int (Int, Int16, Int32, Int64, Int8)+import GHC.Integer (Integer)+import GHC.Natural (Natural)+import GHC.Num (Num)+import qualified GHC.Num as GN+import GHC.Show (Show (show))+import GHC.Word (Word, Word16, Word32, Word64, Word8)+import NumHask+  ( Additive (zero, (+)),+    Distributive,+    Divisive,+    ExpField (exp, log, (**)),+    FromInteger,+    Integral,+    Multiplicative,+    Subtractive (negate, (-)),+    TrigField (acos, acosh, asin, asinh, atan, atan2, atanh, cos, cosh, pi, sin, sinh),+    fromInteger,+    one,+    zero,+    (*),+    (/),+  )++-- | A wrapper type that adds tracing to any value.+--+-- When operations are performed on `Traced` values, they output+-- trace messages to stderr showing what computations are happening.+--+-- ==== __Examples__+--+-- Basic arithmetic with tracing:+--+-- >>> x = traced 5+-- >>> y = traced 3+-- >>> x * y+--  <<< TRACING: Calculating (*) of 5 and 3 >>>+-- 15+--+-- Tracing can be nested:+--+-- >>> (x + y) * (x - y)+--  <<< TRACING: Calculating (+) of 5 and 3 >>>+--  <<< TRACING: Calculating (-) of 5 and 3 >>>+--  <<< TRACING: Calculating (*) of 8 and 2 >>>+-- 16+newtype Traced a = MkTraced {getTraced :: a}+  deriving (Eq, Hashable, Functor, FromInteger)++-- | Smart constructor for creating traced values.+--+-- This is equivalent to using the `MkTraced` constructor directly,+-- but provides a more descriptive name.+--+-- ==== __Examples__+--+-- >>> traced 42+-- 42+traced :: a -> Traced a+traced = MkTraced++-- | Extract the underlying value from a `Traced` wrapper.+-- It is equivalent to using the `getTraced`.+--+-- ==== __Examples__+--+-- >>> untraced (traced 42)+-- 42+untraced :: Traced a -> a+untraced = getTraced++-- | Apply a unary function with tracing.+--+-- This is the core building block for traced unary operations.+-- It outputs a trace message before applying the function.+--+-- ==== __Examples__+--+-- >>> import GHC.Num (abs)+--+-- >>> absoluteTraced = addTraceUnary "abs" abs+-- >>> absoluteTraced (traced (-5))+--  <<< TRACING: Calculating abs of -5 >>>+-- 5+--+-- Custom unary operations:+--+-- >>> double = addTraceUnary "double" (\x -> x * 2)+-- >>> double (traced 7)+--  <<< TRACING: Calculating double of 7 >>>+-- 14+addTraceUnary :: (Show a) => String -> (a -> b) -> Traced a -> Traced b+addTraceUnary name f (MkTraced x) =+  trace (" <<< TRACING: Calculating " <> name <> " of " <> show x <> " >>>") $+    MkTraced $+      f x++-- | Apply a binary function with tracing.+--+-- This is the core building block for traced binary operations.+-- It outputs a trace message before applying the function.+--+-- ==== __Examples__+--+-- Basic binary operation:+--+-- >>> two = traced 2+-- >>> three = traced 3+-- >>> addTraced = addTraceBinary "(+)" (+)+-- >>> addTraced two three+--  <<< TRACING: Calculating (+) of 2 and 3 >>>+-- 5+--+-- With symbolic expressions (assuming 'Debug.SimpleExpr' is imported):+--+-- >>> import Debug.SimpleExpr (variable)+-- >>> x = traced $ variable "x"+-- >>> y = traced $ variable "y"+-- >>> z = x + y+-- >>> z ** 2+--  <<< TRACING: Calculating (+) of x and y >>>+--  <<< TRACING: Calculating (**) of x+y and 2 >>>+-- (x+y)^2+addTraceBinary ::+  (Show a, Show b) =>+  String ->+  (a -> b -> c) ->+  Traced a ->+  Traced b ->+  Traced c+addTraceBinary name f (MkTraced x) (MkTraced y) =+  trace+    ( " <<< TRACING: Calculating "+        <> name+        <> " of "+        <> show x+        <> " and "+        <> show y+        <> " >>>"+    )+    $ MkTraced+    $ f x y++-- | Apply a ternary function with tracing.+--+-- Useful for functions that take three arguments.+--+-- ==== __Examples__+--+-- >>> import Data.Ord (Ord(min, max))+--+-- >>> clamp = addTraceTernary "clamp" (\low high x -> max low (min high x))+-- >>> clamp (traced 0) (traced 10) (traced 15)+--  <<< TRACING: Calculating clamp of 0, 10, and 15 >>>+-- 10+addTraceTernary ::+  (Show a, Show b, Show c) =>+  String ->+  (a -> b -> c -> d) ->+  Traced a ->+  Traced b ->+  Traced c ->+  Traced d+addTraceTernary name f (MkTraced x) (MkTraced y) (MkTraced z) =+  trace+    ( " <<< TRACING: Calculating "+        <> name+        <> " of "+        <> show x+        <> ", "+        <> show y+        <> ", and "+        <> show z+        <> " >>>"+    )+    $ MkTraced+    $ f x y z++-- | Execute a computation with a custom trace message.+--+-- This allows you to add custom trace points in your code.+--+-- ==== __Examples__+--+-- >>> withTrace "Starting computation" $ (traced 3) + (traced 4)+--  <<< TRACING: Starting computation >>>+--  <<< TRACING: Calculating (+) of 3 and 4 >>>+-- 7+withTrace :: String -> Traced a -> Traced a+withTrace msg = trace (" <<< TRACING: " <> msg <> " >>>")++-- | Trace the current value with a custom message.+--+-- ==== __Examples__+--+-- >>> x = traced 42+-- >>> traceShow "Current value" x+--  <<< TRACING: Current value: 42 >>>+-- 42+traceShow :: (Show a) => String -> Traced a -> Traced a+traceShow msg t@(MkTraced x) =+  trace (" <<< TRACING: " <> msg <> ": " <> show x <> " >>>") t++-- | Standard `GHC.Base.Num` instance for compatibility with base Haskell.+instance (GN.Num a, Show a) => GN.Num (Traced a) where+  (+) = addTraceBinary "(+)" (GN.+)+  (*) = addTraceBinary "(*)" (GN.*)+  (-) = addTraceBinary "(-)" (GN.-)+  negate = addTraceUnary "negate" GN.negate+  abs = addTraceUnary "abs" GN.abs+  signum = addTraceUnary "signum" GN.signum+  fromInteger = MkTraced . GN.fromInteger++-- | NumHask `Additive` instance for addition operations.+instance (Additive a, Show a) => Additive (Traced a) where+  (+) = addTraceBinary "(+)" (NumHask.+)+  zero = MkTraced zero++-- | NumHask `Subtractive'`instance for subtraction operations.+instance (Subtractive a, Show a) => Subtractive (Traced a) where+  (-) = addTraceBinary "(-)" (NumHask.-)+  negate = addTraceUnary "negate" NumHask.negate++-- | NumHask `Multiplicative` instance for multiplication operations.+instance (Multiplicative a, Show a) => Multiplicative (Traced a) where+  (*) = addTraceBinary "(*)" (NumHask.*)+  one = MkTraced one++-- | NumHask `Divisive` instance for division operations.+instance (Divisive a, Show a) => Divisive (Traced a) where+  (/) = addTraceBinary "(/)" (/)++-- | NumHask `ExpField` instance for exponential and logarithmic operations.+--+-- >>> import NumHask (exp, log)+-- >>> exp (traced 1)+--  <<< TRACING: Calculating exp of 1.0 >>>+-- 2.718281828459045+--+-- >>> log (traced 10)+--  <<< TRACING: Calculating log of 10.0 >>>+-- 2.302585092994046+--+-- >>> (traced 2) ** (traced 3)+--  <<< TRACING: Calculating (**) of 2.0 and 3.0 >>>+-- 8.0+instance (ExpField a, Show a) => ExpField (Traced a) where+  exp = addTraceUnary "exp" exp+  log = addTraceUnary "log" log+  (**) = addTraceBinary "(**)" (**)++-- | NumHask `TrigField` instance for trigonometric operations.+--+-- >>> cos (traced 0)+--  <<< TRACING: Calculating cos of 0.0 >>>+-- 1.0+instance (TrigField a, Show a) => TrigField (Traced a) where+  sin = addTraceUnary "sin" sin+  cos = addTraceUnary "cos" cos+  pi = MkTraced pi+  asin = addTraceUnary "asin" asin+  acos = addTraceUnary "acos" acos+  atan = addTraceUnary "atan" atan+  atan2 = addTraceBinary "atan2" atan2+  sinh = addTraceUnary "sinh" sinh+  cosh = addTraceUnary "cosh" cosh+  asinh = addTraceUnary "asinh" asinh+  acosh = addTraceUnary "acosh" acosh+  atanh = addTraceUnary "atanh" atanh++-- | Show instance that displays the wrapped value.+--+-- Note that this shows the wrapped value, not the `Traced` constructor.+--+-- >>> show (traced 42)+-- "42"+instance (Show a) => Show (Traced a) where+  show (MkTraced a) = show a++-- `Traced` instance of `AlgebraicPower` typeclass from `Debug.SimpleExpr.Utils.Algebra`.+instance+  (Show b, AlgebraicPower a b) =>+  AlgebraicPower a (Traced b)+  where+  x ^^ n = addTraceUnary "(^^)" (^^ n) x++-- `Traced` instance of `MultiplicativeAction` typeclass+-- from `Debug.SimpleExpr.Utils.Algebra`.+instance+  (Show b, MultiplicativeAction a b) =>+  MultiplicativeAction a (Traced b)+  where+  n *| x = addTraceUnary "(*|)" (n *|) x++-- | `Traced` instance fo `ExtandableMap`typecalss.+instance+  (ExtandableMap a b c d) =>+  ExtandableMap a b (Traced c) (Traced d)+  where+  extendMap f (MkTraced x) = MkTraced $ extendMap f x