From 71ed02d2728701130cf82e61a8633af0f6375812 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Fri, 17 Apr 2009 11:04:08 +0000 Subject: removed static experiment --- examples/experiments/Static.hs | 115 -------------------------------------- examples/experiments/useStatic.hs | 36 ------------ 2 files changed, 151 deletions(-) delete mode 100644 examples/experiments/Static.hs delete mode 100644 examples/experiments/useStatic.hs diff --git a/examples/experiments/Static.hs b/examples/experiments/Static.hs deleted file mode 100644 index 2e4ef4e..0000000 --- a/examples/experiments/Static.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts -fth -fallow-overlapping-instances -fallow-undecidable-instances #-} - -module Static where - -import Language.Haskell.TH -import Numeric.LinearAlgebra -import Foreign -import Language.Haskell.TH.Syntax - -instance Lift Double where - lift x = return (LitE (RationalL (toRational x))) - -instance Lift (Vector a ) where - lift v = [e| v |] - -instance Lift (Matrix a) where - lift m = [e| m |] - -tdim :: Int -> ExpQ -tdim 0 = [| Z |] -tdim n = [| S $(tdim (n-1)) |] - - -data Z = Z deriving Show -data S a = S a deriving Show - -class Dim a - -instance Dim Z -instance Dim a => Dim (S a) - -class Sum a b c | a b -> c -- , a c -> b, b c -> a - -instance Sum Z a a -instance Sum a Z a -instance Sum a b c => Sum a (S b) (S c) - -newtype SVec d t = SVec (Vector t) deriving Show -newtype SMat r c t = SMat (Matrix t) deriving Show - -createl :: d -> [Double] -> SVec d Double -createl d l = SVec (fromList l) - -createv :: Storable t => d -> Vector t -> SVec d t -createv d v = SVec v - -vec'' v = [|createv ($(tdim (dim v))) v|] - -vec' :: [Double] -> ExpQ -vec' d = [| createl ($(tdim (length d))) d |] - - -createm :: (Dim r, Dim c) => r -> c -> (Matrix Double) -> SMat r c Double -createm _ _ m = SMat m - -createml :: (Dim r, Dim c) => r -> c -> Int -> Int -> [Double] -> SMat r c Double -createml _ _ r c l = SMat ((r> Int -> [Double] -> ExpQ -mat r c l = [| createml ($(tdim r)) ($(tdim c)) r c l |] - -vec :: [Double] -> ExpQ -vec d = mat (length d) 1 d - - ---mat' :: Matrix Double -> ExpQ ---mat' m = [| createm ($(tdim (rows m))) ($(tdim (cols m))) m |] - -covec :: [Double] -> ExpQ -covec d = mat 1 (length d) d - -scalar :: SMat (S Z) (S Z) Double -> Double -scalar (SMat m) = flatten m @> 0 - -v = fromList [1..5] :: Vector Double -l = [1,1.5..5::Double] - -k = [11..30::Int] - -rawv (SVec v) = v -raw (SMat m) = m - -liftStatic :: (Matrix a -> Matrix b -> Matrix c) -> SMat dr dc a -> SMat dr dc b -> SMat dr dc c -liftStatic f a b = SMat (f (raw a) (raw b)) - -a |+| b = liftStatic (+) a b - -prod :: SMat r k Double -> SMat k c Double -> SMat r c Double -prod a b = SMat (raw a <> raw b) - -strans :: SMat r c Double -> SMat c r Double -strans = SMat . trans . raw - -sdot a b = scalar (prod a b) - -jv :: (Field t, Sum r1 r2 r3) => SMat r1 c t -> SMat r2 c t -> SMat r3 c t -jv a b = SMat ((raw a) <-> (raw b)) - --- curiously, we cannot easily fold jv because the matrics are not of the same type. - -jh a b = strans (jv (strans a) (strans b)) - - -homog :: (Field t) => SMat r c t -> SMat (S r) c t -homog m = SMat (raw m <-> constant 1 (cols (raw m))) - -inhomog :: (Linear Vector t) => SMat (S (S r)) c t -> SMat r c t -inhomog (SMat m) = SMat (sm <> d) where - sm = takeRows r' m - d = diag $ 1 / (flatten $ dropRows r' m) - r' = rows m -1 - - -ht t vs = inhomog (t `prod` homog vs) - diff --git a/examples/experiments/useStatic.hs b/examples/experiments/useStatic.hs deleted file mode 100644 index 619af8f..0000000 --- a/examples/experiments/useStatic.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# OPTIONS -fno-monomorphism-restriction #-} - -import Static -import Numeric.LinearAlgebra - - -x = $(vec [1,2]) - -y = $(vec [5,7]) - -z a = vec [a,a] - -w = $(vec [1,2,3]) - -cx = $(covec [1,2,3]) - - -t3 = $(tdim 3) - -crm33 = createml t3 t3 3 3 - -rot a = crm33 [a,0,0,0,a,0,0,0,1] - ---q = x |+| y |+| $(z 5) - -m = $(mat 2 3 [1..6]) - -n = $(mat 3 5 [1..15]) - -infixl 7 <*> -(<*>) = prod - -r1 = m <*> n -r2 = strans (strans n <*> strans m) - ---r' = prod n m -- cgit v1.2.3