Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /branches/vis15/src/compiler/common/kernel.sml
ViewVC logotype

View of /branches/vis15/src/compiler/common/kernel.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4043 - (download) (annotate)
Sun Jun 26 14:00:38 2016 UTC (3 years, 2 months ago) by jhr
File size: 6773 byte(s)
  Working on merge: changed the way that we handle kernels in the AST and SimpleAST IRs (treat
  them like literals, instead of like variables).  Added code to rewrite Inside tests in Simple
  IR to use the image instead of the field, which fixes a problem with trying to do inside tests
  on Ein fields.  Added code to promote locals to globals as part of the simplify-vars phase.
(* kernel.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *)

structure Kernel : sig

    type t

    type coefficient = Rational.t

  (* polynomial represented as list of coefficients, where ith element is
   * coefficient for x^i.
   *)
    type polynomial = coefficient list

  (* kernel name *)
    val name : t -> string
    val toString : t -> string

  (* are two kernels the same *)
    val same : t * t -> bool

  (* hash value *)
    val hash : t -> word

  (* how many levels of differentiation does a kernel provide? *)
    val continuity : t -> int

  (* kernel support *)
    val support : t -> int

  (* representation of i'th derivative of the kernel *)
    val curve : t * int -> {
	    isCont : bool,
	    segs : polynomial list	(* piece-wise polynomial that defines *)
					(* the curve over the whole support *)
	  }

    val evaluate : polynomial * int -> Rational.t

  (* some standard kernels *)
    val tent : t		(* linear interpolation *)
    val ctmr : t		(* Catmull-Rom interpolation *)
    val bspln3 : t		(* cubic bspline reconstruction, doesn't interpolate *)
    val bspln5 : t		(* quintic bspline reconstruction, doesn't interpolate *)
    val c4hexic : t		(* C4 hexic kernel; doesn't interpolate *)

  end = struct

    structure R = Rational
    structure A = Array

    val maxDiffLevels = 15		(* support upto 15 levels of differentiation *)

    type coefficient = R.t

    val zero = R.zero
    val one = R.fromInt 1

  (* polynomial represented as list of coefficients, where ith element is
   * coefficient for x^i.
   *)
    type polynomial = coefficient list

    fun differentiate [] = raise Fail "invalid polynomial"
      | differentiate [_] = [zero]
      | differentiate (_::coeffs) = let
	  fun lp (_, []) = []
	    | lp (i, c::r) = R.*(R.fromInt i, c) :: lp(i+1, r)
	  in
	    lp (1, coeffs)
	  end

  (* evaluate a polynomial at an integer coordinate (used to test continuity) *)
    fun evaluate (poly, x) = let
	  val x = R.fromInt x
	  fun eval (sum, [], xn) = sum
	    | eval (sum, c::r, xn) = eval(R.+(sum, R.*(c, xn)), r, R.*(x, xn))
	  in
	    eval (zero, poly, one)
	  end

    type curve = {
	isCont : bool,
	segs : polynomial list	(* piece-wise polynomial that defines *)
				(* the curve over the whole support *)
      }

    datatype t = K of {
	name : string,
	id : Stamp.stamp,	(* unique ID *)
	support : int,		(* number of samples to left/right *)
	continuity : int,	(* number of levels of continuity *)
	curves : curve option array (* cache of curves indexed by differentiation level *)
      }

  (* determine if a list of polynomials represents a continuous piece-wise polynomial *)
    fun isContinuous polys = let
	  val s = List.length polys div 2
	  fun chk (i, y_i, []) = R.isZero y_i
	    | chk (i, y_i, f_i::r) = let
		val y = evaluate(f_i, i)
		in
		  R.same(y_i, y) andalso chk(i+1, evaluate(f_i, i+1), r)
		end
	  in
	    chk (~s, R.zero, polys)
	  end

  (* kernel name *)
    fun name (K{name, ...}) = name
    val toString = name

  (* kernel support *)
    fun support (K{support, ...}) = support

  (* how many levels of differentiation does a kernel provide? *)
    fun continuity (K{continuity, ...}) = continuity

    fun hash (K{id, ...}) = Stamp.hash id
    fun same (K{id=a, ...}, K{id=b, ...}) = Stamp.same (a, b)

  (* representation of i'th derivative of the kernel *)
    fun curve (K{curves, ...}, k) = (case A.sub(curves, k)
	   of SOME curve => curve
	    | NONE => let
	      (* compute the (k+1)'th derivative, given the k'th *)
		fun diff (k, {isCont, segs}) = let
		      val segs' = List.map differentiate segs
		      val isCont' = isCont andalso isContinuous segs'
		      in {
			isCont = isCont',
			segs = segs'
		      } end
		fun lp (j, curve) = if (j < k)
		      then (case A.sub(curves, j+1)
			 of NONE => let
			      val curve' = diff(j+1, curve)
			      in
				A.update(curves, j+1, SOME curve');
				lp (j+1, curve')
			      end
			  | SOME curve' => lp(j+1, curve')
			(* end case *))
		      else curve
		in
		  lp (0, valOf(A.sub(curves, 0)))
		end
	  (* end case *))

  (* some standard kernels *)
    local
      val op / = R./
      fun r i = R.fromInt i
(* FIXME: we should really get the continuity info from the kernels themselves *)
      fun mkKernel {name, support, continuity, segs} = let
	    val curves = Array.array(maxDiffLevels+1, NONE)
	    val curve0 = {
		    isCont = isContinuous segs,
		    segs = segs
		  }
	    in
	      A.update (curves, 0, SOME curve0);
	      K{name=name, id=Stamp.new(), support=support, continuity=continuity, curves=curves}
	    end
    in
    val tent = mkKernel{		(* linear interpolation *)
	    name = "tent",
	    support = 1,
	    continuity = 0,
	    segs = [
		[r 1, r 1],		(* -1 .. 0 *)
		[r 1, r ~1]		(*  0 .. 1 *)
	      ]
	  }
    val ctmr = mkKernel{		(* Catmull-Rom interpolation *)
	    name = "ctmr",
	    support = 2,
	    continuity = 1,
	    segs = [
		[r 2, r 4,  5/2,  1/2],	(* -2 .. -1 *)
		[r 1, r 0, ~5/2, ~3/2],	(* -1 .. 0 *)
		[r 1, r 0, ~5/2,  3/2],	(*  0 .. 1 *)
		[r 2, r ~4, 5/2, ~1/2]	(*  1 .. 2 *)
	      ]
	  }
    val bspln3 = mkKernel{		(* cubic bspline reconstruction; doesn't interpolate *)
	    name = "bspln3",
	    support = 2,
	    continuity = 2,
	    segs = [
		[ 4/3, r 2,  r 1,   1/6 ],	(* -2 .. -1 *)
		[ 2/3, r 0,  r ~1, ~1/2 ],	(* -1 .. 0 *)
		[ 2/3, r 0,  r ~1,  1/2 ],	(*  0 .. 1 *)
		[ 4/3, r ~2, r 1,  ~1/6 ]	(*  1 .. 2 *)
	      ]
	  }
    val bspln5 = mkKernel{		(* quintic bspline reconstruction; doesn't interpolate *)
	    name = "bspln5",
	    support = 3,
	    continuity = 4,
	    segs = [
		[ 81/40, 27/8, 9/4,  3/4,  1/8, 1/120 ],	(* -3 .. -2 *)
		[ 17/40, ~5/8, ~7/4, ~5/4, ~3/8, ~1/24 ],	(* -2 .. -1 *)
		[ 11/20, r 0,  ~1/2, r 0,  1/4, 1/12 ],		(* -1 .. 0 *)
		[ 11/20, r 0,  ~1/2, r 0,  1/4, ~1/12 ],	(*  0 .. 1 *)
		[ 17/40, 5/8,  ~7/4, 5/4, ~3/8, 1/24 ],		(*  1 .. 2 *)
		[ 81/40, ~27/8, 9/4, ~3/4, 1/8, ~1/120 ]	(*  2 .. 3 *)
	      ]
	  }
    val c4hexic = mkKernel{		(* C4 hexic kernel; doesn't interpolate *)
            name = "c4hexic",
            support = 3,
	    continuity = 4,
            segs = [
		[ 1539/160, 189/8,  747/32,  r 12,  109/32,  61/120,  1/32 ],	(* -3 .. -2 *)
		[ 3/160,    ~35/8,  ~341/32, r ~10, ~147/32, ~25/24,  ~3/32 ],	(* -2 .. -1 *)
		[ 69/80,    r 0,    ~23/16,  r 0,   19/16,   7/12,    1/16 ],	(* -1 .. 0 *)
		[ 69/80,    r 0,    ~23/16,  r 0,   19/16,   ~7/12,   1/16 ],	(*  0 .. 1 *)
		[ 3/160,    35/8,   ~341/32, r 10,  ~147/32, 25/24,   ~3/32 ],	(*  1 .. 2 *)
		[ 1539/160, ~189/8, 747/32,  r ~12, 109/32,  ~61/120, 1/32 ]	(*  2 .. 3 *)
              ]
	  }
    end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0