{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
#if ( __GLASGOW_HASKELL__ < 820 )
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-}
#endif
module NumHask.Space
( Space(..)
, Pos(..)
) where
import NumHask.Prelude hiding (singleton)
class (Eq (Element s), Ord (Element s), Field (Element s)) => Space s where
type Element s :: *
lower :: s -> Element s
upper :: s -> Element s
mid :: s -> Element s
mid s = (lower s + upper s)/(one+one)
width :: s -> Element s
width s = upper s - lower s
singleton :: Element s -> s
singular :: s -> Bool
singular s = lower s == upper s
element :: Element s -> s -> Bool
element a s = a >= lower s && a <= upper s
contains :: s -> s -> Bool
contains s0 s1 =
( lower s0 <= lower s1 &&
upper s0 >= upper s1) ||
( lower s1 <= lower s0 &&
upper s1 >= upper s0)
disjoint :: s -> s -> Bool
disjoint s0 s1 =
( lower s0 < lower s1 &&
lower s0 < upper s1 &&
upper s0 < lower s1 &&
upper s0 < upper s1) ||
( lower s0 > lower s1 &&
lower s0 > upper s1 &&
upper s0 > lower s1 &&
upper s0 > upper s1)
intersects :: s -> s -> Bool
intersects s0 s1 = not $ disjoint s0 s1
union :: s -> s -> s
nul :: s
space :: (Foldable f) => f (Element s) -> s
space = foldr (\a x -> x `union` singleton a) nul
project :: s -> s -> Element s -> Element s
project s0 s1 p =
((p-lower s0)/(upper s0-lower s0)) * (upper s1-lower s1) + lower s1
type Grid s :: *
grid :: Pos -> s -> Grid s -> [Element s]
gridSpace :: s -> Grid s -> [s]
data Pos = OuterPos | InnerPos | LowerPos | UpperPos | MidPos deriving (Show, Generic, Eq)