{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RebindableSyntax #-}

-- | Data primitives and utilities
--
-- Whilst the library makes use of <https://hackage.haskell.org/package/numhask numhask>, it does not re-export, to avoid clashes with Prelude, with the exception of 'zero', 'one', 'angle' & 'abs'.
--
-- 'Rect' and 'Point', from <https://hackage.haskell.org/package/numhask-space numhask-space>, make up the base elements of many chart primitives.
module Chart.Data
  ( -- * Data Primitives
    Rect (..),
    pattern Rect,
    mid,
    foldRect,
    addPoint,
    projectOnP,
    projectOnR,
    space1,
    padRect,
    padSingletons,
    isSingleton,
    Point (..),
    addp,
    Range (..),

    -- * NumHask Exports
    Multiplicative (one),
    Additive (zero),
    abs,
    Direction (..),
    Basis (..),
  )
where

import NumHask.Prelude
import NumHask.Space

-- $setup
--
-- >>> import Chart
-- >>> import NumHask.Space

-- | Additive pad (or frame or buffer) a Rect.
--
-- >>> padRect 1 one
-- Rect (-1.5) 1.5 (-1.5) 1.5
padRect :: (Subtractive a) => a -> Rect a -> Rect a
padRect :: forall a. Subtractive a => a -> Rect a -> Rect a
padRect a
p (Rect a
x a
z a
y a
w) = forall a. a -> a -> a -> a -> Rect a
Rect (a
x forall a. Subtractive a => a -> a -> a
- a
p) (a
z forall a. Additive a => a -> a -> a
+ a
p) (a
y forall a. Subtractive a => a -> a -> a
- a
p) (a
w forall a. Additive a => a -> a -> a
+ a
p)

-- | Pad a Rect to remove singleton dimensions.
--
-- Attempting to scale a singleton dimension of a Rect is a common bug.
--
-- Due to the use of scaling, and thus zero dividing, this is a common exception to guard against.
--
-- >>> project (Rect 0 0 0 1) one (Point 0 0)
-- Point NaN (-0.5)
--
-- >>> project (padSingletons (Rect 0 0 0 1)) one (Point 0 0)
-- Point 0.0 (-0.5)
padSingletons :: Rect Double -> Rect Double
padSingletons :: Rect Double -> Rect Double
padSingletons (Rect Double
x Double
z Double
y Double
w)
  | Double
x forall a. Eq a => a -> a -> Bool
== Double
z Bool -> Bool -> Bool
&& Double
y forall a. Eq a => a -> a -> Bool
== Double
w = forall a. a -> a -> a -> a -> Rect a
Rect (Double
x forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double
x forall a. Additive a => a -> a -> a
+ Double
0.5) (Double
y forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double
y forall a. Additive a => a -> a -> a
+ Double
0.5)
  | Double
x forall a. Eq a => a -> a -> Bool
== Double
z = forall a. a -> a -> a -> a -> Rect a
Rect (Double
x forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double
x forall a. Additive a => a -> a -> a
+ Double
0.5) Double
y Double
w
  | Double
y forall a. Eq a => a -> a -> Bool
== Double
w = forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z (Double
y forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double
y forall a. Additive a => a -> a -> a
+ Double
0.5)
  | Bool
otherwise = forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
y Double
w

-- | is any dimension singular?
isSingleton :: Rect Double -> Bool
isSingleton :: Rect Double -> Bool
isSingleton (Rect Double
x Double
z Double
y Double
w) = Double
x forall a. Eq a => a -> a -> Bool
== Double
z Bool -> Bool -> Bool
|| Double
y forall a. Eq a => a -> a -> Bool
== Double
w

-- | add Points, dimension-wise
--
-- >>> Point 1 1 `addp` Point 0 2
-- Point 1.0 3.0
addp :: Point Double -> Point Double -> Point Double
addp :: Point Double -> Point Double -> Point Double
addp = forall a. Additive a => a -> a -> a
(+)