[Haskell-cafe] Re: [Haskell] Defining Cg, HLSL
style vectors in Haskell
Fco.Javier Loma
fjloma at andaluciajunta.es
Wed Dec 6 14:29:43 EST 2006
Slavomir Kaslev <slavomir.kaslev <at> gmail.com> writes:
>
> On 11/29/06, Krasimir Angelov <kr.angelov <at> gmail.com> wrote:
> > It is possible of course but your definition doesn't correspond to any
> > operation in the usual vector algebra. By the way how do you define
> > (*)? Isn't it 3D vector multiplication?
> >
>
> (*) is per component multiplication, as it is in Cg/HLSL. For vector
> to vector, vector to matrix, etc. multiplication there is mul.
>
> Cheers.
>
Hello, I have defined a class for vectors that I think can be interesting for
you, althougt I do NOT use the Num class. I really like infix operators for
vectors but using + * ... and so gets things confusing for me and have bad
interaction with scalars. So I define infix operators <+> <-> <*> ... with an
"<" or ">" on the side when a vector is spected, so (*>) is a scalar
multiplication of a vector, (<*>) multiplication of two vectors, <.> dot product
....
The class is named Vector, and I don't make distinction bewteen vectors and
points. A minimalist instance of Vector class, can be defined by only two method
functions, reduceComponent and combineComponent. reduceComponent is like a fold
functions over the components of a vector, so for example the max component of a
vector is defined as "maxComponent vec = reduceComponent (max) vec".
combineComponent apply a function to every pair of components of two vectors, so
an addition of two vectors is defined as "(<+>) a b = combineComponent (+) a b".
Note that for Vector3 and Vector2 datatypes I define instances with
reduceComponent and combineComponent, but for performance reasons I override
default implementations of the most used operations.
Here is the code, I hope that it makes clear what I have tried to explain.
Please, feel free to criticize the code
Fco. Javier Loma
fjloma <at> andaluciajunta.es
--begin code
{-# OPTIONS_GHC -fglasgow-exts -fbang-patterns #-}
module Data.Vectors where
-- Use a Double for each component
type VReal = Double
--data Dimension = X | Y | Z | W deriving (Show, Read, Eq)
data Vector3 = V3 !VReal !VReal !VReal deriving (Show, Read, Eq)
class (Floating r, Ord r) => (Vector r) v | v -> r where
-- minimun definition by reduceComponent and combineComponent
reduceComponent :: (r -> r -> r) -> v -> r
combineComponent :: (r -> r -> r) -> v -> v -> v
(<+>) :: v -> v -> v
(<+>) a b = combineComponent (+) a b
(<->) :: v -> v -> v
(<->) a b = combineComponent (-) a b
(<*>) :: v -> v -> v
(<*>) a b = combineComponent (*) a b
(</>) :: v -> v -> v
(</>) a b = combineComponent (/) a b
(<.>) :: v -> v -> r
a <.> b = reduceComponent (+) (combineComponent (*) a b)
(<*) :: v -> r -> v
a <* k = combineComponent (\x -> \_ -> x*k) a a
(</) :: v -> r -> v
a </ k = combineComponent (\x -> \_ -> x/k) a a
(*>) :: r -> v -> v
k *> vec = vec <* k
normalize :: v -> v
normalize vec = vec </ (vlength vec)
vlength :: v -> r
vlength vec = sqrt(vec <.> vec)
maxComponent :: v -> r
maxComponent vec = reduceComponent (max) vec
minComponent :: v -> r
minComponent vec = reduceComponent (min) vec
middle :: v -> v -> v
middle a b = (a <+> b) </ 2
distance :: v -> v -> r
distance a b = sqrt (distance2 a b)
distance2 :: v -> v -> r
distance2 a b = r <.> r
where r = b <-> a
instance Vector VReal Vector3 where
reduceComponent f (V3 a1 a2 a3) = (f a1 (f a2 a3))
combineComponent f (V3 a1 a2 a3) (V3 b1 b2 b3) = V3 (f a1 b1) (f a2 b2) (f
a3 b3)
(!V3 a1 a2 a3) <+> (!V3 b1 b2 b3) = V3 (a1 + b1) (a2 + b2) (a3 + b3)
(!V3 a1 a2 a3) <-> (!V3 b1 b2 b3) = V3 (a1 - b1) (a2 - b2) (a3 - b3)
(!V3 a1 a2 a3) <*> (!V3 b1 b2 b3) = V3 (a1 * b1) (a2 * b2) (a3 * b3)
(!V3 a1 a2 a3) </> (!V3 b1 b2 b3) = V3 (a1 / b1) (a2 / b2) (a3 / b3)
(!V3 a1 a2 a3) <.> (!V3 b1 b2 b3) = a1 * b1 + a2 * b2 + a3 * b3
(!V3 a1 a2 a3) <* k = V3 (a1 * k) (a2 * k) (a3 * k)
(!V3 a1 a2 a3) </ k = V3 (a1 / k) (a2 / k) (a3 / k)
data Vector2 = V2 !VReal !VReal deriving (Show, Read, Eq)
instance Vector VReal Vector2 where
combineComponent f (V2 a1 a2) (V2 b1 b2) = V2 (f a1 b1) (f a2 b2)
reduceComponent f (V2 a1 a2) = (f a1 a2)
(V2 a1 a2 ) <.> (V2 b1 b2 ) = a1 * b1 + a2 * b2
(V2 a1 a2 ) <* k = V2 (a1 * k) (a2 * k)
(V2 a1 a2 ) </ k = V2 (a1 / k) (a2 / k)
More information about the Haskell-Cafe
mailing list