cleveland-0.1.1: lorentz-test/Test/Lorentz/CustomArith.hs
-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA
-- Note: This extension is enabled because it allows better representation of tests
-- with @BinBase@. These tests require special representation behavior because 'show' works
-- incorrect with non-decimal base.
{-# LANGUAGE HexFloatLiterals #-}
-- | Tests for custom arithmetic datatypes, added to Lorentz
module Test.Lorentz.CustomArith
( test_fixedArith
, test_NFixedArith
) where
import Prelude hiding (div)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))
import Lorentz
test_fixedArith :: TestTree
test_fixedArith =
testGroup "Arithmetic operations on Fixed values"
[ testGroup "Arithmetics"
[ testGroup "Decimal base"
[ testCase "Fixed add" do
add -$ initialStorageDec
@?= (2.2 :: Fixed (DecBase 3))
, testCase "Fixed sub" do
sub -$ initialStorageDec
@?= (0 :: Fixed (DecBase 3))
, testCase "Fixed mul" do
mul -$ initialStorageDec
@?= (1.21 :: Fixed (DecBase 6))
, testCase "Fixed ediv 1" do
ediv -$ (123.456 :: Fixed (DecBase 3), 100 :: Integer)
@?= Just (1, 23.456 :: (NFixed (DecBase 3)))
, testCase "Fixed ediv 2" do
ediv -$ (2 :: Fixed (DecBase 3), 100 :: Integer)
@?= Just (0, 2 :: (NFixed (DecBase 3)))
]
, testGroup "Binary base"
[ testCase "Fixed add" do
add -$ initialStorageBin
@?= (2.2 :: Fixed (BinBase 1))
, testCase "Fixed sub" do
sub -$ initialStorageBin
@?= (0 :: Fixed (BinBase 1))
, testCase "Fixed mul" do
mul -$ initialStorageBin
@?= (1.21 :: Fixed (BinBase 2))
]
]
, testGroup "Rounding"
[ testGroup "Rounding with decimal base"
[ testCase "Round up Fixed with decimal base 1" do
round_ -$ (1.23456 :: (Fixed (DecBase 6)))
@?= (1.235 :: Fixed (DecBase 3))
, testCase "Round up Fixed with decimal base 2" do
round_ -$ (1.23446 :: (Fixed (DecBase 6)))
@?= (1.234 :: Fixed (DecBase 3))
, testCase "Round up Fixed with decimal base 3" do
round_ -$ (0.177 :: (Fixed (DecBase 3)))
@?= (0.18 :: Fixed (DecBase 2))
, testCase "Round up Fixed with decimal base 4" do
round_ -$ (0.173 :: (Fixed (DecBase 3)))
@?= (0.17 :: Fixed (DecBase 2))
, testCase "Round up Fixed with decimal base 5" do
round_ -$ (1.230 :: (Fixed (DecBase 3)))
@?= (1.23 :: Fixed (DecBase 2))
, testCase "Ceil 1" do
ceil_ -$ (0.177 :: (Fixed (DecBase 3)))
@?= (0.18 :: Fixed (DecBase 2))
, testCase "Ceil 2" do
ceil_ -$ (0.173 :: (Fixed (DecBase 3)))
@?= (0.18 :: Fixed (DecBase 2))
, testCase "Ceil 3" do
ceil_ -$ (1.230 :: (Fixed (DecBase 3)))
@?= (1.23 :: Fixed (DecBase 2))
, testCase "Floor 1" do
floor_ -$ (0.177 :: (Fixed (DecBase 3)))
@?= (0.17 :: Fixed (DecBase 2))
, testCase "Floor 2" do
floor_ -$ (0.173 :: (Fixed (DecBase 3)))
@?= (0.17 :: Fixed (DecBase 2))
, testCase "Floor 3" do
floor_ -$ (1.230 :: (Fixed (DecBase 3)))
@?= (1.23 :: Fixed (DecBase 2))
, testCase "Round down" do
round_ -$ (1.234 :: Fixed (DecBase 3))
@?= (1.23400 :: (Fixed (DecBase 6)))
]
, testGroup "Rounding with Binary Base"
[ testCase "Round up Fixed with binary base 1" do
round_ -$ (0x1.23456 :: (Fixed (BinBase 6)))
@?= (0x1.235 :: Fixed (BinBase 3))
, testCase "Round up Fixed with binary base 2" do
round_ -$ (0x1.23446 :: (Fixed (BinBase 6)))
@?= (0x1.234 :: Fixed (BinBase 3))
, testCase "Round up Fixed with binary base 3" do
round_ -$ (0x0.177 :: (Fixed (BinBase 3)))
@?= (0x0.18 :: Fixed (BinBase 2))
, testCase "Round up Fixed with binary base 4" do
round_ -$ (0x0.173 :: (Fixed (BinBase 3)))
@?= (0x0.17 :: Fixed (BinBase 2))
, testCase "Round up Fixed with binary base 5" do
round_ -$ (0x1.230 :: (Fixed (BinBase 3)))
@?= (0x1.23 :: Fixed (BinBase 2))
, testCase "Ceil 1" do
ceil_ -$ (0x0.177 :: (Fixed (BinBase 3)))
@?= (0x0.18 :: Fixed (BinBase 2))
, testCase "Ceil 2" do
ceil_ -$ (0x0.173 :: (Fixed (BinBase 3)))
@?= (0x0.18 :: Fixed (BinBase 2))
, testCase "Ceil 3" do
ceil_ -$ (0x1.230 :: (Fixed (BinBase 12)))
@?= (0x1.23 :: Fixed (BinBase 8
))
, testCase "Floor 1" do
floor_ -$ (0x0.177 :: (Fixed (BinBase 3)))
@?= (0x0.17 :: Fixed (BinBase 2))
, testCase "Floor 2" do
floor_ -$ (0x0.173 :: (Fixed (BinBase 3)))
@?= (0x0.17 :: Fixed (BinBase 2))
, testCase "Floor 3" do
floor_ -$ (0x1.230 :: (Fixed (BinBase 3)))
@?= (0x1.23 :: Fixed (BinBase 2))
]
, testGroup "Casts"
[ testCase "Cast to Integer" do
fromFixed @(Fixed (DecBase 6)) -$ (1.23456 :: (Fixed (DecBase 6)))
@?= 1
, testCase "Cast Integer to Fixed" do
toFixed @(Fixed (DecBase 6)) -$ (123456 :: Integer)
@?= (123456 :: (Fixed (DecBase 6)))
, testCase "Cast to Integer (Binary base)" do
fromFixed @(Fixed (BinBase 6)) -$ (1.23456 :: (Fixed (BinBase 6)))
@?= 1
, testCase "Cast Integer to Fixed (Binary base)" do
toFixed @(Fixed (BinBase 6)) -$ (123456 :: Integer)
@?= (123456.00 :: (Fixed (BinBase 6)))
]
]
, testGroup "Division"
[ testCase "Divide big Fixed(Dec) to small Fixed(Dec)" do
div @(Maybe (Fixed (DecBase 8))) -$ (625.123 :: Fixed (DecBase 3), 123.23 :: Fixed (DecBase 2))
@?= Just (5.07281506 :: Fixed (DecBase 8))
, testCase "Divide small Fixed(Dec) to big Fixed(Dec)" do
div @(Maybe (Fixed (DecBase 8))) -$ (123.23 :: Fixed (DecBase 3), 625.123 :: Fixed (DecBase 2))
@?= Just (0.19713015 :: Fixed (DecBase 8))
, testCase "Divide big Fixed(Bin) to small Fixed(Bin)" do
div @(Maybe (Fixed (BinBase 8))) -$ (625.123 :: Fixed (BinBase 3), 123.23 :: Fixed (BinBase 2))
@?= (Just (5.079 :: Fixed (BinBase 8)))
, testCase "Divide small Fixed(Bin) to big Fixed(Bin)" do
div @(Maybe (Fixed (BinBase 8))) -$ (123.23 :: Fixed (BinBase 3), 625.123 :: Fixed (BinBase 2))
@?= (Just (0.19713015 :: Fixed (BinBase 8)))
, testCase "Divide by zero" do
div @(Maybe (Fixed (BinBase 8))) -$ (123.23 :: Fixed (BinBase 3), 0 :: Fixed (BinBase 2))
@?= (Nothing)
]
]
where
initialStorageDec =
(1.1 :: Fixed (DecBase 3), 1.1 :: Fixed (DecBase 3))
initialStorageBin =
(1.1 :: Fixed (BinBase 1), 1.1 :: Fixed (BinBase 1))
test_NFixedArith :: TestTree
test_NFixedArith =
testGroup "Arithmetic operations on NFixed values"
[ testGroup "NFixed to Fixed"
[ testCase "Cast NFixed to Fixed 1" do
castNFixedToFixed -$ (1.23456 :: NFixed (DecBase 6))
@?= (1.23456 :: Fixed (DecBase 6))
, testCase "Cast NFixed to Fixed 2" do
castNFixedToFixed -$ (0 :: NFixed (DecBase 6))
@?= (0 :: Fixed (DecBase 6))
, testCase "Cast NFixed to Fixed 3" do
castNFixedToFixed -$ (0.12 :: NFixed (DecBase 2))
@?= (0.12 :: Fixed (DecBase 2))
]
, testGroup "Fixed to NFixed"
[ testCase "Cast Fixed to NFixed 1" do
castFixedToNFixed -$ (1.23456 :: Fixed (DecBase 6))
@?= Just (1.23456 :: NFixed (DecBase 6))
, testCase "Cast Fixed to NFixed 2" do
castFixedToNFixed -$ (0 :: Fixed (DecBase 6))
@?= Just (0 :: NFixed (DecBase 6))
, testCase "Cast Fixed to NFixed 3" do
castFixedToNFixed -$ (0.12 :: Fixed (DecBase 2))
@?= Just (0.12 :: NFixed (DecBase 2))
]
, testGroup "Decimal base"
[ testCase "NFixed add" do
add -$ initialStorageDec
@?= (2.2 :: NFixed (DecBase 3))
, testCase "NFixed sub" do
sub -$ initialStorageDec
@?= (0 :: Fixed (DecBase 3))
, testCase "NFixed mul" do
mul -$ initialStorageDec
@?= (1.21 :: NFixed (DecBase 6))
, testCase "NFixed ediv 1" do
ediv -$ (123.456 :: NFixed (DecBase 3), 100 :: Integer)
@?= Just (1, 23.456 :: (NFixed (DecBase 3)))
, testCase "NFixed ediv 2" do
ediv -$ (2 :: NFixed (DecBase 3), 100 :: Integer)
@?= Just (0, 2 :: (NFixed (DecBase 3)))
]
, testGroup "Binary base"
[ testCase "NFixed add" do
add -$ initialStorageBin
@?= (2.2 :: NFixed (BinBase 1))
, testCase "NFixed sub" do
sub -$ initialStorageBin
@?= (0 :: Fixed (BinBase 1))
, testCase "NFixed mul" do
mul -$ initialStorageBin
@?= (1.21 :: NFixed (BinBase 2))
]
, testGroup "Rounding"
[ testGroup "Rounding with decimal base"
[ testCase "Round up NFixed with decimal base 1" do
round_ -$ (1.23456 :: (NFixed (DecBase 6)))
@?= (1.235 :: NFixed (DecBase 3))
, testCase "Round up NFixed with decimal base 2" do
round_ -$ (1.23446 :: (NFixed (DecBase 6)))
@?= (1.234 :: NFixed (DecBase 3))
, testCase "Round up NFixed with decimal base 3" do
round_ -$ (0.177 :: (NFixed (DecBase 3)))
@?= (0.18 :: NFixed (DecBase 2))
, testCase "Round up NFixed with decimal base 4" do
round_ -$ (0.173 :: (NFixed (DecBase 3)))
@?= (0.17 :: NFixed (DecBase 2))
, testCase "Round up NFixed with decimal base 5" do
round_ -$ (1.230 :: (NFixed (DecBase 3)))
@?= (1.23 :: NFixed (DecBase 2))
, testCase "Ceil 1" do
ceil_ -$ (0.177 :: (NFixed (DecBase 3)))
@?= (0.18 :: NFixed (DecBase 2))
, testCase "Ceil 2" do
ceil_ -$ (0.173 :: (NFixed (DecBase 3)))
@?= (0.18 :: NFixed (DecBase 2))
, testCase "Ceil 3" do
ceil_ -$ (1.230 :: (NFixed (DecBase 3)))
@?= (1.23 :: NFixed (DecBase 2))
, testCase "Floor 1" do
floor_ -$ (0.177 :: (NFixed (DecBase 3)))
@?= (0.17 :: NFixed (DecBase 2))
, testCase "Floor 2" do
floor_ -$ (0.173 :: (NFixed (DecBase 3)))
@?= (0.17 :: NFixed (DecBase 2))
, testCase "Floor 3" do
floor_ -$ (1.230 :: (NFixed (DecBase 3)))
@?= (1.23 :: NFixed (DecBase 2))
, testCase "Round down" do
round_ -$ (1.234 :: NFixed (DecBase 3))
@?= (1.23400 :: (NFixed (DecBase 6)))
]
, testGroup "Rounding with Binary Base"
[ testCase "Round NFixed with binary base" do
round_ -$ (0x1.23456 :: (NFixed (BinBase 6)))
@?= (0x1.235 :: NFixed (BinBase 3))
, testCase "Ceil 1" do
ceil_ -$ (0x0.177 :: (NFixed (BinBase 3)))
@?= (0x0.18 :: NFixed (BinBase 2))
, testCase "Ceil 2" do
ceil_ -$ (0x0.173 :: (NFixed (BinBase 3)))
@?= (0x0.18 :: NFixed (BinBase 2))
, testCase "Ceil 3" do
ceil_ -$ (0x1.230 :: (NFixed (BinBase 12)))
@?= (0x1.23 :: NFixed (BinBase 8))
, testCase "Floor 1" do
floor_ -$ (0x0.177 :: (NFixed (BinBase 3)))
@?= (0x0.17 :: NFixed (BinBase 2))
, testCase "Floor 2" do
floor_ -$ (0x0.173 :: (NFixed (BinBase 3)))
@?= (0x0.17 :: NFixed (BinBase 2))
, testCase "Floor 3" do
floor_ -$ (0x1.230 :: (NFixed (BinBase 3)))
@?= (0x1.23 :: NFixed (BinBase 2))
]
, testGroup "Casts"
[ testCase "Cast to Integer" do
fromFixed @(NFixed (DecBase 6)) -$ (1.23456 :: (NFixed (DecBase 6)))
@?= 1
, testCase "Cast Integer to NFixed" do
toFixed @(NFixed (DecBase 6)) -$ (123456 :: Integer)
@?= (123456 :: (NFixed (DecBase 6)))
, testCase "Cast to Integer (Binary base)" do
fromFixed @(NFixed (BinBase 6)) -$ (1.23456 :: (NFixed (BinBase 6)))
@?= 1
, testCase "Cast Integer to NFixed (Binary base)" do
toFixed @(NFixed (BinBase 6)) -$ (123456 :: Integer)
@?= (123456 :: (NFixed (BinBase 6)))
]
]
, testGroup "Division"
[ testCase "Divide big NFixed(Dec) to small NFixed(Dec)" do
div @(Maybe (NFixed (DecBase 8))) -$ (625.123 :: NFixed (DecBase 3), 123.23 :: NFixed (DecBase 2))
@?= Just (5.07281506 :: NFixed (DecBase 8))
, testCase "Divide small NFixed(Dec) to big NFixed(Dec)" do
div @(Maybe (NFixed (DecBase 8))) -$ (123.23 :: NFixed (DecBase 3), 625.123 :: NFixed (DecBase 2))
@?= Just (0.19713015 :: NFixed (DecBase 8))
, testCase "Divide big NFixed(Bin) to small NFixed(Bin)" do
div @(Maybe (NFixed (BinBase 8))) -$ (625.123 :: NFixed (BinBase 3), 123.23 :: NFixed (BinBase 2))
@?= (Just (5.079 :: NFixed (BinBase 8)))
, testCase "Divide small NFixed(Bin) to big NFixed(Bin)" do
div @(Maybe (NFixed (BinBase 8))) -$ (123.23 :: NFixed (BinBase 3), 625.123 :: NFixed (BinBase 2))
@?= (Just (0.19713015 :: NFixed (BinBase 8)))
, testCase "Divide by zero" do
div @(Maybe (NFixed (BinBase 8))) -$ (123.23 :: NFixed (BinBase 3), 0 :: NFixed (BinBase 2))
@?= (Nothing)
]
]
where
initialStorageDec =
(1.1 :: NFixed (DecBase 3), 1.1 :: NFixed (DecBase 3))
initialStorageBin =
(1.1 :: NFixed (BinBase 1), 1.1 :: NFixed (BinBase 1))