Retour en arriere sur le precedent commit

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4845 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Pierre Weis 2002-05-27 12:06:49 +00:00
parent 75ef6798a9
commit 00d14a727a
2 changed files with 242 additions and 266 deletions

View File

@ -13,51 +13,45 @@
(* $Id$ *)
open Int_misc;;
open Nat;;
open Int_misc
open Nat
type big_int =
{ sign : int;
abs_value : nat }
;;
(* Sign of a big_int *)
let sign_big_int bi = bi.sign;;
let create_big_int sign nat =
if sign == 1 || sign == -1 ||
(sign == 0 &&
if sign = 1 || sign = -1 ||
(sign = 0 &&
is_zero_nat nat 0 (num_digits_nat nat 0 (length_nat nat)))
then { sign = sign;
abs_value = nat }
else invalid_arg "create_big_int"
;;
(* Sign of a big_int *)
let sign_big_int bi = bi.sign
let zero_big_int =
{ sign = 0;
abs_value = make_nat 1 }
;;
let unit_big_int =
{ sign = 1;
abs_value = nat_of_int 1 }
;;
(* Number of digits in a big_int *)
let num_digits_big_int bi =
num_digits_nat (bi.abs_value) 0 (length_nat bi.abs_value);;
num_digits_nat (bi.abs_value) 0 (length_nat bi.abs_value)
(* Opposite of a big_int *)
let minus_big_int bi =
{ sign = - bi.sign;
abs_value = copy_nat (bi.abs_value) 0 (num_digits_big_int bi)}
;;
(* Absolute value of a big_int *)
let abs_big_int bi =
{ sign = if bi.sign == 0 then 0 else 1;
{ sign = if bi.sign = 0 then 0 else 1;
abs_value = copy_nat (bi.abs_value) 0 (num_digits_big_int bi)}
;;
(* Comparison operators on big_int *)
@ -68,33 +62,30 @@ let abs_big_int bi =
-1 if bi < bi2
*)
let compare_big_int bi1 bi2 =
if bi1.sign == 0 && bi2.sign == 0 then 0 else
if bi1.sign < bi2.sign then -1 else
if bi1.sign > bi2.sign then 1 else
if bi1.sign == 1 then
if bi1.sign = 0 && bi2.sign = 0 then 0
else if bi1.sign < bi2.sign then -1
else if bi1.sign > bi2.sign then 1
else if bi1.sign = 1 then
compare_nat (bi1.abs_value) 0 (num_digits_big_int bi1)
(bi2.abs_value) 0 (num_digits_big_int bi2)
else
compare_nat (bi2.abs_value) 0 (num_digits_big_int bi2)
(bi1.abs_value) 0 (num_digits_big_int bi1)
;;
let eq_big_int bi1 bi2 = compare_big_int bi1 bi2 == 0
let eq_big_int bi1 bi2 = compare_big_int bi1 bi2 = 0
and le_big_int bi1 bi2 = compare_big_int bi1 bi2 <= 0
and ge_big_int bi1 bi2 = compare_big_int bi1 bi2 >= 0
and lt_big_int bi1 bi2 = compare_big_int bi1 bi2 < 0
and gt_big_int bi1 bi2 = compare_big_int bi1 bi2 > 0
;;
let max_big_int bi1 bi2 = if lt_big_int bi1 bi2 then bi2 else bi1
and min_big_int bi1 bi2 = if gt_big_int bi1 bi2 then bi2 else bi1
;;
(* Operations on big_int *)
let pred_big_int bi =
match bi.sign with
| 0 -> { sign = -1; abs_value = nat_of_int 1}
0 -> { sign = -1; abs_value = nat_of_int 1}
| 1 -> let size_bi = num_digits_big_int bi in
let copy_bi = copy_nat (bi.abs_value) 0 size_bi in
decr_nat copy_bi 0 size_bi 0;
@ -108,11 +99,10 @@ let pred_big_int bi =
incr_nat copy_bi 0 size_res 1;
{ sign = -1;
abs_value = copy_bi }
;;
let succ_big_int bi =
match bi.sign with
| 0 -> {sign = 1; abs_value = nat_of_int 1}
0 -> {sign = 1; abs_value = nat_of_int 1}
| -1 -> let size_bi = num_digits_big_int bi in
let copy_bi = copy_nat (bi.abs_value) 0 size_bi in
decr_nat copy_bi 0 size_bi 0;
@ -126,24 +116,23 @@ let succ_big_int bi =
incr_nat copy_bi 0 size_res 1;
{ sign = 1;
abs_value = copy_bi }
;;
let add_big_int bi1 bi2 =
let size_bi1 = num_digits_big_int bi1
and size_bi2 = num_digits_big_int bi2 in
if bi1.sign == bi2.sign
if bi1.sign = bi2.sign
then (* Add absolute values if signs are the same *)
{ sign = bi1.sign;
abs_value =
match compare_nat (bi1.abs_value) 0 size_bi1
(bi2.abs_value) 0 size_bi2 with
| -1 -> let res = create_nat (succ size_bi2) in
-1 -> let res = create_nat (succ size_bi2) in
(blit_nat res 0 (bi2.abs_value) 0 size_bi2;
set_digit_nat res size_bi2 0;
add_nat res 0 (succ size_bi2)
(bi1.abs_value) 0 size_bi1 0;
res)
| _ -> let res = create_nat (succ size_bi1) in
|_ -> let res = create_nat (succ size_bi1) in
(blit_nat res 0 (bi1.abs_value) 0 size_bi1;
set_digit_nat res size_bi1 0;
add_nat res 0 (succ size_bi1)
@ -153,43 +142,40 @@ let add_big_int bi1 bi2 =
else (* Subtract absolute values if signs are different *)
match compare_nat (bi1.abs_value) 0 size_bi1
(bi2.abs_value) 0 size_bi2 with
| 0 -> zero_big_int
0 -> zero_big_int
| 1 -> { sign = bi1.sign;
abs_value =
let res = copy_nat (bi1.abs_value) 0 size_bi1 in
sub_nat res 0 size_bi1
(sub_nat res 0 size_bi1
(bi2.abs_value) 0 size_bi2 1;
res }
res) }
| _ -> { sign = bi2.sign;
abs_value =
let res = copy_nat (bi2.abs_value) 0 size_bi2 in
sub_nat res 0 size_bi2
(sub_nat res 0 size_bi2
(bi1.abs_value) 0 size_bi1 1;
res }
;;
res) }
(* Coercion with int type *)
let big_int_of_int i =
{ sign = sign_int i;
abs_value =
let res = (create_nat 1)
in (if i == monster_int
in (if i = monster_int
then (set_digit_nat res 0 biggest_int;
incr_nat res 0 1 1;
())
incr_nat res 0 1 1; ())
else set_digit_nat res 0 (abs i));
res }
;;
let add_int_big_int i bi = add_big_int (big_int_of_int i) bi;;
let add_int_big_int i bi = add_big_int (big_int_of_int i) bi
let sub_big_int bi1 bi2 = add_big_int bi1 (minus_big_int bi2);;
let sub_big_int bi1 bi2 = add_big_int bi1 (minus_big_int bi2)
(* Returns i * bi *)
let mult_int_big_int i bi =
let size_bi = num_digits_big_int bi in
let size_res = succ size_bi in
if i == monster_int
if i = monster_int
then let res = create_nat size_res in
blit_nat res 0 (bi.abs_value) 0 size_bi;
mult_digit_nat res 0 size_res (bi.abs_value) 0 size_bi
@ -201,7 +187,6 @@ let mult_int_big_int i bi =
(nat_of_int (abs i)) 0;
{ sign = (sign_int i) * (sign_big_int bi);
abs_value = res }
;;
let mult_big_int bi1 bi2 =
let size_bi1 = num_digits_big_int bi1
@ -212,27 +197,24 @@ let mult_big_int bi1 bi2 =
abs_value =
if size_bi2 > size_bi1
then (mult_nat res 0 size_res (bi2.abs_value) 0 size_bi2
(bi1.abs_value) 0 size_bi1;
res)
(bi1.abs_value) 0 size_bi1;res)
else (mult_nat res 0 size_res (bi1.abs_value) 0 size_bi1
(bi2.abs_value) 0 size_bi2;
res) }
;;
(bi2.abs_value) 0 size_bi2;res) }
(* (quotient, rest) of the euclidian division of 2 big_int *)
let quomod_big_int bi1 bi2 =
if bi2.sign == 0 then raise Division_by_zero
if bi2.sign = 0 then raise Division_by_zero
else
let size_bi1 = num_digits_big_int bi1
and size_bi2 = num_digits_big_int bi2 in
match compare_nat (bi1.abs_value) 0 size_bi1
(bi2.abs_value) 0 size_bi2 with
| -1 -> (* 1/2 -> 0, reste 1, -1/2 -> -1, reste 1 *)
if bi1.sign == -1
-1 -> (* 1/2 -> 0, reste 1, -1/2 -> -1, reste 1 *)
if bi1.sign = -1
then (big_int_of_int(-1), add_big_int bi2 bi1)
else (zero_big_int, bi1)
else (big_int_of_int 0, bi1)
| 0 -> (big_int_of_int (bi1.sign * bi2.sign), zero_big_int)
| _ -> let bi1_negatif = bi1.sign == -1 in
| _ -> let bi1_negatif = bi1.sign = -1 in
let size_q =
if bi1_negatif
then succ (max (succ (size_bi1 - size_bi2)) 1)
@ -276,10 +258,8 @@ let quomod_big_int bi1 bi2 =
(let new_r = copy_nat (bi2.abs_value) 0 size_bi2 in
(* new_r contains (r, size_bi2) the remainder *)
{ sign = - bi2.sign;
abs_value =
(set_digit_nat q (pred size_q) 0;
incr_nat q 0 size_q 1;
q) },
abs_value = (set_digit_nat q (pred size_q) 0;
incr_nat q 0 size_q 1; q) },
{ sign = 1;
abs_value =
(sub_nat new_r 0 size_bi2 r 0 size_bi2 1;
@ -292,11 +272,9 @@ let quomod_big_int bi1 bi2 =
abs_value = q },
{ sign = if not_null_mod then 1 else 0;
abs_value = copy_nat r 0 size_bi2 })
;;
let div_big_int bi1 bi2 = fst (quomod_big_int bi1 bi2)
and mod_big_int bi1 bi2 = snd (quomod_big_int bi1 bi2)
;;
let gcd_big_int bi1 bi2 =
let size_bi1 = num_digits_big_int bi1
@ -310,7 +288,7 @@ let gcd_big_int bi1 bi2 =
abs_value =
match compare_nat (bi1.abs_value) 0 size_bi1
(bi2.abs_value) 0 size_bi2 with
| 0 -> bi1.abs_value
0 -> bi1.abs_value
| 1 ->
let res = copy_nat (bi1.abs_value) 0 size_bi1 in
let len =
@ -322,7 +300,6 @@ let gcd_big_int bi1 bi2 =
gcd_nat res 0 size_bi2 (bi1.abs_value) 0 size_bi1 in
copy_nat res 0 len
}
;;
(* Coercion operators *)
@ -342,33 +319,29 @@ let int_of_big_int bi =
if bi.sign = -1 then - n else n
with Failure _ ->
if eq_big_int bi monster_big_int then monster_int
else failwith "int_of_big_int"
;;
else failwith "int_of_big_int";;
(* Coercion with nat type *)
let nat_of_big_int bi =
if bi.sign == -1
if bi.sign = -1
then failwith "nat_of_big_int"
else copy_nat (bi.abs_value) 0 (num_digits_big_int bi)
;;
let sys_big_int_of_nat nat off len =
let length = num_digits_nat nat off len in
{ sign = if is_zero_nat nat off length then 0 else 1;
abs_value = copy_nat nat off length }
;;
let big_int_of_nat nat =
sys_big_int_of_nat nat 0 (length_nat nat)
;;
(* Coercion with string type *)
let string_of_big_int bi =
if bi.sign == -1
if bi.sign = -1
then "-" ^ string_of_nat bi.abs_value
else string_of_nat bi.abs_value
;;
let sys_big_int_of_string_aux s ofs len sgn =
if len < 1 then failwith "sys_big_int_of_string";
@ -379,14 +352,13 @@ let sys_big_int_of_string_aux s ofs len sgn =
let sys_big_int_of_string s ofs len =
match s.[ofs] with
| '-' -> sys_big_int_of_string_aux s (ofs + 1) (len - 1) (-1)
| '+' -> sys_big_int_of_string_aux s (ofs + 1) (len - 1) 1
| '-' -> sys_big_int_of_string_aux s (ofs+1) (len-1) (-1)
| '+' -> sys_big_int_of_string_aux s (ofs+1) (len-1) 1
| _ -> sys_big_int_of_string_aux s ofs len 1
;;
let big_int_of_string s =
sys_big_int_of_string s 0 (String.length s)
;;
let power_base_nat base nat off len =
if is_zero_nat nat off len then nat_of_int 1 else
@ -396,7 +368,7 @@ let power_base_nat base nat off len =
let (x, y) = quomod_big_int (sys_big_int_of_nat nat off len)
(big_int_of_int (succ pmax)) in
(int_of_big_int x, int_of_big_int y) in
if n == 0 then copy_nat power_base (pred rem) 1 else
if n = 0 then copy_nat power_base (pred rem) 1 else
begin
let res = make_nat n
and res2 = make_nat (succ n)
@ -413,8 +385,7 @@ let power_base_nat base nat off len =
then (set_to_zero_nat res 0 len;
mult_digit_nat res 0 succ_len2
res2 0 len2
power_base pmax;
())
power_base pmax; ())
else blit_nat res 0 res2 0 len2
end;
set_to_zero_nat res2 0 len2;
@ -422,26 +393,26 @@ let power_base_nat base nat off len =
done;
if rem > 0
then (mult_digit_nat res2 0 (succ n)
res 0 n
power_base (pred rem);
res 0 n power_base (pred rem);
res2)
else res
end
;;
let power_int_positive_int i n =
match sign_int n with
| 0 -> unit_big_int
0 -> unit_big_int
| -1 -> invalid_arg "power_int_positive_int"
| _ -> let nat = power_base_int (abs i) n in
{ sign = if i >= 0 then sign_int i else
if n land 1 == 0 then 1 else -1;
{ sign = if i >= 0
then sign_int i
else if n land 1 = 0
then 1
else -1;
abs_value = nat}
;;
let power_big_int_positive_int bi n =
match sign_int n with
| 0 -> unit_big_int
0 -> unit_big_int
| -1 -> invalid_arg "power_big_int_positive_int"
| _ -> let bi_len = num_digits_big_int bi in
let res_len = bi_len * n in
@ -464,25 +435,29 @@ let power_big_int_positive_int bi n =
set_to_zero_nat res2 0 len2);
p := !p lsr 1
done;
{sign = if bi.sign >= 0 then bi.sign else
if n land 1 == 0 then 1 else -1;
{sign = if bi.sign >= 0
then bi.sign
else if n land 1 = 0
then 1
else -1;
abs_value = res}
;;
let power_int_positive_big_int i bi =
match sign_big_int bi with
| 0 -> unit_big_int
0 -> unit_big_int
| -1 -> invalid_arg "power_int_positive_big_int"
| _ -> let nat = power_base_nat
(abs i) (bi.abs_value) 0 (num_digits_big_int bi) in
{ sign = if i >= 0 then sign_int i else
if is_digit_odd (bi.abs_value) 0 then -1 else 1;
{ sign = if i >= 0
then sign_int i
else if is_digit_odd (bi.abs_value) 0
then -1
else 1;
abs_value = nat }
;;
let power_big_int_positive_big_int bi1 bi2 =
match sign_big_int bi2 with
| 0 -> unit_big_int
0 -> unit_big_int
| -1 -> invalid_arg "power_big_int_positive_big_int"
| _ -> let nat = bi2.abs_value
and off = 0
@ -511,15 +486,17 @@ let power_big_int_positive_big_int bi1 bi2 =
set_to_zero_nat res2 0 len2);
p := !p lsr 1
done;
{sign = if bi1.sign >= 0 then bi1.sign else
if is_digit_odd (bi2.abs_value) 0 then -1 else 1;
{sign = if bi1.sign >= 0
then bi1.sign
else if is_digit_odd (bi2.abs_value) 0
then -1
else 1;
abs_value = res}
;;
(* base_power_big_int compute bi*base^n *)
let base_power_big_int base n bi =
match sign_int n with
| 0 -> bi
0 -> bi
| -1 -> let nat = power_base_int base (-n) in
let len_nat = num_digits_nat nat 0 (length_nat nat)
and len_bi = num_digits_big_int bi in
@ -552,12 +529,12 @@ let base_power_big_int base n bi =
(bi.abs_value) 0 len_bi)
; if is_zero_nat res 0 new_len
then zero_big_int
else create_big_int (bi.sign) res;;
else create_big_int (bi.sign) res
(* Coercion with float type *)
let float_of_big_int bi =
float_of_string (string_of_big_int bi);;
float_of_string (string_of_big_int bi)
(* XL: suppression de big_int_of_float et nat_of_float. *)
@ -570,7 +547,6 @@ let sqrt_big_int bi =
| -1 -> invalid_arg "sqrt_big_int"
| _ -> {sign = 1;
abs_value = sqrt_nat (bi.abs_value) 0 (num_digits_big_int bi)}
;;
let square_big_int bi =
if bi.sign == 0 then zero_big_int else
@ -579,7 +555,6 @@ let square_big_int bi =
let res = make_nat len_res in
square_nat res 0 len_res (bi.abs_value) 0 len_bi;
{sign = 1; abs_value = res}
;;
(* round off of the futur last digit (of the integer represented by the string
argument of the function) that is now the previous one.
@ -588,20 +563,20 @@ let square_big_int bi =
else s <- the round number and the result_int is false *)
let round_futur_last_digit s off_set length =
let l = pred (length + off_set) in
if int_of_char s.[l] >= int_of_char '5'
if Char.code(String.get s l) >= Char.code '5'
then
let rec round_rec l =
let current_char = s.[l] in
if current_char == '9'
let current_char = String.get s l in
if current_char = '9'
then
(s.[l] <- '0';
if l == off_set then true else round_rec (pred l))
(String.set s l '0';
if l = off_set then true else round_rec (pred l))
else
(s.[l] <- char_of_int (succ (int_of_char current_char));
(String.set s l (Char.chr (succ (Char.code current_char)));
false)
in round_rec (pred l)
else false
;;
(* Approximation with floating decimal point a` la approx_ratio_exp *)
let approx_big_int prec bi =
@ -610,18 +585,19 @@ let approx_big_int prec bi =
max 0
(int_of_big_int (
add_int_big_int
(- prec)
(-prec)
(div_big_int (mult_big_int (big_int_of_int (pred len_bi))
(big_int_of_string "963295986"))
(big_int_of_string "100000000")))) in
let s =
string_of_big_int (div_big_int bi (power_int_positive_int 10 n)) in
let (sign, off, len) =
if s.[0] == '-' then ("-", 1, succ prec) else ("", 0, prec) in
if round_futur_last_digit s off (succ prec)
then sign ^ "1." ^ String.make prec '0' ^ "e" ^
string_of_int (n + 1 - off + String.length s)
else sign ^ String.sub s off 1 ^ "." ^
String.sub s (succ off) (pred prec) ^ "e" ^
string_of_int (n - succ off + String.length s)
;;
if String.get s 0 = '-'
then ("-", 1, succ prec)
else ("", 0, prec) in
if (round_futur_last_digit s off (succ prec))
then (sign^"1."^(String.make prec '0')^"e"^
(string_of_int (n + 1 - off + String.length s)))
else (sign^(String.sub s off 1)^"."^
(String.sub s (succ off) (pred prec))
^"e"^(string_of_int (n - succ off + String.length s)))

View File

@ -15,22 +15,22 @@
(* Some extra operations on integers *)
let rec gcd_int i1 i2 =
if i2 = 0 then abs i1 else gcd_int i2 (i1 mod i2)
;;
let rec num_bits_int_aux n =
if n = 0 then 0 else succ(num_bits_int_aux (n lsr 1));;
let num_bits_int n = num_bits_int_aux (abs n);;
let sign_int i = if i = 0 then 0 else if i > 0 then 1 else -1;;
let length_of_int = Sys.word_size - 2;;
let monster_int = 1 lsl length_of_int;;
let biggest_int = monster_int - 1;;
let least_int = - biggest_int;;
let rec num_bits_int_aux n =
if n == 0 then 0 else succ (num_bits_int_aux (n lsr 1));;
let num_bits_int n = num_bits_int_aux (abs n);;
let sign_int i = if i == 0 then 0 else if i > 0 then 1 else -1;;
let compare_int n1 n2 =
if n1 == n2 then 0 else if n1 > n2 then 1 else -1;;
let rec gcd_int i1 i2 =
if i2 == 0 then abs i1 else gcd_int i2 (i1 mod i2);;