From d925bada507562250a75587c409bdb35bbbc6ed8 Mon Sep 17 00:00:00 2001
From: Alberto Ruiz <aruiz@um.es>
Date: Mon, 1 Oct 2007 18:52:46 +0000
Subject: misc examples

---
 examples/Static.hs    | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++
 examples/latexmat.hs  |  11 ++++++
 examples/parallel.hs  |  10 +++++
 examples/usaStatic.hs |  36 +++++++++++++++++
 4 files changed, 161 insertions(+)
 create mode 100644 examples/Static.hs
 create mode 100644 examples/latexmat.hs
 create mode 100644 examples/parallel.hs
 create mode 100644 examples/usaStatic.hs

diff --git a/examples/Static.hs b/examples/Static.hs
new file mode 100644
index 0000000..c4856f5
--- /dev/null
+++ b/examples/Static.hs
@@ -0,0 +1,104 @@
+{-# 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 a, Storable a) => Lift (Vector a ) where
+
+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 |]
+
+
+createml :: (Dim r, Dim c) => r -> c -> Int -> Int -> [Double] -> SMat r c Double
+createml _ _ r c l = SMat ((r><c) l)
+
+mat :: Int -> 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|]
+
+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/latexmat.hs b/examples/latexmat.hs
new file mode 100644
index 0000000..d912a28
--- /dev/null
+++ b/examples/latexmat.hs
@@ -0,0 +1,11 @@
+import Numeric.LinearAlgebra
+import Text.Printf
+
+disp w l fmt m = unlines $ map (++l) $ lines $ format w (printf fmt) m
+
+latex fmt m = "\\begin{bmatrix}\n" ++ disp " & " " \\\\" fmt m ++ "\\end{bmatrix}"
+
+main = do
+    let m = (3><4) [1..12::Double]
+    putStrLn $ disp " | " "" "%.2f" m
+    putStrLn $ latex "%.3f" m
diff --git a/examples/parallel.hs b/examples/parallel.hs
new file mode 100644
index 0000000..2ad686e
--- /dev/null
+++ b/examples/parallel.hs
@@ -0,0 +1,10 @@
+import System(getArgs)
+import Numeric.LinearAlgebra
+import Control.Parallel.Strategies
+
+work k = vectorMax s
+    where (_,s,_) = svd (ident k :: Matrix Double)
+
+main = do
+    args <- (read . head) `fmap` getArgs
+    print $ sum $ parMap rnf work args
\ No newline at end of file
diff --git a/examples/usaStatic.hs b/examples/usaStatic.hs
new file mode 100644
index 0000000..619af8f
--- /dev/null
+++ b/examples/usaStatic.hs
@@ -0,0 +1,36 @@
+{-# 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