bundles/org.simantics.scl.runtime/scl/Interpolation.scl

   1 import "Prelude"\r
   2 include "Vector"\r
   3 \r
   4 \r
   5 @private\r
   6 @inline\r
   7 chooseInterval :: Vector Double -> Double -> (<e> a) -> (Integer -> <e> a) -> (<e> a) -> <e> a\r
   8 chooseInterval table x down inRange up\r
   9     | x < table!0        = down\r
  10     | x >= table!(len-1) = up\r
  11     | otherwise          = search 0 (len-1)\r
  12   where\r
  13     len = length table\r
  14     search low high | high <= low+1 = inRange low\r
  15                     | otherwise = do\r
  16        middle = (low + high) `div` 2\r
  17        if x < table!middle\r
  18        then search low middle\r
  19        else search middle high\r
  20 \r
  21 \r
  22 interpolateNearest :: Vector Double -> Vector Double -> Double -> Double\r
  23 interpolateNearest xs ys x = chooseInterval xs x\r
  24     (ys!0)\r
  25     (\i -> if x - xs!i < xs!(i+1) - x then ys!i else ys!(i+1))\r
  26     (ys!(length xs-1))\r
  27     \r
  28 interpolateLinear :: Vector Double -> Vector Double -> Double -> Double\r
  29 interpolateLinear xs ys x = chooseInterval xs x\r
  30     (ys!0)\r
  31     (\i -> lin (xs!i) (xs!(i+1)) (ys!i) (ys!(i+1)))\r
  32     (ys!(length ys-1))\r
  33   where\r
  34     lin x0 x1 y0 y1 = y0 + (y1-y0) * (x-x0) / (x1-x0)\r
  35 \r
  36 interpolateCubic :: Vector Double -> Vector Double -> Double -> Double\r
  37 interpolateCubic xs ys x = chooseInterval xs x\r
  38     (ys!0)\r
  39     (\i -> let a = max 0 (i-1) ; b = min (i+2) (length xs-1) in\r
  40         cubic (xs!a) (xs!i) (xs!(i+1)) (xs!b)\r
  41               (ys!a) (ys!i) (ys!(i+1)) (ys!b))\r
  42     (ys!(length ys-1))\r
  43   where\r
  44     cubic x0 x1 x2 x3 y0 y1 y2 y3 = let\r
  45         l = x2-x1\r
  46         dx1 = (y2-y0) * l / (x2-x0) \r
  47         dx2 = (y3-y1) * l / (x3-x1)\r
  48         t = (x-x1) / l\r
  49       in \r
  50         y1 + t * (dx1 + t * ((-3*y1 + 3*y2 - 2*dx1 - dx2) + t * (2*y1 - 2*y2 + dx1 + dx2)))\r