31 |
31 |
32 fun int_of_term t = snd (HOLogic.dest_number t) handle TERM _ => raise TERM ("int_of_term", [t]); |
32 fun int_of_term t = snd (HOLogic.dest_number t) handle TERM _ => raise TERM ("int_of_term", [t]); |
33 |
33 |
34 fun real_of_man_exp m e = Real.fromManExp {man = Real.fromInt m, exp = e} |
34 fun real_of_man_exp m e = Real.fromManExp {man = Real.fromInt m, exp = e} |
35 |
35 |
36 fun mapprox_float (\<^term>\<open>Float\<close> $ m $ e) = real_of_man_exp (int_of_term m) (int_of_term e) |
36 fun mapprox_float \<^Const_>\<open>Float for m e\<close> = real_of_man_exp (int_of_term m) (int_of_term e) |
37 | mapprox_float t = Real.fromInt (snd (HOLogic.dest_number t)) |
37 | mapprox_float t = Real.fromInt (snd (HOLogic.dest_number t)) |
38 handle TERM _ => raise TERM ("mapprox_float", [t]); |
38 handle TERM _ => raise TERM ("mapprox_float", [t]); |
39 |
39 |
40 (* TODO: define using compiled terms? *) |
40 (* TODO: define using compiled terms? *) |
41 fun mapprox_floatarith (\<^term>\<open>Add\<close> $ a $ b) xs = mapprox_floatarith a xs + mapprox_floatarith b xs |
41 fun mapprox_floatarith \<^Const_>\<open>Add for a b\<close> xs = mapprox_floatarith a xs + mapprox_floatarith b xs |
42 | mapprox_floatarith (\<^term>\<open>Minus\<close> $ a) xs = ~ (mapprox_floatarith a xs) |
42 | mapprox_floatarith \<^Const_>\<open>Minus for a\<close> xs = ~ (mapprox_floatarith a xs) |
43 | mapprox_floatarith (\<^term>\<open>Mult\<close> $ a $ b) xs = mapprox_floatarith a xs * mapprox_floatarith b xs |
43 | mapprox_floatarith \<^Const_>\<open>Mult for a b\<close> xs = mapprox_floatarith a xs * mapprox_floatarith b xs |
44 | mapprox_floatarith (\<^term>\<open>Inverse\<close> $ a) xs = 1.0 / mapprox_floatarith a xs |
44 | mapprox_floatarith \<^Const_>\<open>Inverse for a\<close> xs = 1.0 / mapprox_floatarith a xs |
45 | mapprox_floatarith (\<^term>\<open>Cos\<close> $ a) xs = Math.cos (mapprox_floatarith a xs) |
45 | mapprox_floatarith \<^Const_>\<open>Cos for a\<close> xs = Math.cos (mapprox_floatarith a xs) |
46 | mapprox_floatarith (\<^term>\<open>Arctan\<close> $ a) xs = Math.atan (mapprox_floatarith a xs) |
46 | mapprox_floatarith \<^Const_>\<open>Arctan for a\<close> xs = Math.atan (mapprox_floatarith a xs) |
47 | mapprox_floatarith (\<^term>\<open>Abs\<close> $ a) xs = abs (mapprox_floatarith a xs) |
47 | mapprox_floatarith \<^Const_>\<open>Abs for a\<close> xs = abs (mapprox_floatarith a xs) |
48 | mapprox_floatarith (\<^term>\<open>Max\<close> $ a $ b) xs = |
48 | mapprox_floatarith \<^Const_>\<open>Max for a b\<close> xs = |
49 Real.max (mapprox_floatarith a xs, mapprox_floatarith b xs) |
49 Real.max (mapprox_floatarith a xs, mapprox_floatarith b xs) |
50 | mapprox_floatarith (\<^term>\<open>Min\<close> $ a $ b) xs = |
50 | mapprox_floatarith \<^Const_>\<open>Min for a b\<close> xs = |
51 Real.min (mapprox_floatarith a xs, mapprox_floatarith b xs) |
51 Real.min (mapprox_floatarith a xs, mapprox_floatarith b xs) |
52 | mapprox_floatarith \<^term>\<open>Pi\<close> _ = Math.pi |
52 | mapprox_floatarith \<^Const_>\<open>Pi\<close> _ = Math.pi |
53 | mapprox_floatarith (\<^term>\<open>Sqrt\<close> $ a) xs = Math.sqrt (mapprox_floatarith a xs) |
53 | mapprox_floatarith \<^Const_>\<open>Sqrt for a\<close> xs = Math.sqrt (mapprox_floatarith a xs) |
54 | mapprox_floatarith (\<^term>\<open>Exp\<close> $ a) xs = Math.exp (mapprox_floatarith a xs) |
54 | mapprox_floatarith \<^Const_>\<open>Exp for a\<close> xs = Math.exp (mapprox_floatarith a xs) |
55 | mapprox_floatarith (\<^term>\<open>Powr\<close> $ a $ b) xs = |
55 | mapprox_floatarith \<^Const_>\<open>Powr for a b\<close> xs = |
56 Math.pow (mapprox_floatarith a xs, mapprox_floatarith b xs) |
56 Math.pow (mapprox_floatarith a xs, mapprox_floatarith b xs) |
57 | mapprox_floatarith (\<^term>\<open>Ln\<close> $ a) xs = Math.ln (mapprox_floatarith a xs) |
57 | mapprox_floatarith \<^Const_>\<open>Ln for a\<close> xs = Math.ln (mapprox_floatarith a xs) |
58 | mapprox_floatarith (\<^term>\<open>Power\<close> $ a $ n) xs = |
58 | mapprox_floatarith \<^Const_>\<open>Power for a n\<close> xs = |
59 Math.pow (mapprox_floatarith a xs, Real.fromInt (nat_of_term n)) |
59 Math.pow (mapprox_floatarith a xs, Real.fromInt (nat_of_term n)) |
60 | mapprox_floatarith (\<^term>\<open>Floor\<close> $ a) xs = Real.fromInt (floor (mapprox_floatarith a xs)) |
60 | mapprox_floatarith \<^Const_>\<open>Floor for a\<close> xs = Real.fromInt (floor (mapprox_floatarith a xs)) |
61 | mapprox_floatarith (\<^term>\<open>Var\<close> $ n) xs = nth xs (nat_of_term n) |
61 | mapprox_floatarith \<^Const_>\<open>Var for n\<close> xs = nth xs (nat_of_term n) |
62 | mapprox_floatarith (\<^term>\<open>Num\<close> $ m) _ = mapprox_float m |
62 | mapprox_floatarith \<^Const_>\<open>Num for m\<close> _ = mapprox_float m |
63 | mapprox_floatarith t _ = raise TERM ("mapprox_floatarith", [t]) |
63 | mapprox_floatarith t _ = raise TERM ("mapprox_floatarith", [t]) |
64 |
64 |
65 fun mapprox_atLeastAtMost eps x a b xs = |
65 fun mapprox_atLeastAtMost eps x a b xs = |
66 let |
66 let |
67 val x' = mapprox_floatarith x xs |
67 val x' = mapprox_floatarith x xs |
68 in |
68 in |
69 mapprox_floatarith a xs + eps <= x' andalso x' + eps <= mapprox_floatarith b xs |
69 mapprox_floatarith a xs + eps <= x' andalso x' + eps <= mapprox_floatarith b xs |
70 end |
70 end |
71 |
71 |
72 fun mapprox_form eps (\<^term>\<open>Bound\<close> $ x $ a $ b $ f) xs = |
72 fun mapprox_form eps \<^Const_>\<open>Bound for x a b f\<close> xs = |
73 (not (mapprox_atLeastAtMost eps x a b xs)) orelse mapprox_form eps f xs |
73 (not (mapprox_atLeastAtMost eps x a b xs)) orelse mapprox_form eps f xs |
74 | mapprox_form eps (\<^term>\<open>Assign\<close> $ x $ a $ f) xs = |
74 | mapprox_form eps \<^Const_>\<open>Assign for x a f\<close> xs = |
75 (Real.!= (mapprox_floatarith x xs, mapprox_floatarith a xs)) orelse mapprox_form eps f xs |
75 (Real.!= (mapprox_floatarith x xs, mapprox_floatarith a xs)) orelse mapprox_form eps f xs |
76 | mapprox_form eps (\<^term>\<open>Less\<close> $ a $ b) xs = mapprox_floatarith a xs + eps < mapprox_floatarith b xs |
76 | mapprox_form eps \<^Const_>\<open>Less for a b\<close> xs = mapprox_floatarith a xs + eps < mapprox_floatarith b xs |
77 | mapprox_form eps (\<^term>\<open>LessEqual\<close> $ a $ b) xs = mapprox_floatarith a xs + eps <= mapprox_floatarith b xs |
77 | mapprox_form eps \<^Const_>\<open>LessEqual for a b\<close> xs = mapprox_floatarith a xs + eps <= mapprox_floatarith b xs |
78 | mapprox_form eps (\<^term>\<open>AtLeastAtMost\<close> $ x $ a $ b) xs = mapprox_atLeastAtMost eps x a b xs |
78 | mapprox_form eps \<^Const_>\<open>AtLeastAtMost for x a b\<close> xs = mapprox_atLeastAtMost eps x a b xs |
79 | mapprox_form eps (\<^term>\<open>Conj\<close> $ f $ g) xs = mapprox_form eps f xs andalso mapprox_form eps g xs |
79 | mapprox_form eps \<^Const_>\<open>Conj for f g\<close> xs = mapprox_form eps f xs andalso mapprox_form eps g xs |
80 | mapprox_form eps (\<^term>\<open>Disj\<close> $ f $ g) xs = mapprox_form eps f xs orelse mapprox_form eps g xs |
80 | mapprox_form eps \<^Const_>\<open>Disj for f g\<close> xs = mapprox_form eps f xs orelse mapprox_form eps g xs |
81 | mapprox_form _ t _ = raise TERM ("mapprox_form", [t]) |
81 | mapprox_form _ t _ = raise TERM ("mapprox_form", [t]) |
82 |
82 |
83 fun dest_interpret_form (\<^const>\<open>interpret_form\<close> $ b $ xs) = (b, xs) |
83 fun dest_interpret_form \<^Const_>\<open>interpret_form for b xs\<close> = (b, xs) |
84 | dest_interpret_form t = raise TERM ("dest_interpret_form", [t]) |
84 | dest_interpret_form t = raise TERM ("dest_interpret_form", [t]) |
85 |
|
86 fun optionT t = Type (\<^type_name>\<open>option\<close>, [t]) |
|
87 fun mk_Some t = Const (\<^const_name>\<open>Some\<close>, t --> optionT t) |
|
88 |
85 |
89 fun random_float_list size xs seed = |
86 fun random_float_list size xs seed = |
90 fold (K (apsnd (random_float size) #-> (fn c => apfst (fn b => b::c)))) xs ([],seed) |
87 fold (K (apsnd (random_float size) #-> (fn c => apfst (fn b => b::c)))) xs ([],seed) |
91 |
88 |
92 fun real_of_Float (@{code Float} (m, e)) = |
89 fun real_of_Float (@{code Float} (m, e)) = |