├── Algebra ├── HaskSymb.hs └── HaskSymb │ ├── M │ ├── QQ.hs │ ├── PrePat.hs │ └── Parser.hs │ ├── BasicAlgs.hs │ ├── MExpr.hs │ └── Definitions.hs ├── HaskSymb.cabal └── README.md /Algebra/HaskSymb.hs: -------------------------------------------------------------------------------- 1 | 2 | module Algebra.HaskSymb (m, MExpr (..), module Algebra.HaskSymb.BasicAlgs) where 3 | 4 | import Algebra.HaskSymb.Definitions 5 | import Algebra.HaskSymb.BasicAlgs 6 | import Algebra.HaskSymb.MExpr 7 | import Algebra.HaskSymb.M.QQ 8 | 9 | -------------------------------------------------------------------------------- /Algebra/HaskSymb/M/QQ.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, ViewPatterns #-} 2 | 3 | 4 | module Algebra.HaskSymb.M.QQ(m, isConst) where 5 | 6 | -- Based on http://www.haskell.org/haskellwiki/Quasiquotation 7 | 8 | import Data.Pattern 9 | import Algebra.HaskSymb.Definitions 10 | import Algebra.HaskSymb.M.PrePat (isConst) 11 | import Algebra.HaskSymb.M.Parser 12 | import Language.Haskell.TH as TH 13 | import Language.Haskell.TH.Quote 14 | 15 | 16 | --m :: QuasiQuoter 17 | m = QuasiQuoter quoteMathExp quoteMathPat (fail "") (fail "") 18 | 19 | 20 | quoteMathPat :: String -> TH.PatQ 21 | quoteMathPat s = do loc <- TH.location 22 | let pos = (TH.loc_filename loc, 23 | fst (TH.loc_start loc), 24 | snd (TH.loc_start loc)) 25 | expr <- parsePat pos s 26 | return expr 27 | 28 | quoteMathExp :: String -> TH.ExpQ 29 | quoteMathExp = fail "no expression support for math right now" 30 | 31 | -------------------------------------------------------------------------------- /HaskSymb.cabal: -------------------------------------------------------------------------------- 1 | Name: HaskSymb 2 | Version: 0.0.1 3 | cabal-version: >= 1.6 4 | Synopsis: An experiment in Haskell symbolic algebra. 5 | Description: A pretty symbolic algebra library for Haskell. 6 | The m quasiquoter allows math pattern matching. 7 | License: GPL 8 | Author: Christopher Olah 9 | Maintainer: Christopher Olah 10 | Homepage: https://github.com/colah/ImplicitCAD 11 | build-type: Simple 12 | Category: Graphics 13 | 14 | Library 15 | Build-Depends: base >= 3 && < 5, template-haskell, pattern-power, parsec 16 | Extensions: ViewPatterns, TemplateHaskell, GADTs, MultiParamTypeClasses 17 | Exposed-Modules: 18 | Algebra.HaskSymb 19 | Other-Modules: 20 | Algebra.HaskSymb.Definitions 21 | Algebra.HaskSymb.BasicAlgs 22 | Algebra.HaskSymb.MExpr 23 | Algebra.HaskSymb.M.Parser 24 | Algebra.HaskSymb.M.PrePat 25 | Algebra.HaskSymb.M.QQ 26 | -------------------------------------------------------------------------------- /Algebra/HaskSymb/BasicAlgs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, ViewPatterns, TemplateHaskell, QuasiQuotes, NoMonomorphismRestriction #-} 2 | 3 | module Algebra.HaskSymb.BasicAlgs (simplify, expand, collectTerms, diff) where 4 | 5 | import Prelude hiding ((+), (*)) 6 | import Algebra.HaskSymb.M.QQ 7 | import Algebra.HaskSymb.Definitions 8 | 9 | infixl 6 + 10 | a+b = sumC' [a,b] 11 | infixl 7 * 12 | a*b = prodC' [a,b] 13 | 14 | simplify = collectTerms . expand 15 | 16 | --expand :: (SymbolicSum a, SymbolicProd a) => a -> a 17 | expand [m| a+b |] = expand a + expand b 18 | expand [m|a*(b+c)|] = expand (a*b) + expand (a*c) 19 | expand a = a 20 | 21 | 22 | collectTerms [m| aC*x + bC*x + c |] = collectTerms $ (aC+bC)*x + c 23 | collectTerms [m| x + bC*x + c |] = collectTerms $ (constC 1 +bC)*x + c 24 | collectTerms [m| x + x + c |] = collectTerms $ (constC 2)*x + c 25 | collectTerms a = a 26 | 27 | d a = collectTerms $ d' a 28 | where 29 | d' [m| a+b |] = d' a + d' b 30 | d' [m| a*b |] = a * d' b + b * d' a 31 | d' [m| aC |] = constC 0 32 | d' a = diffC a 33 | 34 | diff a b = collectTerms $ expand $ diff' a b 35 | where 36 | diff' var expr | var == expr = 1 37 | diff' var [m| a + b|] = diff' var a + diff' var b 38 | diff' var [m| a * b|] = a* (diff' var b) + b* (diff' var a) 39 | diff' var [m| aC |] = 0 40 | diff' var a = 0 41 | 42 | 43 | -------------------------------------------------------------------------------- /Algebra/HaskSymb/M/PrePat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, ViewPatterns, Rank2Types, FlexibleContexts, FlexibleInstances, GADTs, NoMonomorphismRestriction, TemplateHaskell, TypeSynonymInstances #-} 2 | 3 | module Algebra.HaskSymb.M.PrePat {- (PrePat(..), BoundVar(..), makePat) -} where 4 | 5 | import Prelude hiding (const) 6 | import Language.Haskell.TH as TH 7 | import Language.Haskell.TH.Quote 8 | import qualified Data.List as List 9 | import Data.Pattern 10 | 11 | import Algebra.HaskSymb.Definitions 12 | 13 | type SymbPat a = PrePat a a 14 | 15 | isConst (constD -> Just _) = True 16 | isConst _ = False 17 | 18 | instance (Symbolic Integer a, Eq a) => Symbolic Integer (SymbPat a) where 19 | constD _ = Nothing 20 | constC m = Const (e "constC" $$ n m, constC m) 21 | varD _ = Nothing 22 | varC v@(last -> 'C') = Guard (e "isConst", isConst) $ Free v 23 | varC v = Free v 24 | 25 | instance (SymbolicSum a, Eq a, Symbolic Integer a) => SymbolicSum (SymbPat a) where 26 | sumD _ = Nothing 27 | sumC pats = PreProcess (e "sumD",sumD) $ 28 | ListPat [Commutative, CompressExtra (e "sumC", sumC),FillMissing (e "constC" $$ n 0, constC 0)] pats 29 | 30 | instance (SymbolicProd a, Eq a, Symbolic Integer a) => SymbolicProd (SymbPat a) where 31 | prodD _ = Nothing 32 | prodC pats = PreProcess (e "prodD", prodD) $ 33 | ListPat [Commutative, CompressExtra (e "prodC", prodC),FillMissing (e "constC" $$ n 1, constC 1)] pats 34 | 35 | instance (SymbolicDiff a, Eq a, Symbolic Integer a) => SymbolicDiff (SymbPat a) where 36 | diffD _ = Nothing 37 | diffC pat = PreProcess (e "diffD", diffD) pat 38 | 39 | makePat :: SymbPat a -> Q Pat 40 | makePat = finishPat 41 | 42 | e name = VarE (mkName name) 43 | n num = LitE (IntegerL (fromIntegral num)) 44 | ($$) = AppE 45 | 46 | -------------------------------------------------------------------------------- /Algebra/HaskSymb/M/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleContexts, ScopedTypeVariables, Rank2Types, NoMonomorphismRestriction #-} 2 | 3 | module Algebra.HaskSymb.M.Parser (parsePat) {-(mexpr, parsePat)-} where 4 | 5 | import Prelude hiding (const) 6 | import Algebra.HaskSymb.Definitions 7 | import Algebra.HaskSymb.M.PrePat 8 | import Text.Parsec 9 | import Text.ParserCombinators.Parsec.Expr 10 | import Language.Haskell.TH 11 | 12 | -- The obvious generalization of sepBy and sepBy1 13 | sepBy2 seg sep = do 14 | x <- seg 15 | sep 16 | xs <- sepBy1 seg sep 17 | return (x:xs) 18 | 19 | 20 | 21 | -- essentially from the aformentione quasiquoter tutorial 22 | 23 | parsePat :: (String, Int, Int) -> String -> PatQ 24 | parsePat (file, line, col) s = 25 | case runParser p () "" s of 26 | Left err -> fail $ show err 27 | Right e -> e 28 | where 29 | p = do pos <- getPosition 30 | setPosition $ 31 | (flip setSourceName) file $ 32 | (flip setSourceLine) line $ 33 | (flip setSourceColumn) col $ 34 | pos 35 | many space; 36 | e <- mexpr'; 37 | many space; 38 | eof 39 | return e 40 | 41 | 42 | 43 | -- The 'n' argument is the fixity level we are at 44 | 45 | data Proxy = Proxy 46 | deriving Eq 47 | 48 | instance Symbolic Integer Proxy where 49 | constD _ = Nothing 50 | varD _ = Nothing 51 | constC _ = Proxy 52 | varC _ = Proxy 53 | 54 | instance SymbolicSum Proxy where 55 | sumD _ = Nothing 56 | sumC _ = Proxy 57 | 58 | instance SymbolicProd Proxy where 59 | prodD _ = Nothing 60 | prodC _ = Proxy 61 | 62 | mexpr' :: Parsec [Char] st (Q Pat) 63 | mexpr' = do 64 | a :: SymbPat Proxy <- mexpr 0 65 | return (makePat a) 66 | 67 | 68 | mexpr :: (Symbolic Integer a, SymbolicSum a, SymbolicProd a, Eq a) => 69 | Int -> Parsec [Char] st (SymbPat a) 70 | 71 | mexpr n@5 = 72 | (try $ do 73 | many space 74 | a <- many1 digit 75 | many space 76 | return $ constC (read a :: Integer) 77 | ) <|> (try $ do 78 | many space 79 | a <- many1 letter 80 | many space 81 | return $ varC a 82 | ) <|> (try $ do 83 | char '(' 84 | many space 85 | a <- mexpr 0 86 | many space 87 | char ')' 88 | many space 89 | return a 90 | ) 91 | 92 | mexpr n@4 = 93 | ( try $ do 94 | a <- sepBy2 (mexpr (n+1)) (many space >> char '*' >> many space) 95 | return $ prodC a 96 | ) <|> (mexpr (n+1)) 97 | 98 | mexpr n@3 = 99 | ( try $ do 100 | a <- sepBy2 (mexpr (n+1)) (many space >> char '+' >> many space) 101 | return $ sumC a 102 | ) <|> (mexpr (n+1)) 103 | 104 | mexpr 0 = do 105 | many space 106 | a <- mexpr 3 107 | many space 108 | return a 109 | -------------------------------------------------------------------------------- /Algebra/HaskSymb/MExpr.hs: -------------------------------------------------------------------------------- 1 | 2 | {-# LANGUAGE RankNTypes, ViewPatterns, FlexibleInstances, MultiParamTypeClasses #-} 3 | 4 | module Algebra.HaskSymb.MExpr (MExpr(..)) where 5 | 6 | import Algebra.HaskSymb.Definitions 7 | import Data.List as List 8 | import Data.Maybe as Maybe 9 | 10 | data MExpr a = C a | V String | Sum [MExpr a] | Prod [MExpr a] 11 | | Cos (MExpr a) | Sin (MExpr a) | Tan (MExpr a) 12 | | D (MExpr a) 13 | -- deriving Show 14 | 15 | collectCopies :: (Eq a) => [a] -> [(a, [Int])] 16 | collectCopies vars = map (\var -> (var, poslist 0 var vars )) $ List.nub vars 17 | where 18 | poslist _ _ [] = [] 19 | poslist shift match (x:xs) = 20 | if x == match 21 | then shift : poslist (shift+1) match xs 22 | else poslist (shift+1) match xs 23 | 24 | 25 | 26 | instance (Show a, Eq a, Num a) => Show (MExpr a) where 27 | show = show2 0 where 28 | show2 :: (Show a, Eq a, Num a) => Int -> MExpr a -> String 29 | show2 _ (Sum []) = "EMPTYSUM" 30 | show2 _ (Prod []) = "EMPTYPROD" 31 | show2 n (D val) = if n > 0 || (Maybe.isJust . sumD $ val) 32 | then "d(" ++ show2 0 val ++ ")" 33 | else "d" ++ show2 n val 34 | show2 n (Sin val) = "sin(" ++ show2 n val ++ ")" 35 | show2 n (Cos val) = "cos(" ++ show2 n val ++ ")" 36 | show2 n (Tan val) = "tan(" ++ show2 n val ++ ")" 37 | show2 n@0 (Sum vals) = 38 | concat $ List.intersperse " + " $ map (show2 n) $ reverse $ List.sortBy cmp vals 39 | where 40 | (Prod a) `cmp` (Prod b) = length a `compare` length b 41 | _ `cmp` (Prod _) = LT 42 | (Prod _) `cmp` _ = GT 43 | _ `cmp` _ = EQ 44 | show2 0 a = show2 1 a 45 | show2 n@1 (Prod vals) = 46 | pre ++ (concat $ List.intersperse "*" $ map (showWithPow.lengthifySecond) $ collectCopies nonconsts) 47 | where 48 | isConst (C a) = True 49 | isConst _ = False 50 | consts = map (\(C n) -> n) $ filter isConst vals 51 | nonconsts = filter (not.isConst) vals 52 | pre = if null consts || product consts == 1 53 | then "" 54 | else show $ product consts 55 | lengthifySecond (a,b) = (a, length b) 56 | showWithPow (a, 1) = show2 n a 57 | showWithPow (a, 2) = show2 n a ++ "²" 58 | showWithPow (a, 3) = show2 n a ++ "³" 59 | showWithPow (a, 4) = show2 n a ++ "⁴" 60 | showWithPow (a, 5) = show2 n a ++ "⁵" 61 | showWithPow (a, 6) = show2 n a ++ "⁶" 62 | showWithPow (a, 7) = show2 n a ++ "⁷" 63 | showWithPow (a, 8) = show2 n a ++ "⁸" 64 | showWithPow (a, 9) = show2 n a ++ "⁹" 65 | showWithPow (a, m) = show2 n a ++ "^" ++ show m 66 | show2 1 (C a) = show a 67 | show2 1 (V s) = s 68 | show2 1 a = "(" ++ show2 0 a ++ ")" 69 | 70 | 71 | 72 | instance (Num a, Eq a) => Eq (MExpr a) where 73 | a == b = a === b 74 | 75 | instance (Num a, Eq a, Show a) => Num (MExpr a) where 76 | fromInteger n = C $ fromIntegral n 77 | a + b = sumC' [a,b] 78 | a * b = prodC' [a,b] 79 | negate = ((-1)*) 80 | abs _ = error "absolute value not supported in MExpr" 81 | signum _ = error "no signum provided in MExpr" 82 | 83 | 84 | 85 | instance (Num a, Eq a) => Symbolic a (MExpr a) where 86 | constC = C 87 | constD (C n) = Just n 88 | constD _ = Nothing 89 | varC = V 90 | varD (V s) = Just s 91 | varD _ = Nothing 92 | 93 | instance (Num a) => SymbolicSum (MExpr a) where 94 | sumC = Sum 95 | sumD (Sum l) = Just l 96 | sumD _ = Nothing 97 | 98 | instance (Num a) => SymbolicProd (MExpr a) where 99 | prodC = Prod 100 | prodD (Prod l) = Just l 101 | prodD _ = Nothing 102 | 103 | instance SymbolicDiff (MExpr a) where 104 | diffC a = D a 105 | diffD (D a) = Just a 106 | diffD _ = Nothing 107 | -------------------------------------------------------------------------------- /Algebra/HaskSymb/Definitions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, RankNTypes, FunctionalDependencies, ViewPatterns, NoMonomorphismRestriction #-} 2 | 3 | module Algebra.HaskSymb.Definitions where 4 | 5 | import Prelude hiding (const) 6 | import Data.List as List 7 | 8 | -- This is the heart of things. 9 | 10 | -- For every mathematical property one may wish to implement, we make a 11 | -- constructor (names postpended with C) and a destructor 12 | -- that may produce it (names postpended with D; best used with ViewPatterns) 13 | 14 | -- b has both variables and constants of type a 15 | class Symbolic a b| b-> a where 16 | constC :: a -> b 17 | constD :: b -> Maybe a 18 | varC :: String -> b 19 | varD :: b -> Maybe String 20 | 21 | -- a can be added 22 | class SymbolicSum a where 23 | sumC :: [a] -> a 24 | sumD :: a -> Maybe [a] 25 | 26 | sumC' vals = 27 | let 28 | sumC'' [x] = x 29 | sumC'' xs = sumC xs 30 | isSum (sumD -> Just _) = True 31 | isSum _ = False 32 | sums = filter isSum vals 33 | nonsums = filter (not.isSum) vals 34 | isConst (constD -> Just _) = True 35 | isConst _ = False 36 | consts = map (\(constD -> Just a) -> a) $ filter isConst vals 37 | in if null sums 38 | then if null consts 39 | then sumC'' vals 40 | else sumC'' $ 41 | (if sum consts == 0 then [] else [constC (sum consts)]) ++ filter (not.isConst) vals 42 | else sumC' $ nonsums ++ concat (map (\(sumD -> Just a) -> a) sums) 43 | 44 | 45 | 46 | -- a can be multiplied 47 | class SymbolicProd a where 48 | prodC :: [a] -> a 49 | prodD :: a -> Maybe [a] 50 | 51 | prodC' vals = 52 | let 53 | prodC'' [x] = x 54 | prodC'' xs = prodC xs 55 | isProd (prodD -> Just _) = True 56 | isProd _ = False 57 | prods = filter isProd vals 58 | nonprods = filter (not.isProd) vals 59 | isConst (constD -> Just _) = True 60 | isConst _ = False 61 | consts = map (\(constD -> Just a) -> a) $ filter isConst vals 62 | nonconsts = filter (not.isConst) vals 63 | in if null prods 64 | then if null consts 65 | then prodC'' vals 66 | else case (nonconsts, product consts) of 67 | ([],n) -> constC n 68 | (_, 0) -> constC 0 69 | (l, 1) -> prodC l 70 | (l, n) -> prodC $ (constC n) : l 71 | else prodC' $ nonprods ++ concat (map (\(prodD -> Just a) -> a) prods) 72 | 73 | -- a can be differentiated 74 | class SymbolicDiff a where 75 | diffC :: a -> a 76 | diffD :: a -> Maybe a 77 | 78 | {-cleanLCons :: ([a] -> a) -> (a -> Maybe [a]) -> ([b] -> a) -> (a -> b) -> (b -> Maybe a) -> a -> a 79 | cleanLCons cons dest constCons constC constD (dest -> Just vals) = 80 | let 81 | --isCons :: a -> Bool 82 | isCons (dest -> Just _) = True 83 | isCons _ = False 84 | --isConst :: a -> Bool 85 | isConst (constD -> Just _) = True 86 | isConst _ = False 87 | --conses :: [a] 88 | conses = filter isCons vals 89 | --consts :: [b] 90 | consts = map (\(constD -> Just a) -> a) $ filter isConst vals 91 | in if null conses 92 | then cons $ [constC (constCons consts)] ++ filter (not.isConst) vals 93 | else cleanLCons cons dest constCons constC constD $ cons $ 94 | filter (not . isCons) vals ++ concat (map (\(dest -> Just a) -> a) conses) 95 | -} 96 | 97 | 98 | 99 | listEq (==) (a:as) b = 100 | let 101 | amatches = filter (==a) b 102 | nonamatches = filter (not .(==a)) b 103 | in 104 | if null amatches 105 | then False 106 | else listEq (==) as (tail amatches ++ nonamatches) 107 | listEq _ [] [] = True 108 | listEq _ _ _ = False 109 | 110 | (===) :: (SymbolicSum a, Symbolic b a, Eq b, SymbolicProd a, SymbolicDiff a) => a -> a -> Bool 111 | (constD -> Just a) === (constD -> Just b) = a == b 112 | (varD -> Just a) === (varD -> Just b) = a == b 113 | (sumD -> Just as) === (sumD -> Just bs) = listEq (===) as bs 114 | (sumD -> Just [a]) === ( b ) = a === b 115 | ( a ) === (sumD -> Just [b]) = a === b 116 | (prodD -> Just as) === (prodD -> Just bs) = listEq (===) as bs 117 | (prodD-> Just [a]) === ( b ) = a === b 118 | ( a ) === (prodD-> Just [b]) = a === b 119 | (diffD -> Just a ) === (diffD -> Just b ) = a === b 120 | a === b = False 121 | 122 | --instance Eq 123 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | HaskSymb: An Experiment in Haskell Symbolic Algebra 2 | =================================================== 3 | 4 | HaskSymb is a quickly hacked together proof of concept that I may expand at some point. That said, it has some cool features. 5 | 6 | The biggest one is that it provides mathematical pattern matching via quasiquoters. So one can write code like this: 7 | 8 | ```haskell 9 | expand [m| a+b |] = expand a + expand b 10 | expand [m|a*(b+c)|] = expand (a*b) + expand (a*c) 11 | expand a = a 12 | ``` 13 | 14 | The patterns match up to trivial mathematical equivalency. For example, because multiplication is commutative, `[m|a*(b+c)|]` matches `(x+1)*y` in addition to `2*(x+1)`. On the other hand, it doesn't attempt to do deeper analysis, like expanding expressions. It does support using the same variable multiple times (eg. `[m|a+a|]` which will match `x+x` but not `x+1`) and constants (eg. `[m|2*a|]`). 15 | 16 | (In fact, at the time of writing that is actual code in **BasicAlg.hs**.) 17 | 18 | Example Use 19 | ------------ 20 | 21 | A short ghci session with HaskSymb, using the `MExpr` symbolic type 22 | 23 | ```haskell 24 | Prelude> import Algebra.HaskSymb 25 | Prelude Algebra.HaskSymb> -- Let's make some variables! 26 | Prelude Algebra.HaskSymb> let (a,b) = (V "a", V "b") 27 | 28 | Prelude Algebra.HaskSymb> -- Basic Expression manipulation 29 | Prelude Algebra.HaskSymb> (a+1)^3 30 | (a + 1)³ 31 | Prelude Algebra.HaskSymb> expand $ (a+1)^3 32 | a³ + a² + a² + a² + a + a + a + 1 33 | Prelude Algebra.HaskSymb> collectTerms $ expand $ (a+1)^3 34 | a³ + 3a² + 3a + 1 35 | Prelude Algebra.HaskSymb> collectTerms $ expand $ (a+b)^4 36 | 6a²*b² + 4a³*b + 4a*b³ + b⁴ + a⁴ 37 | 38 | Prelude Algebra.HaskSymb> -- Derivatives! 39 | Prelude Algebra.HaskSymb> diff a $ a^4 + 3*a^2 + 5 40 | 4a³ + 6a 41 | 42 | ``` 43 | 44 | How does it work? 45 | ------------------ 46 | 47 | The basic idea is the *constructor-destructor* class pattern. For example, the class `SymbolicSum` is defined: 48 | 49 | ```haskell 50 | class SymbolicSum a where 51 | sumC :: [a] -> a 52 | sumD :: a -> Maybe [a] 53 | ``` 54 | 55 | `sumC` constructs a value of type `a` representing a sum of `a`s. `sumD` attempts to destruct a value of type `a` into a list that could be summed into them. 56 | 57 | Then, using View Patterns, we can write stuff like: 58 | 59 | ```haskell 60 | foo (sumD -> Just vals) = "input is a sum of" ++ show vals 61 | foo _ = "input is not a sum" 62 | ``` 63 | 64 | Our quasiquoter, `m`, will build smarter destructors based off of these. Then if someone implements `SymbolicSum`, etc, they can use our patterns! 65 | 66 | (The actual pattern matching has been abstracted to colah/pattern-power which you need installed to run this.) 67 | 68 | Fun Hacking!! 69 | -------------- 70 | 71 | As mentioned earlier, HaskSymb is a quickly hacked together proof of concept. It is not a serious project, isn't useful for anything, and has fairly ugly code. At some point, it may become something else, but that isn't right now. 72 | 73 | So, I can't in good conscience recommend hacking on most of the code base. It was my first time writing Template Haskell and that shines through with the sort of code that will making you want to bang your head against the wall repeatedly. 74 | 75 | That said, **BasicAlgs.hs** is really cool and may be worth hacking on. It's just simple procedures to apply to symbolic expressions, made really pleasant by the `m` quasiquoter. Check it out! Right now, there's just `expand` and `collectTerms` -- I don't really know what the building blocks of procedural algebra should be... 76 | 77 | I'd be thrilled to accept pull requests here. 78 | 79 | Where I'm Kind Of Stuck 80 | ------------------------ 81 | 82 | So this is a quickly hacked together proof of concept. The code is kind of ugly. Substantially, this is because I haven't figured out how to do things well. 83 | 84 | The *big* issue I'm facing is appropriate types for symbolic expressions. In particular, how do I handle variables in types? 85 | 86 | My ideal solution would involved dependent types, eg. `SymbolicExpr (Set [Var "x", Var "y"])`. This would allows all sorts of nice things like `set :: SymbolicExpr vars -> Var name -> Float -> SymbolicExpr (delete (Var name) vars)`, `(+) :: SymbolicExpr vars1 -> SymbolicExpr vars2 -> SymbolicExpr (union vars1 vars2)` and `eval :: SymbolicExpr (Set []) -> Float`. We could even give the variables types, eg. `SymbolicExpr (Set [Var "x" Float, Var "y" (Vector 3 Float)])`! 87 | 88 | Sadly, I live in the real world and not fantasy land. (It may be possible to implement this with data promotion? I haven't done much with it yet. But I'm skeptical of it typechecking nicely...) 89 | 90 | One thing I've considered is using GADTs as in [Dan Burton's really cool approach to implementing System F](https://github.com/DanBurton/Blog/blob/master/Literate%20Haskell/SystemF.lhs). But variables really shouldn't be ordered in this context; I really don't want to have something like `SymbolicExpr (Int -> Int -> Int)` for a symbolic expression with 2 integer variables, because there's no real reason for `x` or `y` to be the variable in first or second position. And for relationships between expressions, it would be the programmers job to relate positions, which is silly (locally, a monad could generate variables, but globally this would get ugly). It really needs to be a type-level thing. 91 | 92 | My bad solution for now has been to just not have type-level variable representation, which kind of bothers me. And generally, when one part of a program is ugly, I find it difficult to motivate myself to make other parts pretty. :( 93 | 94 | I'm planning to come back to this at some point, but I want to sit on it for a little while and think. Your feedback would be greatly appreciated; you can reach me at chris@colah.ca. 95 | 96 | 97 | --------------------------------------------------------------------------------