Annotation of /trunk/src/compiler/IL/test-kernel.sml

Parent Directory | Revision Log

---

Revision 155 - (view) (download)

1 :	jhr	140	(* test-kenel.sml
2 :			*
3 :			* COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :			* All rights reserved.
5 :			*
6 :			* Text driver for the kernel code.
7 :			*)
8 :
9 :			structure Test =
10 :			struct
11 :
12 :			structure R = Rational
13 :			structure K = Kernel
14 :
15 :	jhr	153	fun eval ({isOdd, isCont, segs}, x) = let
16 :			fun eval' x = let
17 :			val {whole, frac} = Real.split x
18 :			val i = Real.trunc whole
19 :			fun evalPoly [] = 0.0
20 :			| evalPoly (c::r) = R.toReal c + x * evalPoly r
21 :			in
22 :			evalPoly (List.nth(segs, i)) handle _ => 0.0
23 :			end
24 :	jhr	140	in
25 :	jhr	153	if (x >= 0.0) then eval' x
26 :			else if isOdd then ~(eval' (~x))
27 :			else eval' (~x)
28 :	jhr	140	end
29 :
30 :	jhr	153
31 :			local
32 :			(* Path to Ploticus command *)
33 :			val plPath = "/usr/local/bin/pl"
34 :			val env = [
35 :			"PLOTICUS_PREFABS=/usr/local/src/ploticus/prefabs"
36 :			];
37 :			in
38 :			fun ploticus args outFn = let
39 :			val proc = Unix.executeInEnv (plPath, args, env)
40 :			val outS = Unix.textOutstreamOf proc
41 :			in
42 :			outFn outS;
43 :			TextIO.closeOut outS;
44 :			Unix.reap proc
45 :			end
46 :
47 :			fun output mergedData outS = let
48 :			fun plotRow (x, l) = (
49 :			TextIO.output(outS, Format.format "%f" [Format.REAL x]);
50 :			List.app (fn t => TextIO.output(outS, Format.format " %f" [Format.REAL t])) l;
51 :			TextIO.output(outS, "\n"))
52 :			in
53 :			List.app plotRow mergedData
54 :			end
55 :
56 :			(* command-line arguments for ploticus *)
57 :			fun args (file, name) = [
58 :			"-prefab", "lines",
59 :			"-eps",
60 :			"-o", file,
61 :			"-font", "/Times-Roman",
62 :			"-textsize", "12",
63 :			"data=-",
64 :			"rectangle= 0 1.0 5.5 5.5",
65 :			"legend= max-1 max",
66 :			"x=1",
67 :			"xlbl=X",
68 :			"xnearest=1",
69 :			"y=2",
70 :			"y2=3",
71 :			"y3=4",
72 :			"y4=5",
73 :			"ylbl=Y",
74 :			"ynearest=1",
75 :			"pointsym=none",
76 :			"pointsym2=none",
77 :			"pointsym3=none",
78 :			"pointsym4=none",
79 :			"name= D0",
80 :			"name2= D1",
81 :			"name3= D2",
82 :			"name4= D3",
83 :			"title= "^name
84 :			];
85 :
86 :			end;
87 :
88 :			(* given a kernel, kernel and its derivatives *)
89 :			fun plotKernel kern = let
90 :			val s = Kernel.support kern
91 :			val curve0 = Kernel.curve(kern, 0)
92 :			val curve1 = Kernel.curve(kern, 1)
93 :			val curve2 = Kernel.curve(kern, 2)
94 :			val curve3 = Kernel.curve(kern, 3)
95 :			val maxX = Real.fromInt s
96 :			val step = 1.0 / 64.0
97 :			fun lp (x, rows) = if (x <= maxX)
98 :			then let
99 :			val rows = (x, [eval(curve0, x), eval(curve1, x), eval(curve2, x), eval(curve3, x)]) :: rows
100 :			in
101 :			lp (x+step, rows)
102 :			end
103 :			else List.rev rows
104 :			val rows = lp (~maxX, [])
105 :			val name = K.name kern
106 :			in
107 :			ploticus (args (name ^ ".eps", name)) (output rows);
108 :			OS.Process.system (concat["/usr/bin/open ", name, ".eps"])
109 :			end
110 :
111 :	jhr	155	fun polyToString poly = let
112 :			fun c2s c = Format.format "%g" [Format.REAL(R.toReal c)]
113 :			fun toS ([c], l) = c2s c :: l
114 :			| toS (c::r, l) = c2s c :: " + x*(" :: toS(r, ")"::l)
115 :			in
116 :			String.concat (toS (poly, []))
117 :			end
118 :
119 :			fun printKernel (kern, k) = let
120 :			val {isCont, isOdd, segs} = K.curve(kern, k)
121 :			val name = if (k > 0)
122 :			then concat(K.name kern::List.tabulate(k, fn _ => "'"))
123 :			else K.name kern
124 :			fun lp (_, []) = ()
125 :			| lp (i, poly::rest) = (
126 :			print(concat[
127 :			" ", name, "(x) = ", polyToString poly, " for ",
128 :			Int.toString i, " <= x < ", Int.toString(i+1), "\n"
129 :			]);
130 :			lp (i+1, rest))
131 :			in
132 :			print(name ^ ":\n");
133 :			lp (0, segs);
134 :			if (isOdd)
135 :			then print(concat[" ", name, "(x) = -", name, "(-x) for x < 0\n"])
136 :			else print(concat[" ", name, "(x) = ", name, "(-x) for x < 0\n"])
137 :			end
138 :
139 :	jhr	140	end

---

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