module Goal.Geometry.Manifold
(
Manifold (dimension)
, Transition (transition)
, Embedded (Embedded, disembed)
, Coordinates
, (:#:) (coordinates, manifold)
, coordinate
, chart
, breakChart
, alterChart
, listCoordinates
, alterCoordinates
, toPair
, Cartesian (Cartesian)
, Polar (Polar)
, fromList
, fromCoordinates
, euclideanPoint
, realNumber
, mapReplicated
, joinReplicated
, concatReplicated
, joinPair
, splitPair
, joinPair'
, splitPair'
, joinTriple
, splitTriple
, joinTriple'
, splitTriple'
) where
import Goal.Core
import Goal.Geometry.Set
import qualified Data.Vector.Storable as C
class Eq m => Manifold m where
dimension :: m -> Int
data c :#: m = Point
{ coordinates :: !Coordinates
, manifold :: m } deriving (Eq, Read, Show)
infixr 1 :#:
coordinate :: Int -> c :#: m -> Double
coordinate n (Point cs _) = cs C.! n
data Embedded m c = Embedded { disembed :: m } deriving (Eq, Read, Show)
chart :: Manifold m => c -> c :#: m -> c :#: m
chart _ = id
breakChart :: Manifold m => c :#: m -> d :#: m
breakChart p = Point (coordinates p) (manifold p)
alterChart :: Manifold m => d -> c :#: m -> d :#: m
alterChart _ = breakChart
toPair :: c :#: m -> (Double,Double)
toPair p = (coordinate 0 p,coordinate 1 p)
alterCoordinates :: Manifold m => (Double -> Double) -> c :#: m -> c :#: m
alterCoordinates f (Point cs m) = Point (C.map f cs) m
listCoordinates :: c :#: m -> [Double]
listCoordinates (Point cs _) = C.toList cs
class Transition c d m where
transition :: c :#: m -> d :#: m
fromList :: Manifold m => m -> [Double] -> c :#: m
fromList m cs = fromCoordinates m $ C.fromList cs
fromCoordinates :: Manifold m => m -> Coordinates -> c :#: m
fromCoordinates m cs
| dimension m == C.length cs = Point cs m
| otherwise = error
$ "Coordinate dimension (" ++ show (C.length cs) ++ ") does not match Manifold dimension (" ++ show (dimension m) ++ ")."
euclideanPoint :: [Double] -> Cartesian :#: Euclidean
euclideanPoint xs = fromList (Euclidean $ length xs) xs
realNumber :: Double -> Cartesian :#: Continuum
realNumber x = fromList Continuum [x]
data Cartesian = Cartesian
data Polar = Polar
mapReplicated :: Manifold m => (c :#: m -> x) -> c :#: Replicated m -> [x]
mapReplicated pf ps =
let (Replicated m k) = manifold ps
cs = coordinates ps
b = dimension m
in [ pf . fromCoordinates m $ C.slice (i * b) b cs | i <- [0.. k 1 ] ]
joinReplicated :: Manifold m => [c :#: m] -> c :#: Replicated m
joinReplicated ps =
Point (foldl1' (C.++) (coordinates <$> ps)) $ Replicated (manifold $ head ps) (length ps)
concatReplicated :: c :#: Replicated m -> c :#: Replicated m -> c :#: Replicated m
concatReplicated (Point cs (Replicated m x)) (Point cs' (Replicated _ y)) = Point (cs C.++ cs') $ Replicated m (x + y)
joinPair :: (Manifold m, Manifold n) => c :#: m -> d :#: n -> (c,d) :#: (m,n)
joinPair = unsafeJoinPair
splitPair :: (Manifold m, Manifold n) => (c,d) :#: (m,n) -> (c :#: m, d :#: n)
splitPair = unsafeSplitPair
joinPair' :: (Manifold m, Manifold n) => c :#: m -> c :#: n -> c :#: (m,n)
joinPair' = unsafeJoinPair
splitPair' :: (Manifold m, Manifold n) => c :#: (m,n) -> (c :#: m, c :#: n)
splitPair' = unsafeSplitPair
unsafeJoinPair :: (Manifold m, Manifold n) => c :#: m -> d :#: n -> e :#: (m,n)
unsafeJoinPair cm dn =
fromCoordinates (manifold cm,manifold dn) $ coordinates cm C.++ coordinates dn
unsafeSplitPair :: (Manifold m, Manifold n) => c :#: (m,n) -> (d :#: m, e :#: n)
unsafeSplitPair cmn =
let (m,n) = manifold cmn
cs = coordinates cmn
(mcs,ncs) = C.splitAt (dimension m) cs
in (fromCoordinates m mcs, fromCoordinates n ncs)
joinTriple :: (Manifold m, Manifold n, Manifold o) => c :#: m -> d :#: n -> e :#: o -> (c,d,e) :#: (m,n,o)
joinTriple = unsafeJoinTriple
splitTriple :: (Manifold m, Manifold n, Manifold o) => (c,d,e) :#: (m,n,o) -> (c :#: m, d :#: n, e :#: o)
splitTriple = unsafeSplitTriple
joinTriple' :: (Manifold m, Manifold n, Manifold o) => c :#: m -> c :#: n -> c :#: o -> c :#: (m,n,o)
joinTriple' = unsafeJoinTriple
splitTriple' :: (Manifold m, Manifold n, Manifold o) => c :#: (m,n,o) -> (c :#: m, c :#: n, c :#: o)
splitTriple' = unsafeSplitTriple
unsafeJoinTriple :: (Manifold m, Manifold n, Manifold o) => c :#: m -> d :#: n -> e :#: o -> f :#: (m,n,o)
unsafeJoinTriple cm dn eo =
fromCoordinates (manifold cm, manifold dn, manifold eo) $ coordinates cm C.++ coordinates dn C.++ coordinates eo
unsafeSplitTriple :: (Manifold m, Manifold n, Manifold o) => c :#: (m,n,o) -> (d :#: m, e :#: n, f :#: o)
unsafeSplitTriple cmno =
let (m,n,o) = manifold cmno
(mcs,cs') = C.splitAt (dimension m) $ coordinates cmno
(ncs,ocs) = C.splitAt (dimension n) cs'
in (fromCoordinates m mcs, fromCoordinates n ncs, fromCoordinates o ocs)
instance Transition c c m where
transition = id
instance Manifold m => Set (Embedded m c) where
type Element (Embedded m c) = c :#: m
instance Manifold Euclidean where
dimension (Euclidean n) = n
instance Manifold Continuum where
dimension _ = 1
instance Transition Polar Cartesian Euclidean where
transition p =
let r:phis = listCoordinates p
phiss = reverse . tails $ reverse phis
m = manifold p
xs = [ r * cos phi * product (sin <$> phis') | (phi,phis') <- zip phis phiss ]
in fromList m $ xs ++ [r * product (sin <$> phis)]
instance Transition Cartesian Polar Euclidean where
transition p =
let (Euclidean n) = manifold p
xs = listCoordinates p
xs2 = listCoordinates $ alterCoordinates (^2) p
r = sqrt $ sum xs2
(phis,phin0:_) = splitAt (n2) [ acos $ xi / sqrt (sum xs2i) | (xi,xs2i) <- zip xs (tails xs2) ]
xn = last xs
phin = if xn > 0 then phin0 else 2*pi phin0
in fromList (Euclidean n) $ r : (phis ++ [phin])
instance (Manifold m, Manifold n) => Manifold (m,n) where
dimension (m,n) = dimension m + dimension n
instance (Manifold m, Manifold n, Manifold o) => Manifold (m,n,o) where
dimension (m,n,o) = dimension m + dimension n + dimension o
instance Manifold m => Manifold (Replicated m) where
dimension (Replicated m rn) = dimension m * rn