packages feed

metric (empty) → 0.1.4

raw patch · 15 files changed

+431/−0 lines, 15 filesdep +QuickCheckdep +basedep +data-defaultsetup-changed

Dependencies added: QuickCheck, base, data-default, edit-distance, hmatrix, metric, test-framework, test-framework-quickcheck2, vector

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) vi++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ metric.cabal view
@@ -0,0 +1,32 @@+name:                metric+version:             0.1.4+synopsis:            Metric spaces.+license:             MIT+license-file:        LICENSE+author:              Vikram Verma+maintainer:          me@vikramverma.com+category:            Data+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:   Data.Metric,+                     Data.Metric.Class,+                     Data.Metric.Set,+                     Data.Metric.String,+                     Data.Metric.Vector.Real+  hs-source-dirs:    src+  other-modules:     Control.Applicative.Extras,+                     Data.Default.Instances.EditDistance,+                     Data.Function.Extras,+                     Data.List.Extras,+                     Data.Vector.Extras,+                     Data.Packed.Matrix.Extras+  other-extensions:  GADTs+  build-depends:     base == 4.*, vector, hmatrix, edit-distance, data-default++test-suite metric-tests:+  type:              exitcode-stdio-1.0+  main-is:           Main.hs+  hs-source-dirs:    test+  build-depends:     base == 4.*, vector, metric, QuickCheck, test-framework, test-framework-quickcheck2
+ src/Control/Applicative/Extras.hs view
@@ -0,0 +1,10 @@+module Control.Applicative.Extras ((<$$>), (<$$$>)) where++(<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f(g(h a)) -> f(g(h b))+(<$$$>) = fmap . fmap . fmap+ +(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(<$$>) = fmap . fmap++infixl 4 <$$>+infixl 8 <$$$>
+ src/Data/Default/Instances/EditDistance.lhs view
@@ -0,0 +1,13 @@+> module Data.Default.Instances.EditDistance () where+>+> import Data.Default (Default(..))+> import Text.EditDistance (Costs(..), EditCosts(..))++For sake of simplicity, we associate each operation with a fixed edit+cost:++> instance Default (Costs a) where+>   def = ConstantCost 1+>+> instance Default EditCosts where+>   def = EditCosts def def def def
+ src/Data/Function/Extras.hs view
@@ -0,0 +1,4 @@+module Data.Function.Extras (on3) where++on3 :: (b -> b -> b -> c) -> (a -> b) -> a -> a -> a -> c+g `on3` f = \x y z -> g (f x) (f y) (f z)
+ src/Data/List/Extras.lhs view
@@ -0,0 +1,6 @@+> module Data.List.Extras (count) where++`count` is `length` with a numeric result type:++> count :: Num b => [a] -> b+> count = fromIntegral . length
+ src/Data/Metric.hs view
@@ -0,0 +1,17 @@+module Data.Metric (+  Metric(..),+  Discrete(..),+  Hamming(..),+  Levenshtein(..),+  RestrictedDamerauLevenshtein(..),+  Euclidean(..),+  Taxicab(..),+  Cosine(..),+  Chebyshev(..),+  PostOffice(..)+) where++import Data.Metric.Class (Metric(..))+import Data.Metric.Set (Discrete(..))+import Data.Metric.String (Hamming(..), Levenshtein(..), RestrictedDamerauLevenshtein(..)) +import Data.Metric.Vector.Real (Euclidean(..), Taxicab(..), Cosine(..), Chebyshev(..), PostOffice(..))
+ src/Data/Metric/Class.lhs view
@@ -0,0 +1,13 @@+> module Data.Metric.Class (+>   Metric(..)+> ) where++The `Metric` typeclass, as defined here, is intended to contain types that+are metric spaces. Instances can be defined in terms of `distance` or the +infix `<->`:++> class Metric a where+>   (<->) :: a -> a -> Double+>   (<->) = distance +>   distance :: a -> a -> Double+>   distance = (<->)
+ src/Data/Metric/Set.lhs view
@@ -0,0 +1,28 @@+> {-# LANGUAGE GADTs #-}++Metric spaces defined over arbitrary sets.++> module Data.Metric.Set (+>   Discrete(..)+> ) where+>+> import Control.Applicative.Extras ((<$$>))+> import Data.Metric.Class (Metric(..))++`Discrete` wraps the discrete metric. If to elements are equal, the+distance is 0, otherwise it is 1. This can be applied between any+two `Eq` instances; i.e. any pair of non-empty sets.++> data Discrete a where +>   Discrete :: Eq a => a -> Discrete a+>+> instance Metric (Discrete a) where+>   Discrete a <-> Discrete b+>     | a == b    = 0+>     | otherwise = 1+>+> instance Eq (Discrete a) where+>   (==) = (0==) <$$> distance+>+> instance Show a => Show (Discrete a) where+>   show (Discrete a) = "Discrete " ++ show a
+ src/Data/Metric/String.lhs view
@@ -0,0 +1,55 @@+Metric spaces defined over strings; i.e. edit distance.++> module Data.Metric.String (+>   Hamming(..),+>   Levenshtein(..),+>   RestrictedDamerauLevenshtein(..)+> ) where+>+> import Control.Applicative.Extras ((<$$>))+> import Data.Default (Default(def))+> import Data.Default.Instances.EditDistance ()+> import Data.Function (on)+> import Data.List.Extras (count)+> import Data.Metric.Class (Metric(..))+> import Data.Metric.Set (Discrete(..))+> import Text.EditDistance (levenshteinDistance, restrictedDamerauLevenshteinDistance)++`Hamming` wraps Hamming distance: the number of positions between two+*fixed length* strings at which the corresponding symbols are different.+Equivalently, this can be seen as the minimum number of substitutions+required to change one of the strings into the other.++> newtype Hamming = Hamming+>   { getHamming :: String+>   } deriving (Eq, Show)+> +> instance Metric Hamming where+>   distance = count <$$> zipWith (distance `on` Discrete) `on` getHamming++`Levenshtein` wraps Levenshtein distance: the minimum number of+single-character operations-- insertions, deletions or substitutions--+required to make two strings equal. Here, we in effect re-export the+heavily optimised implementation provided by Max Bolingbroke's excellent+`edit-distance` package.++> newtype Levenshtein = Levenshtein+>   { getLevenshtein :: String+>   } deriving (Eq, Show)+>+> instance Metric Levenshtein where+>   distance = fromIntegral <$$> levenshteinDistance def `on` getLevenshtein++The Restricted-Damerau Levenshtein distance extends Levenshtein distance+(above), with an additional operation: the transposition of two+adjacent characters. It is 'restricted' in that the algorithm computes+the minimum number of edit operations **under the condition that no+substring is edited more than once.** Here, again, we're wrapping an+implementation from `edit-distance`.++> newtype RestrictedDamerauLevenshtein = RestrictedDamerauLevenshtein+>   { getRestrictedDamerauLevenshtein :: String+>   } deriving (Eq, Show)+>+> instance Metric RestrictedDamerauLevenshtein where+>   distance = fromIntegral <$$> restrictedDamerauLevenshteinDistance def `on` getRestrictedDamerauLevenshtein
+ src/Data/Metric/Vector/Real.lhs view
@@ -0,0 +1,113 @@+> {-# LANGUAGE GeneralizedNewtypeDeriving #-}++Metric spaces defined over real vectors.++> module Data.Metric.Vector.Real (+>   Euclidean(..),+>   Taxicab(..),+>   Cosine(..),+>   Chebyshev(..),+>   PostOffice(..)+> ) where+> +> import Prelude hiding (zipWith, map, foldr1, maximum, length)+> import Data.Function (on)+> import Data.Packed.Matrix.Extras (fromVectors)+> import Data.Vector (Vector(..), zipWith, map, foldr1, maximum, length)+> import Data.Vector.Extras (zero)+> import Numeric.LinearAlgebra.Algorithms (rank)+> import Data.Metric.Class (Metric(..))+> import Control.Applicative.Extras ((<$$>), (<$$$>))++Real vectors can be viewed as a metric space in more than one way, as we can+define multiple valid distance functions. To avoid ambiguous type instances,+we define a newtype wrapper over `Vector Double` for each distance function,+and make that `newtype` an instance of `Metric`.+ +`Euclidean` wraps Euclidean distance, our usual conception of distance+between two points on a plane. The square root of the sum of the+differences between corresponding coordinates ;-).++> newtype Euclidean = Euclidean +>   { getEuclidean :: Vector Double +>   } deriving (Eq, Show)+> +> instance Metric Euclidean where+>   distance = sqrt . foldr1 (+) . map (**2) <$$> zipWith (-) `on` getEuclidean++`Taxicab` describes the length of the path connecting the two vectors+along only vertical and horizontal lines (`_|`) without backtracing.+The name stems from the observation that it's the shortest distance you+could travel by taxi on a rectangular grid of streets (think Manhattan.)++> newtype Taxicab = Taxicab+>   { getTaxicab :: Vector Double+>   } deriving (Eq, Show)+> +> instance Metric Taxicab where+>   distance = foldr1 (+) . map abs <$$> zipWith (-) `on` getTaxicab+ +`Cosine` wraps cosine similarity, measuring the cosine of the angle+between two vectors using the Euclidean dot product formula. Unlike the+other distance functions, this describes orientation, rather than+magnitude; this is useful when comparing tf-idf weights, as it+implicitly normalises for document length.++Edge case: the denominator of this function is the product of the+vectors norms; when either of the vectors have no magnitude, this+describes division by zero. A runtime error occurs in this case.++> newtype Cosine = Cosine+>   { getCosine :: Vector Double+>   } deriving (Eq, Show)+> +> instance Metric Cosine where+>   Cosine v0 <-> Cosine v1 +>     | norm == 0 = error "zero magnitude vector"+>     | otherwise = (v0 `dot` v1) / norm+>     where norm = (v0 |*| v1)+>+> mag :: Vector Double -> Double+> mag = sqrt . foldr1 (+) . map (**2)+>+> dot :: Vector Double -> Vector Double -> Double+> dot = foldr1 (+) <$$> zipWith (*)+>+> (|*|) :: Vector Double -> Vector Double -> Double+> (|*|) = (*) `on` mag++`Chebyshev` wraps Chebyshev distance, in which the distance between two+vectors is defined to be the maximum of their differences along any+dimension.++> newtype Chebyshev = Chebyshev+>   { getChebyshev :: Vector Double+>   } deriving (Eq, Show)+> +> instance Metric Chebyshev where+>   distance = maximum . map abs <$$> zipWith (-) `on` getChebyshev++Post Office distance; the Euclidean distance between two vectors is Euclidean+when they are co-linear with the origin, and otherwise the sum of their+magnitudes. It's named so as letters usually need to first travel to the post+office, with exception to when the letter passes the destination on the way+there.++Three points are considered to be colinear if the matrix of their coordinates+has a rank less than one. In constructing a vector here, we consider together+with the origin those points that are the subject of the metric.++> newtype PostOffice = PostOffice+>   { getPostOffice :: Vector Double+>   } deriving (Eq, Show)+> +> instance Metric PostOffice where+>   PostOffice v0 <-> PostOffice v1 +>     | colinear v0 v1 (zero $ length v0) = Euclidean v0 <-> Euclidean v1+>     | otherwise = v0 |+| v1+>+> colinear :: Vector Double -> Vector Double -> Vector Double -> Bool+> colinear = (<1) . rank <$$$> fromVectors+>+> (|+|) :: Vector Double -> Vector Double -> Double+> (|+|) = (+) `on` mag
+ src/Data/Packed/Matrix/Extras.hs view
@@ -0,0 +1,9 @@+module Data.Packed.Matrix.Extras (fromVectors) where++import Data.Function.Extras (on3)+import Data.Vector (Vector(..), toList)+import Data.Packed.Matrix (Matrix(..), fromLists, trans)++fromVectors :: Vector Double -> Vector Double -> Vector Double -> Matrix Double+fromVectors = fromColumns `on3` toList+  where fromColumns xs ys zs = trans $ fromLists [xs, ys, zs]
+ src/Data/Vector/Extras.hs view
@@ -0,0 +1,7 @@+module Data.Vector.Extras (zero) where++import Prelude hiding(replicate)+import Data.Vector (Vector(..), replicate)++zero :: Num a => Int -> Vector a+zero = flip replicate 0
+ test/Main.hs view
@@ -0,0 +1,101 @@+import Data.Metric.Set (Discrete(..))+import Data.Metric.String (Hamming(..), Levenshtein(..), RestrictedDamerauLevenshtein(..))+import Data.Metric.Vector.Real (Euclidean(..), Taxicab(..), Cosine(..), Chebyshev(..), PostOffice(..))+import Control.Applicative ((<$>))+import Data.Vector (Vector(..), fromList)+import Data.Ratio ((%))+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Property, Arbitrary(..), conjoin, vector, vectorOf, oneof, choose)+import Test.QuickCheck.Property.Metric (prop_Metric)++instance Arbitrary a => Arbitrary (Vector a) where+  arbitrary = fromList <$> vector 2++-- | Discrete++instance (Eq a, Arbitrary a) => Arbitrary (Discrete a) where+  arbitrary = Discrete <$> arbitrary++prop_DiscreteMetric :: Discrete Char -> Discrete Char -> Discrete Char -> Property+prop_DiscreteMetric = prop_Metric++-- | Euclidean++instance Arbitrary Euclidean where+  arbitrary = Euclidean <$> arbitrary ++prop_EuclideanMetric :: Euclidean -> Euclidean -> Euclidean -> Property+prop_EuclideanMetric = prop_Metric++-- | Taxicab++instance Arbitrary Taxicab where+  arbitrary = Taxicab <$> arbitrary ++prop_TaxicabMetric :: Taxicab -> Taxicab -> Taxicab -> Property+prop_TaxicabMetric = prop_Metric++-- | Cosine++instance Arbitrary Cosine where+  arbitrary = oneof [choose (1,1000), choose (-1,-1000)]+          >>= vectorOf 3 . return . fromRational . (%100)+          >>= return . Cosine . fromList++prop_CosineMetric :: Cosine -> Cosine -> Cosine -> Property+prop_CosineMetric = prop_Metric++-- | Chebyshev++instance Arbitrary Chebyshev where+  arbitrary = Chebyshev <$> arbitrary ++prop_ChebyshevMetric :: Chebyshev -> Chebyshev -> Chebyshev -> Property+prop_ChebyshevMetric = prop_Metric++-- | PostOffice++instance Arbitrary PostOffice where+  arbitrary = PostOffice <$> arbitrary ++prop_PostOfficeMetric :: PostOffice -> PostOffice -> PostOffice -> Property+prop_PostOfficeMetric = prop_Metric++-- | Hamming++instance Arbitrary Hamming where+  arbitrary = Hamming <$> vector 10++prop_HammingMetric :: Hamming -> Hamming -> Hamming -> Property+prop_HammingMetric = prop_Metric++-- | Levenshtein++instance Arbitrary Levenshtein where+  arbitrary = Levenshtein <$> arbitrary ++prop_LevenshteinMetric :: Levenshtein -> Levenshtein -> Levenshtein -> Property+prop_LevenshteinMetric = prop_Metric++-- | Restricted Damerau Levenshtein++instance Arbitrary RestrictedDamerauLevenshtein where+  arbitrary = RestrictedDamerauLevenshtein <$> arbitrary ++prop_RestrictedDamerauLevenshteinMetric :: RestrictedDamerauLevenshtein -> RestrictedDamerauLevenshtein -> RestrictedDamerauLevenshtein -> Property+prop_RestrictedDamerauLevenshteinMetric = prop_Metric++-- |++main :: IO ()+main = defaultMain . return . testGroup "QuickCheck" $+  [ testProperty "discrete"    $ prop_DiscreteMetric+  , testProperty "euclidean"   $ prop_EuclideanMetric+  , testProperty "taxicab"     $ prop_TaxicabMetric+  , testProperty "cosine"      $ prop_CosineMetric+  , testProperty "chebyshev"   $ prop_ChebyshevMetric+  , testProperty "postoffice"  $ prop_PostOfficeMetric+  , testProperty "hamming"     $ prop_HammingMetric+  , testProperty "levenshtein" $ prop_LevenshteinMetric+  ]