]> gerrit.simantics Code Review - simantics/platform.git/blobdiff - bundles/org.simantics.scl.runtime/scl/Interpolation.scl
Fixed multiple issues causing dangling references to discarded queries
[simantics/platform.git] / bundles / org.simantics.scl.runtime / scl / Interpolation.scl
index 7840c7cb9470bc16733c1267a23eb7b7f7362723..add8157554347f40dbdb7bdca83ce546139f48dc 100644 (file)
@@ -1,50 +1,50 @@
-import "Prelude"\r
-include "Vector"\r
-\r
-\r
-@private\r
-@inline\r
-chooseInterval :: Vector Double -> Double -> (<e> a) -> (Integer -> <e> a) -> (<e> a) -> <e> a\r
-chooseInterval table x down inRange up\r
-    | x < table!0        = down\r
-    | x >= table!(len-1) = up\r
-    | otherwise          = search 0 (len-1)\r
-  where\r
-    len = length table\r
-    search low high | high <= low+1 = inRange low\r
-                    | otherwise = do\r
-       middle = (low + high) `div` 2\r
-       if x < table!middle\r
-       then search low middle\r
-       else search middle high\r
-\r
-\r
-interpolateNearest :: Vector Double -> Vector Double -> Double -> Double\r
-interpolateNearest xs ys x = chooseInterval xs x\r
-    (ys!0)\r
-    (\i -> if x - xs!i < xs!(i+1) - x then ys!i else ys!(i+1))\r
-    (ys!(length xs-1))\r
-    \r
-interpolateLinear :: Vector Double -> Vector Double -> Double -> Double\r
-interpolateLinear xs ys x = chooseInterval xs x\r
-    (ys!0)\r
-    (\i -> lin (xs!i) (xs!(i+1)) (ys!i) (ys!(i+1)))\r
-    (ys!(length ys-1))\r
-  where\r
-    lin x0 x1 y0 y1 = y0 + (y1-y0) * (x-x0) / (x1-x0)\r
-\r
-interpolateCubic :: Vector Double -> Vector Double -> Double -> Double\r
-interpolateCubic xs ys x = chooseInterval xs x\r
-    (ys!0)\r
-    (\i -> let a = max 0 (i-1) ; b = min (i+2) (length xs-1) in\r
-        cubic (xs!a) (xs!i) (xs!(i+1)) (xs!b)\r
-              (ys!a) (ys!i) (ys!(i+1)) (ys!b))\r
-    (ys!(length ys-1))\r
-  where\r
-    cubic x0 x1 x2 x3 y0 y1 y2 y3 = let\r
-        l = x2-x1\r
-        dx1 = (y2-y0) * l / (x2-x0) \r
-        dx2 = (y3-y1) * l / (x3-x1)\r
-        t = (x-x1) / l\r
-      in \r
-        y1 + t * (dx1 + t * ((-3*y1 + 3*y2 - 2*dx1 - dx2) + t * (2*y1 - 2*y2 + dx1 + dx2)))\r
+import "Prelude"
+include "Vector"
+
+
+@private
+@inline
+chooseInterval :: Vector Double -> Double -> (<e> a) -> (Integer -> <e> a) -> (<e> a) -> <e> a
+chooseInterval table x down inRange up
+    | x < table!0        = down
+    | x >= table!(len-1) = up
+    | otherwise          = search 0 (len-1)
+  where
+    len = length table
+    search low high | high <= low+1 = inRange low
+                    | otherwise = do
+       middle = (low + high) `div` 2
+       if x < table!middle
+       then search low middle
+       else search middle high
+
+
+interpolateNearest :: Vector Double -> Vector Double -> Double -> Double
+interpolateNearest xs ys x = chooseInterval xs x
+    (ys!0)
+    (\i -> if x - xs!i < xs!(i+1) - x then ys!i else ys!(i+1))
+    (ys!(length xs-1))
+    
+interpolateLinear :: Vector Double -> Vector Double -> Double -> Double
+interpolateLinear xs ys x = chooseInterval xs x
+    (ys!0)
+    (\i -> lin (xs!i) (xs!(i+1)) (ys!i) (ys!(i+1)))
+    (ys!(length ys-1))
+  where
+    lin x0 x1 y0 y1 = y0 + (y1-y0) * (x-x0) / (x1-x0)
+
+interpolateCubic :: Vector Double -> Vector Double -> Double -> Double
+interpolateCubic xs ys x = chooseInterval xs x
+    (ys!0)
+    (\i -> let a = max 0 (i-1) ; b = min (i+2) (length xs-1) in
+        cubic (xs!a) (xs!i) (xs!(i+1)) (xs!b)
+              (ys!a) (ys!i) (ys!(i+1)) (ys!b))
+    (ys!(length ys-1))
+  where
+    cubic x0 x1 x2 x3 y0 y1 y2 y3 = let
+        l = x2-x1
+        dx1 = (y2-y0) * l / (x2-x0) 
+        dx2 = (y3-y1) * l / (x3-x1)
+        t = (x-x1) / l
+      in 
+        y1 + t * (dx1 + t * ((-3*y1 + 3*y2 - 2*dx1 - dx2) + t * (2*y1 - 2*y2 + dx1 + dx2)))