426 lines
12 KiB
OCaml
426 lines
12 KiB
OCaml
|
|
(** A naive implementation of big integers
|
|
|
|
This module aims at creating a set of big integers naively. Such data
|
|
types will be subsequently called bitarrays. A bitarray is a list of
|
|
zeros and ones ; first integer representing the sign bit. In this
|
|
context zero is reprensented by the empty list []. The list is to
|
|
be read from left to right ; this is the opposite convention to the
|
|
one you usually write binary decompositions with. After the sign bit
|
|
the first encountered bit is the coefficient in front of two to
|
|
the power zero. This convention has been chosen to ease writing
|
|
down code. A natural bitarray is understood as being a bitarray of
|
|
which you've taken out the sign bit, it is just the binary
|
|
decomposition of a non-negative integer.
|
|
|
|
*)
|
|
|
|
(** Creates a bitarray from a built-in integer.
|
|
@param x built-in integer.
|
|
*)
|
|
let sign x =
|
|
if x < 0 then
|
|
-1
|
|
else
|
|
1;;
|
|
|
|
|
|
let rec rem_rec bA =
|
|
match bA with
|
|
[] -> []
|
|
| 1::bA -> 1::bA
|
|
| _::bA -> rem_rec bA;;
|
|
|
|
let rem0_rev bA = List.rev (rem_rec bA);;
|
|
|
|
let rem0 bA =
|
|
let bA = List.rev bA
|
|
in rem0_rev bA;;
|
|
|
|
|
|
let from_int x =
|
|
if x = 0 then []
|
|
else
|
|
let rec from_int_rec n =
|
|
match n with
|
|
0 -> []
|
|
| n -> n mod 2::from_int_rec (n/2)
|
|
in let bitsign =
|
|
if sign x = -1 then
|
|
1
|
|
else
|
|
0
|
|
in bitsign::from_int_rec (sign x * x);;
|
|
|
|
(** Transforms bitarray of built-in size to built-in integer.
|
|
UNSAFE: possible integer overflow.
|
|
@param bA bitarray object.
|
|
*)
|
|
|
|
let modulo a b =
|
|
match sign a = -1 && a mod b != 0 with
|
|
true -> a mod b + b
|
|
| _ -> a mod b;;
|
|
|
|
let power x n =
|
|
if n = 0 then 1 else
|
|
let rec power_rec x1 n =
|
|
match n with
|
|
1 -> x1
|
|
| n when modulo n 2 = 0 -> power_rec (x1 * x1) (n/2)
|
|
| n -> x1 * power_rec (x1 * x1) ((n-1)/2)
|
|
in power_rec x n;;
|
|
|
|
|
|
let to_int bA =
|
|
match bA with
|
|
[] -> 0
|
|
| e::bA1 -> begin
|
|
let sign = match e with
|
|
0 -> 1
|
|
| _ -> -1
|
|
in let rec to_int_rec bA pow =
|
|
match bA with
|
|
[] -> 0
|
|
| e::bA1 -> (e * power 2 pow) + to_int_rec bA1 (pow + 1)
|
|
in sign * to_int_rec bA1 0
|
|
end;;
|
|
|
|
(** Prints bitarray as binary number on standard output.
|
|
@param bA a bitarray.
|
|
*)
|
|
let print_b bA =
|
|
match bA with
|
|
[] -> print_endline "0"
|
|
| e::l1 -> begin
|
|
let rec print_b_rec bA =
|
|
match bA with
|
|
[] -> print_endline ""
|
|
| e::l1 -> begin
|
|
print_b_rec l1;
|
|
print_int e
|
|
end
|
|
in
|
|
if e = 1 then (
|
|
print_string "-";
|
|
print_b_rec l1
|
|
) else
|
|
print_b_rec l1
|
|
end;;
|
|
(** Toplevel directive to use print_b as bitarray printer.
|
|
CAREFUL: print_b is then list int printer.
|
|
UNCOMMENT FOR TOPLEVEL USE.
|
|
*)
|
|
(* #install_printer print_b *)
|
|
|
|
(** Internal comparisons on bitarrays and naturals. Naturals in this
|
|
context are understood as bitarrays missing a bit sign and thus
|
|
assumed to be non-negative.
|
|
*)
|
|
|
|
(** Comparing naturals. Output is 1 if first argument is bigger than
|
|
second -1 if it is smaller and 0 in case of equality.
|
|
@param nA A natural, a bitarray having no sign bit.
|
|
Assumed non-negative.
|
|
@param nB A natural.
|
|
*)
|
|
|
|
|
|
let compare_n nA nB =
|
|
match (nA, nB) with
|
|
([], []) -> 0
|
|
| (_, []) -> 1
|
|
| ([], _) -> -1
|
|
| (_::nA, _::nB) ->
|
|
let nA = List.rev nA and nB = List.rev nB in
|
|
let lengthA = List.length nA and lengthB = List.length nB in
|
|
if lengthA > lengthB then
|
|
1
|
|
else if lengthA < lengthB then
|
|
-1
|
|
else
|
|
let rec compare_n_rec nA nB =
|
|
match (nA, nB) with
|
|
([], []) -> 0
|
|
| ([], _) | (0::_, 1::_) -> -1
|
|
| (_, []) | (1::_, 0::_) -> 1
|
|
| (_::l1, _::l2) -> compare_n_rec l1 l2
|
|
in compare_n_rec nA nB;;
|
|
|
|
|
|
(** Bigger inorder comparison operator on naturals. Returns true if
|
|
first argument is bigger than second and false otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (>>!) nA nB = compare_n nA nB = 1;;
|
|
|
|
(** Smaller inorder comparison operator on naturals. Returns true if
|
|
first argument is smaller than second and false otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (<<!) nA nB = compare_n nA nB = -1;;
|
|
|
|
(** Bigger or equal inorder comparison operator on naturals. Returns
|
|
true if first argument is bigger or equal to second and false
|
|
otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (>=!) nA nB =
|
|
let comp = compare_n nA nB
|
|
in comp = 1 || comp = 0;;
|
|
|
|
(** Smaller or equal inorder comparison operator on naturals. Returns
|
|
true if first argument is smaller or equal to second and false
|
|
otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (<=!) nA nB =
|
|
let comp = compare_n nA nB
|
|
in comp = -1 || comp = 0;;
|
|
|
|
(** Comparing two bitarrays. Output is 1 if first argument is bigger
|
|
than second -1 if it smaller and 0 in case of equality.
|
|
@param bA A bitarray.
|
|
@param bB A bitarray.
|
|
*)
|
|
let compare_b bA bB =
|
|
match (bA, bB) with
|
|
([], []) -> 0
|
|
| ([], _) | (1::_, 0::_) -> -1
|
|
| (_, []) | (0::_, 1::_) -> 1
|
|
| (sign:: nA, _::nB) ->
|
|
match sign with
|
|
0 -> compare_n (0::nA) (0::nB)
|
|
| _ -> -1 * compare_n (0::nA) (0::nB);;
|
|
|
|
(** Bigger inorder comparison operator on bitarrays. Returns true if
|
|
first argument is bigger than second and false otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (<<) bA bB = compare_b bA bB = -1;;
|
|
|
|
(** Smaller inorder comparison operator on bitarrays. Returns true if
|
|
first argument is smaller than second and false otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (>>) bA bB = compare_b bA bB = 1;;
|
|
|
|
(** Bigger or equal inorder comparison operator on bitarrays. Returns
|
|
true if first argument is bigger or equal to second and false
|
|
otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (<<=) bA bB =
|
|
let comp = compare_b bA bB
|
|
in comp = -1 || comp = 0;;
|
|
|
|
(** Smaller or equal inorder comparison operator on naturals. Returns
|
|
true if first argument is smaller or equal to second and false
|
|
otherwise.
|
|
@param nA natural.
|
|
@param nB natural.
|
|
*)
|
|
let (>>=) bA bB =
|
|
let comp = compare_b bA bB
|
|
in comp = 1 || comp = 0;;
|
|
|
|
(** Sign of a bitarray.
|
|
@param bA Bitarray.
|
|
*)
|
|
let sign_b bA =
|
|
match bA with
|
|
[] | 0::_ -> 1
|
|
| _ -> -1;;
|
|
|
|
(** Absolute value of bitarray.
|
|
@param bA Bitarray.
|
|
*)
|
|
let abs_b bA =
|
|
match bA with
|
|
[] -> []
|
|
| _::bA -> 0::bA;;
|
|
|
|
(** Quotient of integers smaller than 4 by 2.
|
|
@param a Built-in integer smaller than 4.
|
|
*)
|
|
let _quot_t a =
|
|
match a with
|
|
0 | 1-> 0
|
|
| _ -> 1
|
|
|
|
(** Modulo of integer smaller than 4 by 2.
|
|
@param a Built-in integer smaller than 4.
|
|
*)
|
|
let _mod_t a =
|
|
match a with
|
|
0 | 2 -> 0
|
|
| _ -> 1
|
|
|
|
(** Division of integer smaller than 4 by 2.
|
|
@param a Built-in integer smaller than 4.
|
|
*)
|
|
let _div_t a = (_quot_t a, _mod_t a);;
|
|
|
|
(** Addition of two naturals.
|
|
@param nA Natural.
|
|
@param nB Natural.
|
|
*)
|
|
let add_n nA nB =
|
|
match (nA, nB) with
|
|
(l, []) | ([], l) -> l
|
|
| (_::nA, _::nB) ->
|
|
let rec add_n_rec nA nB ret res=
|
|
match (nA, nB) with
|
|
([], []) -> ret::res
|
|
| (e::l1, []) | ([], e::l1) -> begin
|
|
let tot = e + ret in
|
|
let (q, r) = _div_t tot in
|
|
add_n_rec l1 [] q (r::res)
|
|
end
|
|
| (e1::nA, e2::nB) -> begin
|
|
let tot = e1 + e2 + ret in
|
|
let (q, r) = _div_t tot in
|
|
add_n_rec nA nB q (r::res)
|
|
end
|
|
in rem0_rev (add_n_rec nA nB 0 [0]);;
|
|
|
|
|
|
(** Difference of two naturals.
|
|
UNSAFE: First entry is assumed to be bigger than second.
|
|
@param nA Natural.
|
|
@param nB Natural.
|
|
*)
|
|
|
|
let diff_n nA nB =
|
|
let rec diff_n_rec nA nB ret res=
|
|
match (nA, nB) with
|
|
([], []) -> res
|
|
| ([], e::nB) when 0 - (ret + e) = 0 -> diff_n_rec nA nB 0 (0::res)
|
|
| ([], e::nB) when 0 - (ret + e) = -1 -> diff_n_rec nA nB 1 (1::res)
|
|
| ([], e::nB) -> diff_n_rec nA nB 1 (0::res)
|
|
| (e::nA, []) when e - ret >= 0 -> diff_n_rec nA nB 0 (e-ret::res)
|
|
| (e::nA, []) -> diff_n_rec nA nB 1 (1::res)
|
|
| (e1::nA, e2::nB) when e1 - (e2 + ret) = 0 -> diff_n_rec nA nB 0 (0::res)
|
|
| (e1::nA, e2::nB) when e1 - (e2 + ret) = 1 -> diff_n_rec nA nB 0 (1::res)
|
|
| (e1::nA, e2::nB) when e1 - (e2 + ret) = -1 -> diff_n_rec nA nB 1 (1::res)
|
|
| (_::nA, _::nB) -> diff_n_rec nA nB 1 (0::res)
|
|
in match (nA, nB) with
|
|
(l, []) -> l
|
|
| ([], _::nB) -> rem0_rev (diff_n_rec [] nB 0 [0])
|
|
| (_::nA, _::nB) -> rem0_rev (diff_n_rec nA nB 0 [0]);;
|
|
|
|
(** Shifts bitarray to the left by a given natural number.
|
|
@param bA Bitarray.
|
|
@param d Non-negative integer.
|
|
*)
|
|
let shift bA d =
|
|
match bA with
|
|
[] -> []
|
|
| sign::bA ->
|
|
let rec shift_rec bA d res=
|
|
match d with
|
|
d when d <= 0 -> res
|
|
| d -> shift_rec bA (d-1) (0::res)
|
|
in sign::shift_rec bA d bA;;
|
|
|
|
|
|
(** Addition of two bitarrays.
|
|
@param bA Bitarray.
|
|
@param bB Bitarray.
|
|
*)
|
|
|
|
let abs_neg bA =
|
|
match bA with
|
|
[] -> []
|
|
| _::bA -> 1::bA;;
|
|
|
|
let add_b bA bB =
|
|
match (bA, bB) with
|
|
([], l) | (l, []) -> l
|
|
| (0::bA, 0::bB) -> add_n (0::bA) (0::bB)
|
|
| (1::bA, 1::bB) -> abs_neg (add_n (0::bA) (0::bB))
|
|
| (1::bA, 0::bB) when (<=!) (0::bA) (0::bB) -> diff_n (0::bB) (0::bA)
|
|
| (1::bA, 0::bB) -> abs_neg (diff_n (shift [0] (List.length bA)) (diff_n (0::bB) (0::bA)))
|
|
| (0::bA, 1::bB) when (>=!) (0::bA) (0::bB) -> diff_n (0::bA) (0::bB)
|
|
| (0::bA, 1::bB) -> abs_neg (diff_n (shift [0] (List.length bB)) (diff_n (0::bA) (0::bB)))
|
|
| _ -> failwith "error";;
|
|
|
|
|
|
(** Difference of two bitarrays.
|
|
@param bA Bitarray.
|
|
@param bB Bitarray.
|
|
*)
|
|
let diff_b bA bB =
|
|
match bB with
|
|
[] -> bA
|
|
| 1::bB -> add_b bA (0::bB)
|
|
| _ -> add_b bA (abs_neg bB);;
|
|
|
|
(** Multiplication of two bitarrays.
|
|
@param bA Bitarray.
|
|
@param bB Bitarray.
|
|
*)
|
|
let mult_b bA bB =
|
|
match (bA, bB) with
|
|
([], _) | (_, []) -> []
|
|
| (signA::bA, signB::bB) ->
|
|
let rec mult_b_rec bA bB n =
|
|
match bA with
|
|
[] -> []
|
|
| e::bA ->
|
|
let a = match e with 0 -> [] | _ -> bB in
|
|
add_n (shift a n) (mult_b_rec bA bB (n+1))
|
|
in match (signA, signB) with
|
|
(0,0) | (1,1) -> abs_b (mult_b_rec bA (0::bB) 0)
|
|
| _ -> abs_neg (mult_b_rec bA (0::bB) 0)
|
|
|
|
(** Integer division of two bitarrays.
|
|
@param bA Bitarray you want to divide.
|
|
@param bB Bitarray you wnat to divide by.
|
|
*)
|
|
let div_b bA bB =
|
|
match (bA, bB) with
|
|
(_, []) -> invalid_arg "divider must be Non-Zero"
|
|
| ([],_) -> ([], [])
|
|
| (sign1::bA, sign2::bB) ->
|
|
let rec div_b_rec bA bB res=
|
|
if (>=!) bA bB then
|
|
let bA = diff_n bA bB
|
|
and res = add_n [0;1] res
|
|
in div_b_rec bA bB res
|
|
else (res, bA)
|
|
in let (quot, rest) = div_b_rec (0::bA) (0::bB) [] in
|
|
match (sign1, sign2) with
|
|
(0,0) | (1,1) -> (abs_b quot, rest)
|
|
| _ -> begin
|
|
match (quot, rest) with
|
|
(quot, []) -> (abs_neg quot, [])
|
|
| (quot, rest) -> (abs_neg (add_n [0;1] quot), diff_n (0::bB) rest)
|
|
end
|
|
|
|
|
|
(** Quotient of two bitarrays.
|
|
@param bA Bitarray you want to divide by second argument.
|
|
@param bB Bitarray you divide by. Non-zero!
|
|
*)
|
|
let quot_b bA bB =
|
|
let (quot, _) = div_b bA bB in quot;;
|
|
|
|
|
|
|
|
(** Modulo of a bitarray against a positive one.
|
|
@param bA Bitarray the modulo of which you're computing.
|
|
@param bB Bitarray which is modular base.
|
|
*)
|
|
let mod_b bA bB =
|
|
let (_, rest) = div_b bA bB in rest;;
|
|
|
|
|