diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ + +Copyright (c) 2013, Hans Höglund +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/average.cabal b/average.cabal new file mode 100644 --- /dev/null +++ b/average.cabal @@ -0,0 +1,29 @@ + +name: average +version: 0.5 +cabal-version: >= 1.10 +author: Hans Hoglund +maintainer: Hans Hoglund +license: BSD3 +license-file: COPYING +synopsis: An average (arithmetic mean) monoid. +category: +tested-with: GHC +build-type: Simple + +description: + Provides a monoid for calculating arithmetic means. + +source-repository head + type: git + location: git://github.com/hanshoglund/average.git + +library + build-depends: + base >= 4 && < 5, + semigroups >= 0.13.0.1 && < 1 + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: + Data.Monoid.Average + diff --git a/src/Data/Monoid/Average.hs b/src/Data/Monoid/Average.hs new file mode 100644 --- /dev/null +++ b/src/Data/Monoid/Average.hs @@ -0,0 +1,137 @@ + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : stable +-- Portability : non-portable +-- +-- Provides a monoid for calculating arithmetic means. +-- +------------------------------------------------------------------------------------- + +module Data.Monoid.Average ( + Average(..), + average, + maybeAverage + ) where + +import Prelude hiding ((**)) + +import Data.Typeable +import Data.Maybe +import Data.Semigroup +import Data.AdditiveGroup +import Data.VectorSpace +import Data.AffineSpace +import Control.Monad +import Control.Applicative + +-- | +-- A monoid for 'Average' values. +-- +-- This is actually just the free monoid with an extra function 'average' for +-- extracing the (arithmetic) mean. This function is used to implement 'Real', +-- so you can use 'Average' whenever a ('Monoid', 'Real') is required. +-- +-- >>> toRational $ mconcat [1,2::Average Rational] +-- 3 % 2 +-- >>> toRational $ mconcat [1,2::Sum Rational] +-- 3 % 1 +-- >>> toRational $ mconcat [1,2::Product Rational] +-- 2 % 1 +-- +newtype Average a = Average { getAverage :: [a] } + deriving (Show, Semigroup, Monoid, Typeable, Functor, Applicative) + +instance (Fractional a, Eq a) => Eq (Average a) where + a == b = average a == average b + +instance (Fractional a, Ord a) => Ord (Average a) where + a `compare` b = average a `compare` average b + +-- What should (+) and (*) do for Average values? +-- +-- The important thing is to preserve scalar addition and multiplication (for example +-- scaling all components of) an average value by some constant factor, so we can just as +-- well use the standard list instance. What about averages with more components? I *think* +-- 'average' is a linear map, so they would work as expected: +-- +-- >>> average (2<>2<>3)+average (3<>3) +-- 16 % 3 +-- >>> average $ (2<>2<>3)+(3<>3) +-- 16 % 3 +-- >>> average (mconcat [5,6,9])*average (mconcat[-1,0]) +-- (-10) % 3 +-- >>> average $ (mconcat [5,6,9])*(mconcat[-1,0]) +-- (-10) % 3 +-- + +instance Num a => Num (Average a) where + (+) = liftA2 (+) + (*) = liftA2 (*) + negate = fmap negate + abs = fmap abs + signum = fmap signum + fromInteger = pure . fromInteger + +instance (Fractional a, Num a) => Fractional (Average a) where + (/) = liftA2 (/) + fromRational = pure . fromRational + +instance (Real a, Fractional a) => Real (Average a) where + toRational = toRational . average + +instance Floating a => Floating (Average a) where + pi = pure pi + exp = fmap exp + sqrt = fmap sqrt + log = fmap log + sin = fmap sin + tan = fmap tan + cos = fmap cos + asin = fmap asin + atan = fmap atan + acos = fmap acos + sinh = fmap sinh + tanh = fmap tanh + cosh = fmap cosh + asinh = fmap asinh + atanh = fmap atanh + acosh = fmap acosh + +instance AdditiveGroup a => AdditiveGroup (Average a) where + zeroV = pure zeroV + (^+^) = liftA2 (^+^) + negateV = fmap negateV + +instance VectorSpace a => VectorSpace (Average a) where + type Scalar (Average a) = Scalar a + s *^ v = liftA2 (*^) (pure s) v + +instance AffineSpace a => AffineSpace (Average a) where + type Diff (Average a) = Average (Diff a) + p1 .-. p2 = liftA2 (.-.) p1 p2 + p .+^ v = liftA2 (.+^) p v + +{- +instance Arbitrary a => Arbitrary (Average a) where + arbitrary = fmap Average arbitrary +-} + +-- | Return the average of all monoidal components. If given 'mempty', return zero. +average :: Fractional a => Average a -> a +average = fromMaybe 0 . maybeAverage + +-- | Return the average of all monoidal components. If given 'mempty', return 'Nothing'. +maybeAverage :: Fractional a => Average a -> Maybe a +maybeAverage (Average []) = Nothing +maybeAverage (Average xs) = Just $ sum xs / fromIntegral (length xs) + +