average (empty) → 0.5

raw patch · 4 files changed

+196/−0 lines, 4 filesdep +basedep +semigroupssetup-changed

Dependencies added: base, semigroups

Files

COPYING +26/−0
Setup.hs +4/−0
average.cabal +29/−0
src/Data/Monoid/Average.hs +137/−0

+ COPYING view

@@ -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 <organization> 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 <COPYRIGHT HOLDER> 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.+

+ Setup.hs view

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++import Distribution.Simple+main = defaultMain

+ average.cabal view

@@ -0,0 +1,29 @@++name:               average+version:            0.5+cabal-version:      >= 1.10+author:             Hans Hoglund+maintainer:         Hans Hoglund <hans@hanshoglund.se>+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+

+ src/Data/Monoid/Average.hs view

@@ -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)++