[Haskell-cafe] ANN: fixed-vector
Aleksey Khudyakov
alexey.skladnoy at gmail.com
Mon Nov 12 13:05:21 CET 2012
> I have a lot of one-off code where I've defined these myself. Is it
> possible to e.g. define vectors in R^2 and R^3, and write the p-norm
> functions only once?
>
Yes. it's possible.
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> import Data.Vector.Fixed as V
> import Data.Vector.Fixed.Internal
> -- ^^^ Needed for Fun /will be reexported from Data.Vector.Fixed
> import Data.Vector.Fixed.Unboxed
First we need to define data types and instances. It's possible to use
vectors from library
> data Vec2D a = Vec2D a a
>
> type instance Dim Vec2D = S (S Z)
>
> instance Vector Vec2D a where
> inspect (Vec2D x y) (Fun f) = f x y
> construct = Fun Vec2D
>
>
> data Vec3D a = Vec3D a a a
>
> type instance Dim Vec3D = S (S (S Z))
>
> instance Vector Vec3D a where
> inspect (Vec3D x y z) (Fun f) = f x y z
> construct = Fun Vec3D
>
Now we can define generic p-norm. Maybe you had something different in
mind but still it's function which will work with any vector of fixed
length.
> pNorm :: (Vector v a, Floating a) => a -> v a -> a
> pNorm p = (** recip p) . V.sum . V.map ((** p) . abs)
We will get folloiwng in GHCi:
*Main> pNorm 1 $ Vec2D 1 2 :: Double
3.0
*Main> pNorm 1 $ Vec3D 1 2 3 :: Double
6.0
It's possible to avoid defining data types and use generic vectors
from library. Vec2 is synonym to Data.Vector.Fixed.Unboxed.Vec (S (S Z))
*Main> pNorm 2 (vec $ con |> 1 |> 2 :: Vec2 Double)
2.23606797749979
At the moment their construction is a bit cumbersome
so used replicate to illustrate other vector sizes.
*Main> pNorm 1 (V.replicate 1 :: Vec2 Double)
2.0
*Main> pNorm 1 (V.replicate 1 :: Vec (S (S (S Z))) Double)
3.0
*Main> pNorm 1 (V.replicate 1 :: Vec (S (S (S (S Z)))) Double)
4.0
More information about the Haskell-Cafe
mailing list