Update functions

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);

  ]