Diff of /trunk/src/compiler/IL/kernel.sml

Parent Directory | Revision Log | Patch

	revision 138, Thu Jul 8 18:47:33 2010 UTC	revision 139, Thu Jul 8 18:48:23 2010 UTC
#	Line 15	Line 15
15	*)	*)
16	type polynomial = coefficient list	type polynomial = coefficient list
17
18	type kernel = {	type kernel
19	name : string,
20	support : int,          (* number of samples to left/right *)	(* kernel name *)
21	segs : polynomial list  (* piece-wise polynomial that defines the kernel.  Since *)	val name : kernel -> string
	(* a kernel is symmetric, we only store the positive *)
	(* segments, with segs[i] covering the domain [i,i+1) *)
	}
22
23	val differentiate : polynomial -> polynomial	(* kernel support *)
24		val support : kernel -> int
25
26		(* representation of i'th derivative of the kernel *)
27		val curve : kernel * int -> {
28		isOdd : bool,
29		isCont : bool,
30		segs : polynomial list      (* piece-wise polynomial that defines *)
31		(* the curve over the positive support *)
32		}
33
34	val evaluate : polynomial * int -> Rational.rat	val evaluate : polynomial * int -> Rational.rat
35
36	end = struct	end = struct
37
38	structure R = Rational	structure R = Rational
39		structure A = Array
40
41		val maxDiffLevels = 15              (* support upto 15 levels of differentiation *)
42
43	type coefficient = R.rat	type coefficient = R.rat
44
#	Line 41	Line 50
50	*)	*)
51	type polynomial = coefficient list	type polynomial = coefficient list
52
	type kernel = {
	name : string,
	support : int,          (* number of samples to left/right *)
	segs : polynomial list  (* piece-wise polynomial that defines the *)
	(* kernel; there are 2*support segments *)
	}
53	fun differentiate [] = raise Fail "invalid polynomial"	fun differentiate [] = raise Fail "invalid polynomial"
54	| differentiate [_] = [zero]	| differentiate [_] = [zero]
55	| differentiate (_::coeffs) = let	| differentiate (_::coeffs) = let
56	fun lp (_, []) = []	fun lp (_, []) = []
57	| lp (i, c::r) = R.mul(R.fromInt i, c) :: lp(i+1, r)	| lp (i, c::r) = R.*(R.fromInt i, c) :: lp(i+1, r)
58	in	in
59	lp (1, coeffs)	lp (1, coeffs)
60	end	end
61
62	(* evaluate a polynomial at an integer coordinate (used to test continuity) *)	(* evaluate a polynomial at an integer coordinate (used to test continuity) *)
63	fun evaluate (poly, x) = let	fun evaluate (poly, x) = let
64	val x = F.fromInt x	val x = R.fromInt x
65	fun eval (sum, [], xn) = sum	fun eval (sum, [], xn) = sum
66	| eval (sum, c::r, xn) = eval(R.add(sum, R.mul(c, xn)), r, R.mul(x, xn))	| eval (sum, c::r, xn) = eval(R.+(sum, R.*(c, xn)), r, R.*(x, xn))
67	in	in
68	eval (zero, poly, one)	eval (zero, poly, one)
69	end	end
70
71		type curve = {
72		isOdd : bool,
73		isCont : bool,
74		segs : polynomial list  (* piece-wise polynomial that defines *)
75		(* the curve over the positive support *)
76		}
77
78		datatype kernel = K of {
79		name : string,
80		support : int,          (* number of samples to left/right *)
81		curves : curve option array (* cache of curves indexed by differentiation level *)
82		}
83
84		(* determine if a list of polynomials represents a continuous piece-wise polynomial *)
85		fun isContinuous polys = let
86		fun chk (i, f_i, []) = (R.zero = evaluate(f_i, i))
87		| chk (i, f_i, f_i1::r) = let
88		val y_i = evaluate(f_i, i)
89		val y_i1 = evaluate(f_i1, i)
90		in
91		if (y_i = y_i1)
92		then chk(i+1, f_i1, r)
93		else false
94		end
95		in
96		case polys of (f0::r) => chk (0, f0, r) | _ => true
97		end
98
99		(* kernel name *)
100		fun name (K{name, ...}) = name
101
102		(* kernel support *)
103		fun support (K{support, ...}) = support
104
105		(* representation of i'th derivative of the kernel *)
106		fun curve (K{curves, ...}, k) = (case A.sub(curves, k)
107		of SOME curve => curve
108		| NONE => let
109		(* compute the (k+1)'th derivative, given the k'th *)
110		fun diff (k, {isOdd, isCont, segs}) = let
111		val segs' = List.map differentiate segs
112		val isOdd = not isOdd
113		in {
114		isOdd = not isOdd,
115		isCont = isContinuous segs',
116		segs = segs'
117		} end
118		fun lp (j, curve) = if (j < k)
119		then (case A.sub(curves, j+1)
120		of NONE => let
121		val curve' = diff(j+1, curve)
122		in
123		A.update(curves, j+1, SOME curve');
124		lp (j+1, curve')
125		end
126		| SOME curve' => lp(j+1, curve')
127		(* end case *))
128		else curve
129		in
130		lp (0, valOf(A.sub(curves, 0)))
131		end
132		(* end case *))
133
134	(* some standard kernels *)	(* some standard kernels *)
135	local	local
136	val op / = R./	val op / = R./
137	fun r i = R.fromInt i	fun r i = R.fromInt i
138		fun mkKernel {name, support, segs} = let
139		val curves = Array.array(maxDiffLevels+1, NONE)
140		val curve0 = {
141		isOdd = false,
142		isCont = isContinuous segs,
143		segs = segs
144		}
145		in
146		A.update (curves, 0, SOME curve0);
147		K{name=name, support=support, curves=curves}
148		end
149	in	in
150	val tent : kernel = {       (* linear interpolation *)	val tent : kernel = mkKernel{       (* linear interpolation *)
151	name = "tent",	name = "tent",
152	support = 1,	support = 1,
153	segs = [[r 1, r ~1]]	segs = [[r 1, r ~1]]
154	}	}
155	val ctmr : kernel = {       (* Catmull-Rom interpolation *)	val ctmr : kernel = mkKernel{       (* Catmull-Rom interpolation *)
156	name = "ctmr",	name = "ctmr",
157	support = 2,	support = 2,
158	segs = [	segs = [
#	Line 84	Line 160
160	[r 2, r ~4, 5/2, ~1/2]	[r 2, r ~4, 5/2, ~1/2]
161	]	]
162	}	}
163	val bspl3 : kernel = {      (* cubic bspline reconstruction, doesn't interpolate *)	val bspl3 : kernel = mkKernel{      (* cubic bspline reconstruction, doesn't interpolate *)
164	name = "bspl3",	name = "bspl3",
165	support = 2,	support = 2,
166	segs = [	segs = [
#	Line 92	Line 168
168	[ 4/3, r ~2, r 1, ~1/6 ]	[ 4/3, r ~2, r 1, ~1/6 ]
169	]	]
170	}	}
171	val bspl5 : kernel = {      (* quintic bspline reconstruction, doesn't interpolate *)	val bspl5 : kernel = mkKernel{      (* quintic bspline reconstruction, doesn't interpolate *)
172	name = "bspl5",	name = "bspl5",
173	support = 3,	support = 3,
174	segs = [	segs = [

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.138   changed lines   Added in v.139

---

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