A geometry idea for Zsolt

MyGeo.hs

{-# LANGUAGE FlexibleInstances                                              #-}
{-# LANGUAGE GADTs                                                          #-}
{-# LANGUAGE StandaloneDeriving                                             #-}
{-# LANGUAGE TypeFamilies                                                   #-}

module MyGeo where

import Data.Vec.Nat

import GHC.Real (Ratio(..))

-- I've parameterized it over the dimension type (a),
-- as well as the dimensionality (d)
data Geo a d where
    Geo1d :: a           -> Geo a N1
    Geo2d :: a -> a      -> Geo a N2
    Geo3d :: a -> a -> a -> Geo a N3

deriving instance Show a => Show (Geo a d)

xCoord :: Geo a d -> a
xCoord (Geo1d x)     = x
xCoord (Geo2d x _)   = x
xCoord (Geo3d x _ _) = x

yCoord :: Geo a (Succ (Succ n)) -> a
yCoord (Geo2d _ y)   = y
yCoord (Geo3d _ y _) = y
-- yCoord (Geo1d _) = ಠ_ಠ
-- we can't define yCoord for a 1d point, the type signature tells GHC
-- to not even allow us to try
-- similarly, a user would get a compile-time error upon attempting to call
-- yCoord (Geo1d 1)
-- or attempting to call yCoord on any Geo a d where d is not evidenced to
-- be ≥ 2, as above, even though a particular instance may in fact be



slopeThrough :: (Real a, Floating f) => Geo a (Succ (Succ n)) -> Geo a (Succ (Succ n)) -> f
slopeThrough (Geo2d x y)    (Geo2d x' y')   = realToFrac (x - x') / realToFrac (y - y')
slopeThrough (Geo3d x y z) (Geo3d x' y' z') = let deltaX = x' - x
                                                  deltaY = y' - y
                                                  deltaZ = z' - z
                                                  run = sqrt $ realToFrac (deltaX * deltaX) + realToFrac (deltaY * deltaY)
                                              in
                                              run / realToFrac deltaZ
-- I still see warnings here about unmatched (but impossible) patterns - e.g.
-- slopeThrough (Geo3d _ _ _) (Geo2d _ _) = …
-- or vice-versa



-- with the addition of type families we could define functions with output
-- types determined by input type
-- as a silly example:

class Slope a where
    type Slope' a
    slopeThru :: a -> a -> Slope' a

-- maybe you couuld do this more generally with Real and Fractional constraints,
-- but I was getting errors about the index not matching the class instance head
-- no matter how I cut it
instance Slope (Geo Integer N2) where
    type Slope' (Geo Integer N2) = Rational
    slopeThru (Geo2d x y) (Geo2d x' y') = (x' - x) :% (y' - y)

-- and we'll express the slope of a 3d line as a 3d direction vector
-- instead of a ratio of run to rise
instance Slope (Geo Integer N3) where
    -- ditto note above - would be nice to just define something for Num a => Geo a N3
    type Slope' (Geo Integer N3) = Geo Integer N3 -- or could express it as an (Integer, Integer, Integer) thruple
    slopeThru (Geo3d x y z) (Geo3d x' y' z') = Geo3d (x' - x) (y' - y) (z' - z)

-- Now:
-- >>> slopeThru (Geo3d (1::Integer) 1 0) (Geo3d 4 5 6)
-- Geo3d 3 4 6
--
-- >>> slopeThru (Geo2d (1::Integer) 1) (Geo2d 4 5)
-- 3 % 4
--
-- >>> slopeThru (Geo1d (1::Integer)) (Geo1d 4)
-- <interactive>:11:1:
--     No instance for (Slope (Geo Integer N1))
--       arising from a use of ‘slopeThru’
--     In the expression: slopeThru (Geo1d (1 :: Integer)) (Geo1d 4)
--     In an equation for ‘it’:
--         it = slopeThru (Geo1d (1 :: Integer)) (Geo1d 4)