external/clem/src/interpolation.lisp

   1 ;;;
   2 ;;; File: interpolation.cl
   3 ;;; Description: interpolation for the clem matrix package
   4 ;;; Author: Cyrus Harmon
   5 ;;;
   6
   7 (in-package :clem)
   8
   9
  10 (defmacro bilinear-interpolate
  11     (g00 g01 g10 g11 a b)
  12   (ch-util::once-only (g00 g01 g10 g11 a b)
  13     `(+ ,g00
  14         (* ,a (- ,g10 ,g00))
  15         (* ,b (- ,g01 ,g00))
  16         (* ,a ,b (- (+ ,g00 ,g11)
  17                     (+ ,g10 ,g01))))))
  18
  19 (defmacro quadratic-kernel (s type)
  20   (let ((minus-half (coerce -0.5 `,type))
  21         (half (coerce 0.5 `,type))
  22         (minus-one-point-five  (coerce -1.5 `,type))
  23         (one-point-five (coerce 1.5 `,type))
  24         (five (coerce 5 `,type))
  25         (minus-two (coerce -2 `,type))
  26         (two (coerce 2 `,type))
  27         (one (coerce 1 `,type))
  28         (zero (coerce 0 `,type)))
  29     `(cond ((<= ,minus-half ,s ,half)
  30             (+ (* ,minus-two (* ,s ,s)) ,one))
  31            ((<= ,minus-one-point-five ,s ,one-point-five)
  32             (+ (* ,s ,s) (- (/ (* ,five (abs ,s)) ,two)) ,one-point-five))
  33            (t ,zero))))
  34
  35 (defmacro quadratic-interpolate
  36     (g00 g01 g02
  37      g10 g11 g12
  38      g20 g21 g22 a b
  39      type)
  40   `(let ((a0 (quadratic-kernel (- -1, a) ,type))
  41          (a1 (quadratic-kernel (- ,a) ,type))
  42          (a2 (quadratic-kernel (- 1 ,a) ,type))
  43          (b0 (quadratic-kernel (- -1 ,b) ,type))
  44          (b1 (quadratic-kernel (- ,b) ,type))
  45          (b2 (quadratic-kernel (- 1 ,b) ,type)))
  46      (+ (* a0 (+ (* b0 ,g00)
  47                  (* b1 ,g01)
  48                  (* b2 ,g02)))
  49         (* a1 (+ (* b0 ,g10)
  50                  (* b1 ,g11)
  51                  (* b2 ,g12)))
  52         (* a2 (+ (* b0 ,g20)
  53                  (* b1 ,g21)
  54                  (* b2 ,g22))))))
  55