Tropical algebra overloading: Difference between revisions
Content added Content deleted
(Tropical algebra overloading en FreeBASIC) |
(Haskell version.) |
||
Line 388: | Line 388: | ||
5 ⊗ 8 ⊕ 5 ⊗ 7 = 13 |
5 ⊗ 8 ⊕ 5 ⊗ 7 = 13 |
||
5 ⊗ (8 ⊕ 7) == 5 ⊗ 8 ⊕ 5 ⊗ 7 is true |
5 ⊗ (8 ⊕ 7) == 5 ⊗ 8 ⊕ 5 ⊗ 7 is true |
||
</pre> |
|||
=={{header|Haskell}}== |
|||
Looks like the Haskell pretty printer thinks the single quote in 'Maxima begins a character constant. |
|||
<lang haskell>{-# LANGUAGE DataKinds, DerivingVia, FlexibleInstances, StandaloneDeriving #-} |
|||
import Prelude hiding ((^)) |
|||
import Data.Monoid (Sum(Sum)) |
|||
import Data.Number.CReal (CReal) |
|||
import Data.Semiring (Semiring, (^), plus, times) |
|||
import Data.Semiring.Tropical (Tropical(..), Extrema(Maxima)) |
|||
-- Create our max-plus semiring over the constructive reals (CReal), using the |
|||
-- Tropical type from the semirings package. (We'll put all the boilerplate |
|||
-- code after the main function.) |
|||
-- |
|||
-- 'Maxima indicates that our semiring is a max-plus semiring, where the plus |
|||
-- function is maximum, the times function is addition, and the Infinity |
|||
-- constructor is treated as -∞. |
|||
newtype MaxPlus = MaxPlus (Tropical 'Maxima CReal) |
|||
-- Symbolic aliases to satisfy the problem requirements. |
|||
(⊕), (⊗) :: MaxPlus -> MaxPlus -> MaxPlus |
|||
(⊕) = plus |
|||
(⊗) = times |
|||
infixl 6 ⊕ |
|||
infixl 7 ⊗ |
|||
(↑) :: Integral a => MaxPlus -> a -> MaxPlus |
|||
(↑) = (^) |
|||
infixr 8 ↑ |
|||
main :: IO () |
|||
main = do |
|||
-- Description Equation Expected Value |
|||
test "2 ⊗ (-2) == 0" (2 ⊗ (-2)) 0 |
|||
test "-0.001 ⊕ -Inf == -0.001" (-0.001 ⊕ MaxPlus Infinity) (-0.001) |
|||
test "0 ⊗ -Inf == -Inf" (0 ⊗ MaxPlus Infinity) (MaxPlus Infinity) |
|||
test "1.5 ⊕ -1 == 1.5" (1.5 ⊕ (-1)) 1.5 |
|||
test "-0.5 ⊗ 0 == -0.5" ((-0.5) ⊗ 0) (-0.5) |
|||
test "5 ↑ 7 == 35" (5 ↑ 7) 35 |
|||
test "5 ⊗ (8 ⊕ 7) == 13" (5 ⊗ (8 ⊕ 7)) 13 |
|||
test "5 ⊗ 8 ⊕ 5 ⊗ 7 == 13" (5 ⊗ 8 ⊕ 5 ⊗ 7) 13 |
|||
-------------------------------------------------------------------------------- |
|||
-- Boilerplate, utility functions, etc. |
|||
-- Bootstrap our way to having MaxPlus be a Semiring instance. Also, derive |
|||
-- Eq and Ord instances. |
|||
deriving via (Sum CReal) instance Semigroup CReal |
|||
deriving via (Sum CReal) instance Monoid CReal |
|||
deriving via Tropical 'Maxima CReal instance Semiring MaxPlus |
|||
deriving via Tropical 'Maxima CReal instance Eq MaxPlus |
|||
deriving via Tropical 'Maxima CReal instance Ord MaxPlus |
|||
-- Create a Num instance for MaxPlus mostly so that we can use fromInteger and |
|||
-- negate. This lets us treat the numeric literal -2, for example, as a value |
|||
-- in our semiring. |
|||
instance Num MaxPlus where |
|||
(+) = plus |
|||
(*) = times |
|||
abs = opError "absolute value" |
|||
signum (MaxPlus Infinity) = -1 |
|||
signum x = wrap . signum . unwrap $ x |
|||
fromInteger = wrap . fromInteger |
|||
negate (MaxPlus Infinity) = opError "negation of -Inf" |
|||
negate x = wrap . negate . unwrap $ x |
|||
-- Similar to Num, this will let us treat numeric literals, like 0.001, as |
|||
-- MaxPlus values. |
|||
instance Fractional MaxPlus where |
|||
fromRational = wrap . fromRational |
|||
recip _ = opError "reciprocal" |
|||
instance Show MaxPlus where |
|||
show (MaxPlus Infinity) = "-Inf" |
|||
show x = show . unwrap $ x |
|||
-- Test two expressions for equality. |
|||
test :: String -> MaxPlus -> MaxPlus -> IO () |
|||
test s actual expected = do |
|||
putStr $ "Expecting " ++ s ++ ". Got " ++ show actual ++ " " |
|||
putStrLn $ if actual == expected then "✔" else "✘" |
|||
-- Utility functions. |
|||
wrap :: CReal -> MaxPlus |
|||
wrap = MaxPlus . Tropical |
|||
unwrap :: MaxPlus -> CReal |
|||
unwrap (MaxPlus (Tropical x)) = x |
|||
unwrap (MaxPlus Infinity) = error "can't convert -Inf to a CReal" |
|||
opError :: String -> a |
|||
opError op = error $ op ++ " is not defined on a max-plus semiring"</lang> |
|||
{{out}} |
|||
<pre> |
|||
Expecting 2 ⊗ (-2) == 0. Got 0.0 ✔ |
|||
Expecting -0.001 ⊕ -Inf == -0.001. Got -0.001 ✔ |
|||
Expecting 0 ⊗ -Inf == -Inf. Got -Inf ✔ |
|||
Expecting 1.5 ⊕ -1 == 1.5. Got 1.5 ✔ |
|||
Expecting -0.5 ⊗ 0 == -0.5. Got -0.5 ✔ |
|||
Expecting 5 ↑ 7 == 35. Got 35.0 ✔ |
|||
Expecting 5 ⊗ (8 ⊕ 7) == 13. Got 13.0 ✔ |
|||
Expecting 5 ⊗ 8 ⊕ 5 ⊗ 7 == 13. Got 13.0 ✔ |
|||
</pre> |
</pre> |
||