-- | -- Module : Main -- Copyright : (c) Justus SagemΓΌller 2017 -- License : GPL v3 -- -- Maintainer : (@) sagemueller $ geo.uni-koeln.de -- Stability : experimental -- Portability : portable -- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE CPP #-} module Main where import CAS.Dumb import Test.Tasty import Test.Tasty.HUnit main = defaultMain tests type Expr = Expression String tests :: TestTree tests = testGroup "Tests" [ testGroup "Explicit transformations" [ testCase "π‘Ž + 𝑏 * 𝑐 &~: γ„–+γ„ˆ :=: γ„ˆ+γ„–" $ (π‘Ž + 𝑏 * 𝑐 &~: γ„–+γ„ˆ :=: γ„ˆ+γ„–) @?= (𝑏 * 𝑐 + π‘Ž :: Expr) , testCase "(π‘Ž+𝑏) * 𝑐 &~: γ„–+γ„ˆ :=: γ„ˆ+γ„–" $ ((π‘Ž+𝑏) * 𝑐 &~: γ„–+γ„ˆ :=: γ„ˆ+γ„–) @?= ((𝑏+π‘Ž) * 𝑐 :: Expr) , testCase "π‘Ž*𝑏 - 𝑐*𝑑 &~: γ„–*γ„ˆ :=: γ„ˆ*γ„–" $ (π‘Ž*𝑏 - 𝑐*𝑑 &~: γ„–*γ„ˆ :=: γ„ˆ*γ„–) @?= (𝑏*π‘Ž - 𝑑*𝑐 :: Expr) , testCase "π‘Ž*𝑏 - 𝑐*𝑑 &~? γ„–*γ„ˆ :=: γ„ˆ*γ„–" $ (π‘Ž*𝑏 - 𝑐*𝑑 &~? γ„–*γ„ˆ :=: γ„ˆ*γ„–) @?= [𝑏*π‘Ž - 𝑐*𝑑, π‘Ž*𝑏 - 𝑑*𝑐 :: Expr] , testCase "π‘Ž + 𝑏 + 𝑐 + 𝑑 &~: γ„œ+γ„‘ :=: γ„‘+γ„œ" $ (π‘Ž + 𝑏 + 𝑐 + 𝑑 &~: γ„œ+γ„‘ :=: γ„‘+γ„œ) @?= (𝑏 + π‘Ž + 𝑑 + 𝑐 :: Expr) , testCase "π‘Ž + 𝑏 + 𝑐 + 𝑑 &~: 𝑏+𝑐 :=: 𝑐+𝑏" $ (π‘Ž + 𝑏 + 𝑐 + 𝑑 &~: 𝑏+𝑐 :=: 𝑐+𝑏) @?= (π‘Ž + 𝑐 + 𝑏 + 𝑑 :: Expr) , testCase "π‘Ž + 𝑏 + 𝑐 + 𝑑 &~? γ„œ+γ„‘ :=: γ„‘+γ„œ" $ (π‘Ž + 𝑏 + 𝑐 + 𝑑 &~? γ„œ+γ„‘ :=: γ„‘+γ„œ) @?= [ 𝑏 + π‘Ž + 𝑐 + 𝑑 , π‘Ž + 𝑐 + 𝑏 + 𝑑 , π‘Ž + 𝑏 + 𝑑 + 𝑐 :: Expr] , testCase "π‘Ž + 𝑐 + 𝑏 &~? π‘Ž+𝑐 :=: ΞΎ" $ (π‘Ž + 𝑐 + 𝑏 &~? π‘Ž+𝑐 :=: ΞΎ ) @?= [ ΞΎ + 𝑏 :: Expr] , testCase "π‘Ž + 𝑏 + 𝑐 &~? 𝑏+𝑐 :=: 𝑐+𝑏 &~? π‘Ž+𝑐 :=: ΞΎ" $ ((π‘Ž + 𝑏 + 𝑐 &~? 𝑏+𝑐:=:𝑐+𝑏) >>= (&~? π‘Ž+𝑐:=:ΞΎ) ) @?= [ ΞΎ+𝑏 :: Expr] , testCase "π‘Ž*π‘₯ + 𝑏*π‘₯ + 𝑐 &~: ㄏ*γ„˜+ㄐ*γ„˜ :=: (ㄏ+ㄐ)*γ„˜" $ (π‘Ž*π‘₯ + 𝑏*π‘₯ + 𝑐 &~: ㄏ*γ„˜+ㄐ*γ„˜ :=: (ㄏ+ㄐ)*γ„˜) @?= ((π‘Ž+𝑏)*π‘₯ + 𝑐 :: Expr) , testCase "(π‘Ž+𝑏)*π‘₯ + 𝑐 &~: (ㄏ+ㄐ)*γ„˜ :=: ㄏ*γ„˜+ㄐ*γ„˜" $ ((π‘Ž+𝑏)*π‘₯ + 𝑐 &~: (ㄏ+ㄐ)*γ„˜ :=: ㄏ*γ„˜+ㄐ*γ„˜) @?= (π‘Ž*π‘₯ + 𝑏*π‘₯ + 𝑐 :: Expr) , testCase "Rename local symbols" $ (map succ%$> π‘Ž+𝑝) * π‘₯ @?= ((𝑏+π‘ž) * π‘₯ :: Expr) ] , testGroup "Show instance" [ testCase "π‘Ž+𝑏+𝑐" $ show (π‘Ž+𝑏+𝑐 :: Expr) @?= "π‘Ž+𝑏+𝑐" , testCase "π‘Ž+(𝑏+𝑐)" $ show (π‘Ž+(𝑏+𝑐) :: Expr) @?= "π‘Ž+(𝑏+𝑐)" , testCase "π‘Ž+𝑏*𝑐" $ show (π‘Ž+𝑏*𝑐 :: Expr) @?= "π‘Ž+𝑏*𝑐" , testCase "(π‘Ž+𝑏)*𝑐" $ show ((π‘Ž+𝑏)*𝑐 :: Expr) @?= "(π‘Ž+𝑏)*𝑐" , testCase "abs (π‘Ž+𝑏)" $ show (abs (π‘Ž+𝑏) :: Expr) @?= "abs (π‘Ž+𝑏)" , testCase "abs 3" $ show (abs 3 :: Expr) @?= "abs 3" , testCase "π‘Ž + -3" $ show (π‘Ž+(-3) :: Expr) @?= "π‘Ž+( -3)" , testCase "π‘Ž / signum Ο€" $ show (π‘Ž/signum Ο€ :: Expr) @?= "π‘Ž/signum Ο€" , testCase "logBase 2 32 ** atan pi" $ show (logBase 2 32 ** atan pi :: Expr) @?= "2`logBase`32**atan pi" , testCase "37.84" $ show (37.84 :: Expr) @?= "37.84" , testCase "5e-23" $ show (5e-23 :: Expr) @?= "5e-23" , testCase "-5.3e7" $ show (-5.3e8 :: Expr) @?= " -5.3e8" ] ]