smoothie 0.2.2 → 0.3

raw patch · 7 files changed

+188/−178 lines, 7 files

Files

• CHANGELOG.md +9/−0
• smoothie.cabal +3/−3
• src/Data/Spline.hs +2/−47
• src/Data/Spline/CP.hs +0/−23
• src/Data/Spline/Curve.hs +79/−0
• src/Data/Spline/Key.hs +95/−0
• src/Data/Spline/Polynomial.hs +0/−105

@@ -1,3 +1,12 @@+## 0.3++- Added Bézier interpolation mode.+- Removed CP type.+- Removed Polynomial type.+- Added Key type. It replaces both CP and Polynomial.+- Enhanced user interface with the library.+- Internal files refactoring.+ ## 0.2.2  - Added cubicHermite.

@@ -1,5 +1,5 @@ name:                smoothie
-version:             0.2.2
+version:             0.3
 synopsis:            Smooth curves via several splines and polynomials.
 description:         This package exports several splines and curves you can use
                      to interpolate points in between.
@@ -25,8 +25,8 @@                      , DeriveTraversable
 
   exposed-modules:     Data.Spline
-                     , Data.Spline.CP
-                     , Data.Spline.Polynomial
+                     , Data.Spline.Curve
+                     , Data.Spline.Key
 
 
   build-depends:       base   >= 4.7  && < 5.0

