diff --git a/example/Util/BMA.purs b/example/Util/BMA.purs index 97685e5ce..4a5416e79 100644 --- a/example/Util/BMA.purs +++ b/example/Util/BMA.purs @@ -2,12 +2,13 @@ module Example.Util.BMA where import Prelude -import Data.Array (cons, head, mapMaybe, range, tail, uncons, (!!)) +import Data.Array (cons, head, mapMaybe, range, tail, uncons, zip, zipWith, (!!)) import Data.FastVect.FastVect (Vect) -import Data.Foldable (foldl) +import Data.Foldable (class Foldable, foldl) import Data.Int (toNumber) import Data.Maybe (Maybe(..)) import Data.Number (pow) +import Data.Int (pow) as I import Data.Ord (abs) import Effect (Effect) import Effect.Class.Console (log) @@ -17,8 +18,11 @@ import Util (type (×), (×)) product :: forall a len. Semiring a => Vect len a -> a product v = foldl (*) one v -sum :: forall a len. Semiring a => Vect len a -> a -sum v = foldl (+) zero v +vsum :: forall a len. Semiring a => Vect len a -> a +vsum v = foldl (+) zero v + +sum :: forall f a. Foldable f => Semiring a => f a -> a +sum xs = foldl (+) zero xs vlen :: forall a len. Vect len a -> Int vlen xs = foldl (\count _x -> (+) 1 count) 0 xs @@ -28,7 +32,7 @@ vlenN = toNumber <<< vlen mean :: forall len. Number -> Vect len Number -> Number mean 0.0 xs = product xs `pow` (1.0 / vlenN xs) -mean p xs = (1.0 / vlenN xs * sum (map (pow p) xs)) `pow` (1.0/p) +mean p xs = (1.0 / vlenN xs * vsum (map (pow p) xs)) `pow` (1.0/p) type Matrix a = Array (Array a) @@ -37,6 +41,36 @@ instance Show IntInf where show (IInt x) = "IInt" <> show x show (Infty) = "Infty" +instance Semiring IntInf where + add Infty _ = Infty + add _ Infty = Infty + add (IInt x) (IInt y) = IInt (x + y) + zero = IInt 0 + one = IInt 1 + mul Infty _ = Infty + mul _ Infty = Infty + mul (IInt x) (IInt y) = IInt (x * y) +instance Ring IntInf where -- seems potentially dangerous? + sub Infty _ = Infty + sub _ Infty = Infty + sub (IInt x) (IInt y) = IInt (x - y) + +instance Eq IntInf where + eq Infty Infty = true + eq Infty (IInt _) = false + eq (IInt _) Infty = false + eq (IInt x) (IInt y) = eq x y + +instance Ord IntInf where + compare Infty Infty = EQ + compare Infty (IInt _) = GT + compare (IInt _) Infty = LT + compare (IInt x) (IInt y) = compare x y + +ipow :: IntInf -> IntInf -> IntInf +ipow Infty _ = Infty +ipow _ Infty = Infty +ipow (IInt x) (IInt y) = IInt (x `I.pow` y) matIndex :: forall a. Matrix a -> Int -> Int -> Maybe a matIndex mat row col = case mat !! row of @@ -78,6 +112,23 @@ transpose xs = Just { head: x, tail: xs' } -> (x `cons` mapMaybe head xss) `cons` transpose (xs' `cons` mapMaybe tail xss) +mMult :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a +mMult x y = do + ar <- x + bc <- (transpose y) + pure $ [(sum $ zipWith (*) ar bc)] + +mAdd :: forall a. Semiring a => Matrix a -> Matrix a -> Matrix a +mAdd x y = map (\(xR × yR) -> zipWith (+) xR yR) (zip x y) + +mSub :: forall a. Ring a => Matrix a -> Matrix a -> Matrix a +mSub x y = map (\(xR × yR) -> zipWith (-) xR yR) (zip x y) + +mapMatrix :: forall a b. (a -> b) -> Matrix a -> Matrix b +mapMatrix f m = map (\row -> map f row) m + +matSquared :: Matrix IntInf -> Matrix IntInf +matSquared mat = mapMatrix (\x -> x `ipow` (IInt 2)) mat main :: Effect Unit main = do @@ -86,3 +137,8 @@ main = do log $ "newMat: " <> (show newMat) log $ "transposed: " <> (show (transpose newMat)) + let testMul = [[1, 2],[3, 4]] `mMult` [[5, 6], [7, 8]] + logShow testMul + let testAdd = [[1,0], [0, 1]] `mSub` [[0, 1], [1,0]] + logShow testAdd +