From 163a82655b1b3649c9bff4db05f487db3a992a40 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 8 Nov 2017 17:01:04 +0100 Subject: Update functions --- dataType.ml | 34 ++++++++++++++++++++++++++-------- evaluator.ml | 4 +++- expression.ml | 2 +- scTypes.ml | 21 ++++++++++++++++++++- scTypes.mli | 2 ++ tests/dataType_test.ml | 22 +++++++++++++++++++--- 6 files changed, 71 insertions(+), 14 deletions(-) diff --git a/dataType.ml b/dataType.ml index b6c4fd0..8e5ead0 100755 --- a/dataType.ml +++ b/dataType.ml @@ -33,7 +33,10 @@ module Num = struct let mult = Q.mul - let floor f = Q.of_bigint (Q.to_bigint f) + let floor t = + let num = Q.num t + and den = Q.den t in + Q.of_bigint @@ Z.fdiv num den let ge = Q.geq @@ -41,12 +44,29 @@ module Num = struct let le = Q.leq - let pow t q_factor = - let factor = Q.to_int q_factor - and num = Q.num t - and den = Q.num t in + let is_integer t = (Q.den t) == Z.one + + let pow t q_factor = begin + + if is_integer q_factor then + + let factor = Q.to_int q_factor + and num = Q.num t + and den = Q.den t in + + Q.make (Z.pow num factor) (Z.pow den factor) - Q.make (Z.pow num factor) (Z.pow den factor) + else + + let factor = Q.to_float q_factor + and num = Z.to_float @@ Q.num t + and den = Z.to_float @@ Q.den t in + + Q.div + (Q.of_float (num ** factor)) + (Q.of_float (den ** factor)) + + end let gcd t1 t2 = Q.of_bigint @@ Z.gcd (Q.to_bigint t1) (Q.to_bigint t2) @@ -54,8 +74,6 @@ module Num = struct let lcm t1 t2 = Q.of_bigint @@ Z.lcm (Q.to_bigint t1) (Q.to_bigint t2) - let is_integer t = (Q.den t) == Z.one - end module Bool = struct diff --git a/evaluator.ml b/evaluator.ml index 64d260e..0681183 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -330,11 +330,13 @@ let () = begin fold "sum" t_int f_number D.Num.add (D.Num.zero); fold "product" t_int f_number D.Num.mult (D.Num.one); + register2 "^" (t_int, t_int) f_number D.Num.pow; + register2 "power" (t_int, t_int) f_number D.Num.pow; + register2 "gcd"(t_int, t_int) f_number D.Num.gcd; register2 "lcm"(t_int, t_int) f_number D.Num.lcm; register1 "+" t_int f_num (fun x -> x); register1 "-" t_int f_num D.Num.neg; (* Unary negation *) - register2 "^" (t_int, t_int) f_number D.Num.pow; register2 "+" (t_int, t_int) f_num D.Num.add; register2 "-" (t_int, t_int) f_num D.Num.sub; register2 "*" (t_int, t_int) f_number D.Num.mult; diff --git a/expression.ml b/expression.ml index fd697a9..20227ad 100755 --- a/expression.ml +++ b/expression.ml @@ -91,7 +91,7 @@ let show e = | Formula (Expression f) -> UTF8.Buffer.add_char buffer '='; ScTypes.show_expr buffer f - | Basic b -> ScTypes.Type.show buffer b + | Basic b -> ScTypes.Type.show_full buffer b | Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s | Undefined -> () end; diff --git a/scTypes.ml b/scTypes.ml index 075f25d..48e4d3c 100755 --- a/scTypes.ml +++ b/scTypes.ml @@ -127,7 +127,7 @@ module Type = struct show_list printer buffer tl end - and show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function + let show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function | Str x -> UTF8.Buffer.add_string buffer x | Bool b -> UTF8.Printf.bprintf buffer "%B" b | Num (Number, n) -> @@ -146,6 +146,25 @@ module Type = struct UTF8.Printf.bprintf buffer "%d/%d/%d" y m d end + let show_full: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function + | Str x -> UTF8.Buffer.add_string buffer x + | Bool b -> UTF8.Printf.bprintf buffer "%B" b + | Num (Number, n) -> + if DataType.Num.is_integer n then + DataType.Num.to_int n + |> string_of_int + |> UTF8.from_utf8string + |> UTF8.Buffer.add_string buffer + else + let f = DataType.Num.to_float n + and to_b = UTF8.Format.formatter_of_buffer buffer in + ignore @@ UTF8.Format.fprintf to_b "%f" f; + Format.pp_print_flush to_b () + | Num (Date, n) -> + let y, m, d = DataType.Date.date_from_julian_day n in + UTF8.Printf.bprintf buffer "%d/%d/%d" y m d + end + type t = | Value: 'a dataFormat * 'a -> t diff --git a/scTypes.mli b/scTypes.mli index d147d92..348f4fe 100755 --- a/scTypes.mli +++ b/scTypes.mli @@ -81,6 +81,8 @@ module Type : sig val show: UTF8.Buffer.buffer -> 'a types -> unit + val show_full: UTF8.Buffer.buffer -> 'a types -> unit + end module Refs : sig diff --git a/tests/dataType_test.ml b/tests/dataType_test.ml index ddb45ae..f015e89 100755 --- a/tests/dataType_test.ml +++ b/tests/dataType_test.ml @@ -22,12 +22,28 @@ let test_num_sub n1 n2 result ctx = begin (N.to_int @@ N.sub n1 n2) end +let test_floor n1 expected ctx = begin + + let result = N.to_int @@ N.floor n1 in + + assert_equal + ~msg:(Printf.sprintf "Expected %d but got %d" expected result) + ~cmp:(=) + expected + result + +end + + + let n1 = N.of_int 1 let n2 = N.of_int 2 let num_tests = "num_test">::: [ - "test_add" >:: test_num_add n1 n1 2; - "test_mult" >:: test_num_mult n2 n1 2; - "test_sub" >:: test_num_sub n1 n1 0; + "test_add" >:: test_num_add n1 n1 2; + "test_mult" >:: test_num_mult n2 n1 2; + "test_sub" >:: test_num_sub n1 n1 0; + "test_floor1" >:: test_floor (N.of_float 1.2) 1; + "test_floor2" >:: test_floor (N.of_float (-1.2)) (-2); ] -- cgit v1.2.3