@@ -16,52 +16,7 @@ ----------------------------------------------------------------------------  module Data.Spline (-    -- * Spline-    Spline-  , spline-  , unspline-    -- * Sampling values from splines-  , sample+    module X   ) where -import Data.List ( sortBy )-import Data.Ord ( comparing )-import Data.Spline.CP-import Data.Spline.Polynomial ( Polynomial(..), bsearchLower )-import Data.Vector ( Vector, (!?), fromList, toList )-import qualified Data.Vector as V ( zip )---- |A @Spline@ is a collection of control points with associated polynomials.--- Given two control points which indices are /i/ and /i+1/, interpolation on--- the resulting curve is performed using the polynomial of indice /i/. Thus,--- the latest control point is ignored and can be set to whatever the user wants--- to, even 'undefined' – you should use hold, though. Yeah, don’t go filthy.-data Spline s a = Spline (Vector (CP s a)) (Vector (Polynomial s a))---- |Create a spline using a list of control points and associated polynomials.--- Since 'spline' sorts the list before creating the 'Spline', you don’t have to--- ensure the list is sorted – even though you should, setting control points--- with no order might be… chaotic.-spline :: (Ord a,Ord s) => [(CP s a,Polynomial s a)] -> Spline s a-spline = uncurry spline_ . unzip . dupLast . sortBy (comparing fst)-  where-    spline_ cps polys = Spline (fromList cps) (fromList polys)---- |Deconstruct a 'Spline s a' to yield '[(CP s a,Polynomial s a)]'.-unspline :: Spline s a -> [(CP s a,Polynomial s a)]-unspline (Spline cps polys) = toList $ V.zip cps polys---- |Sample a point on a spline.-sample :: (Ord s) => Spline s a -> s -> Maybe a-sample (Spline cps polys) s = do-  i <- bsearchLower (\(CP s' _) -> compare s s') cps-  p <- polys !? i-  unPolynomial p s cps---- Duplicate the last element in a list.------ Warning: unsafe function.-dupLast :: [a] -> [a]-dupLast [] = []-dupLast [x] = [x,x]-dupLast (x:xs) = x : dupLast xs+import Data.Spline.Curve as X

@@ -1,23 +0,0 @@------------------------------------------------------------------------------
--- |
--- Copyright   : (C) 2015 Dimitri Sabadie
--- License     : BSD3
---
--- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>
--- Stability   : experimental
--- Portability : portable
---
-----------------------------------------------------------------------------
-
-module Data.Spline.CP (
-    -- * Control points
-    CP(..)
-  ) where
-
--- | A 'CP' is a **control point**. A curve passes through control points and
--- the shape of the curve is determined by the polynomials used to interpolate
--- values in between.
---
--- @CP s a@ is a control point of sampling type 's' and carried type 'a'. In
--- most cases, 's' must be 'Ord' and 'a' must be 'Additive' and 'Fractional'.
-data CP s a = CP !s !a deriving (Foldable,Functor,Eq,Ord,Show,Traversable)

@@ -0,0 +1,79 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Data.Spline.Curve (+    -- * Spline+    Spline+  , splineKeys+  , splineSampler+    -- * Building splines+  , spline+    -- * Sampling splines+  , sample+    -- * Re-exported+  , module X+  ) where++import Control.Monad ( guard )+import Data.List ( sortBy )+import Data.Ord ( comparing )+import Data.Spline.Key as X+import Data.Vector ( Vector, (!?), fromList )+import Linear ( Additive )++-- |A @Spline@ is a collection of keys with associated interpolation modes.+-- Given two keys which indices are /i/ and /i+1/, the interpolation mode on the+-- resulting curve is performed using the interpolation mode of the key /i/.+-- Thus, the interpolation mode of the latest key might be ignored. There’s an+-- exception, though, when using the 'Bezier' interpolation mode.+data Spline a s = Spline {+    -- |Extract the keys.+    splineKeys :: Vector (Key (a s))+    -- |Extract the sampler.+  , splineSampler :: a s -> s+  }++-- |Build a 'Spline a s'.+--+-- 'a s' is the type hold by keys. For instance, @V2 Float@.+--+-- The first argument of the function, which has type @a s -> s@ is a function+-- used to extract the sampling value of each keys. In most cases, that value+-- represents the time or the frame of a simulation. That value is used to+-- perform sampling comparison.+spline :: (Ord s)+       => (a s -> s)+       -> [Key (a s)]+       -> Spline a s+spline sampler keys =+  Spline (fromList $ sortBy (comparing $ sampler . keyValue) keys) sampler++-- |Sample a 'Spline' at a given 's' sampling value. If no sample exists,+-- yields 'Nothing'.+sample :: (Additive a,Floating s,Ord s) => Spline a s -> s -> Maybe (a s)+sample (Spline keys sampler) at = do+  i <- bsearchLower (\k -> compare at (sampler $ keyValue k)) keys+  interpolateKeys at <$> keys !? i <*> keys !? (i + 1)++-- Helper binary search that searches the ceiling index for the+-- value to be searched according to the predicate.+bsearchLower :: (a -> Ordering) -> Vector a -> Maybe Int+bsearchLower p v = go 0 (length v - 1)+  where+    go start end = do+        guard (start <= end)+        ma <- v !? m+        ma1 <- v !? succ m+        case p ma of+          LT -> go start (pred m)+          EQ -> Just m+          GT -> if p ma1 == LT then Just m else go (succ m) end+      where+        m = (end + start) `div` 2

@@ -0,0 +1,95 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Data.Spline.Key (+    -- * Key type+    Key(..)+  , keyValue+    -- * interpolation+  , interpolateKeys+  ) where++import Linear++-- |A 'Key' is a point on the spline with extra information added. It can be,+-- for instance, left and right handles for a 'Bezier' curve, or whatever the+-- interpolation might need.+--+-- @Hold v@ is used to express no interpolation and holds its latest value until+-- the next key.+--+-- @Linear v@ represents a linear interpolation until the next key.+--+-- @Cosine v@ represents a cosine interpolation until the next key.+--+-- @CubicHermite v@ represents a cubic hermitian interpolation until the next+-- key.+--+-- @Bezier l v r@ represents a cubic Bezier interpolation, where 'l' refers+-- to the input – left – normal of the key and 'r' is the+-- output – right – normal of the key.+data Key a+  = Hold a+  | Linear a+  | Cosine a+  | CubicHermite a+  | Bezier a a a+    deriving (Eq,Show)++instance Functor Key where+  fmap f k = case k of+    Hold a         -> Hold (f a)+    Linear a       -> Linear (f a)+    Cosine a       -> Cosine (f a)+    CubicHermite a -> CubicHermite (f a)+    Bezier l a r   -> Bezier (f l) (f a) (f r)++-- |Extract the value out of a 'Key'.+keyValue :: Key a -> a+keyValue k = case k of+  Hold a         -> a+  Linear a       -> a+  Cosine a       -> a+  CubicHermite a -> a+  Bezier _ a _   -> a++-- |@interpolateKeys t start end@ interpolates between 'start' and 'end' using+-- 's' as a normalized sampling value.+--+-- Satisfies the following laws:+-- @+--   interpolateKeys 0 start _ = start+--   interpolateKeys 1 _ end   = end+-- @+interpolateKeys :: (Additive a,Floating s) => s -> Key (a s) -> Key (a s) -> a s+interpolateKeys s start end = case start of+    Hold k         -> k+    Linear k       -> lerp s b k+    Cosine k       -> lerp ((1 - cos (s * pi)) * 0.5) b k+    CubicHermite k -> lerp (s * s * (3 - 2 * s)) b k+    Bezier _ k0 r0   -> case end of+      Bezier l1 k1 _ -> interpolateBezier s k0 r0 l1 k1+      _              -> interpolateBezier s k0 r0 r0 b+  where+    b = keyValue end++-- @interpolateBezier s k0 r0 l1 k1@ performs a Bezier interpolation+-- between keys 'k0' and 'k1' using their respectives right and left handles.+interpolateBezier :: (Additive a,Floating s)+                  => s+                  -> a s+                  -> a s+                  -> a s+                  -> a s+                  -> a s+interpolateBezier s k0 r0 l1 k1 = (u ^+^ v) ^* s+  where+    u = k0 ^+^ (r0 ^-^ k0) ^* s+    v = l1 ^+^ (k1 ^-^ l1) ^* s

@@ -1,105 +0,0 @@--------------------------------------------------------------------------------- |--- Copyright   : (C) 2015 Dimitri Sabadie--- License     : BSD3------ Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>--- Stability   : experimental--- Portability : portable----------------------------------------------------------------------------------module Data.Spline.Polynomial (-    -- * Polynomial-    Polynomial(unPolynomial)-    -- * Polynomials for interpolation-  , hold-  , linear-  , linearBy-  , cosine-  , cubicHermite-    -- * Helpers-  , bsearchLower-  ) where--import Control.Monad ( guard )-import Data.Spline.CP-import Data.Vector as V ( Vector, (!?), length )-import Linear ( Additive(lerp) )---- |A 'Polynomial' is used to interpolate in between a spline’s control points.-newtype Polynomial s a = Polynomial { unPolynomial :: s -> Vector (CP s a) -> Maybe a}---- |Constant polynomial – a.k.a. /no interpolation/.------ Given two control points and a sample value in between, the 'hold' polynomial--- won’t perform any interpolation but it just /holds/ the value carried by the--- lower control point along the whole curve between the two control points.-hold :: (Ord s) => Polynomial s a-hold = Polynomial go-  where-    go s cps = do-        li <- bsearchLower (\(CP s' _) -> compare s s') cps-        CP _ r <- cps !? li-        return r---- |Parametric linear polynomial.------ This form applies a pre-filter on the input before performing a linear--- interpolation. Instead of:------ @ lerp x a b @------ We have:------ @ lerp (pref x) a b @------ This can be used to implement 1-degree splines if @pref = id@, basic cubic--- non-hermitian splines if @pref = (^3)@, cosine splines if--- @pref = \x -> (1 - cos (x*pi)) * 0.5@, and so on and so forth.-linearBy :: (Additive a,Fractional s,Ord s) => (s -> s) -> Polynomial s (a s)-linearBy pref = Polynomial go-  where-    go s cps = do-        li <- bsearchLower (\(CP s' _) -> compare s s') cps-        lower <- cps !? li-        upper <- cps !? succ li-        return $ lerp_ s lower upper-    lerp_ x (CP s0 a) (CP s1 b) = lerp x' b a-      where-        x' = (pref x - s0) / (s1 - s0)---- |1-degree polynomial – a.k.a. /straight line interpolation/, or /linear--- interpolation/.------ This polynomial connects control points with straight lines.------ Note: implemented with @linearBy id@.-linear :: (Additive a,Fractional s,Ord s) => Polynomial s (a s)-linear = linearBy id---- |Cosine polynomial.-cosine :: (Additive a,Floating s,Ord s) => Polynomial s (a s)-cosine = linearBy $ \x -> (1 - cos (x * pi)) * 0.5---- |Cubic hermite interpolation.------ Implemented with https://en.wikipedia.org/wiki/Smoothstep.-cubicHermite :: (Additive a,Fractional s,Ord s) => Polynomial s (a s)-cubicHermite = linearBy $ \x -> x * x * (3 - 2 * x)---- |Helper binary search that search the ceiling index for the--- value to be searched according to the predicate.-bsearchLower :: (a -> Ordering) -> Vector a -> Maybe Int-bsearchLower p v = go 0 (pred $ V.length v)-  where-    go start end = do-        guard (start <= end)-        ma <- v !? m-        ma1 <- v !? succ m-        case p ma of-          LT -> go start (pred m)-          EQ -> Just m-          GT -> if p ma1 == LT then Just m else go (succ m) end-      where-        m = (end + start) `div` 2