diff --git a/Source/scalable/scalable.ml b/Source/scalable/scalable.ml index 343ef82..89bebf3 100644 --- a/Source/scalable/scalable.ml +++ b/Source/scalable/scalable.ml @@ -25,6 +25,19 @@ let sign x = 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 @@ -112,28 +125,27 @@ let print_b bA = @param nB A natural. *) -let rec rem_0 bA = - match bA with - [] -> [] - | 1::l1 -> 1::l1 - | _::l1 -> rem_0 l1;; - let compare_n nA nB = - let nA = rem_0 (List.rev nA) - and nB = rem_0 (List.rev nB) - in if List.length nA > List.length nB then - 1 - else if List.length nA < List.length nB 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;; + 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 @@ -156,7 +168,9 @@ let (<=!) nA nB = compare_n nA nB = 1 || compare_n nA nB = 0;; +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 @@ -164,7 +178,9 @@ let (>=!) nA nB = compare_n nA nB = 1 || compare_n nA nB = 0;; @param nA natural. @param nB natural. *) -let (<=!) nA nB = compare_n nA nB = -1 || compare_n nA nB = 0;; +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. @@ -201,7 +217,9 @@ let (>>) bA bB = compare_b bA bB = 1;; @param nA natural. @param nB natural. *) -let (<<=) bA bB = compare_b bA bB = -1 || compare_b bA bB = 0;; +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 @@ -209,16 +227,17 @@ let (<<=) bA bB = compare_b bA bB = -1 || compare_b bA bB = 0;; @param nA natural. @param nB natural. *) -let (>>=) bA bB = compare_b bA bB = 1 || compare_b bA bB = 0;; +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 - [] -> 1 - | e::_ when e = 1 -> -1 - | _ -> 1;; + [] | 0::_ -> 1 + | _ -> -1;; (** Absolute value of bitarray. @param bA Bitarray. @@ -234,17 +253,15 @@ let abs_b bA = let _quot_t a = match a with 0 | 1-> 0 - | 2 | 3-> 1 - | _ -> invalid_arg "must be smaller than 4";; + | _ -> 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 | 3-> 1 - | _ -> invalid_arg "must be smaller than 4";; + 0 | 2 -> 0 + | _ -> 1 (** Division of integer smaller than 4 by 2. @param a Built-in integer smaller than 4. @@ -262,14 +279,17 @@ let add_n nA nB = let rec add_n_rec nA nB ret res= match (nA, nB) with ([], []) -> ret::res - | (e::l1, []) | ([], e::l1) -> let tot = e + ret in + | (e::l1, []) | ([], e::l1) -> begin + let tot = e + ret in let (q, r) = _div_t tot in add_n_rec l1 [] q (r::res) - | (e1::nA, e2::nB) -> + 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) - in List.rev (add_n_rec nA nB 0 [0]);; + end + in rem0_rev (add_n_rec nA nB 0 [0]);; (** Difference of two naturals. @@ -277,69 +297,71 @@ let add_n nA nB = @param nA Natural. @param nB Natural. *) -let bit_comp = function 0 -> 1 | _ -> 0;; +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]);; -let complem2 bA n= +(** 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 [] -> [] - | e::bA -> - let rec complem_rec bA comp res n= - match n with - 0 -> res - | n -> - let (e:: bA) = match bA with - [] -> [0] - | _ -> bA in - let res = if comp then - (bit_comp e)::res - else e::res - and comp = if not comp && e = 1 then true else comp - in complem_rec bA comp res (n-1) - in bit_comp e::List.rev (complem_rec bA false [] (n - 1));; + | 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;; -let diff_n nA nB = add_n nA (complem2 nB (List.length nA)) (** Addition of two bitarrays. @param bA Bitarray. @param bB Bitarray. *) -let get_signed_bitarray bsign bA = +let abs_neg bA = match bA with [] -> [] - | _::bA -> bsign::bA;; + | _::bA -> 1::bA;; let add_b bA bB = match (bA, bB) with ([], l) | (l, []) -> l - | (0::bA, 0::bB) -> get_signed_bitarray 0 (add_n (0::bA) (0::bB)) - | (1::bA, 1::bB) -> get_signed_bitarray 1 (add_n (0::bA) (0::bB)) - | (1::bA, 0::bB) when (<<=) (0::bA) (0::bB) -> - get_signed_bitarray 0 (diff_n (0::bB) (0::bA)) - | (1::bA, 0::bB) -> - get_signed_bitarray 1 (add_n (0::bB) (complem2 (1::bA) (List.length bA))) - | (0::bA, 1::bB) when (<<) (0::bA) (0::bB) -> - get_signed_bitarray 1 (add_n (0::bA) (complem2 (1::bB) (List.length bB))) - | (0::bA, 1::bB) -> - get_signed_bitarray 0 (diff_n (0::bA) (0::bB)) - | _ -> failwith "error" + | (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 = [] - -(** Shifts bitarray to the left by a given natural number. - @param bA Bitarray. - @param d Non-negative integer. -*) -let rec shift bA d = - match d with - 0 -> bA - | d -> 0::shift bA (d-1);; +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. @@ -348,34 +370,48 @@ let rec shift bA d = let mult_b bA bB = match (bA, bB) with ([], _) | (_, []) -> [] - | (sign1::bA, sign2::bB) -> + | (signA::bA, signB::bB) -> let rec mult_b_rec bA bB n = match bA with [] -> [] | e::bA -> - let a = match e with 0 -> [] | 1 -> bB in + let a = match e with 0 -> [] | _ -> bB in add_n (shift a n) (mult_b_rec bA bB (n+1)) - in match (sign1, sign2) with - (0,0) | (1,1) -> 0::mult_b_rec bA bB 0 - | _ -> 1::mult_b_rec bA bB 0 + 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 = - match (bA, bB) with - ([], _) | (_, []) -> [] - | (sign1::bA, sign2::bB) -> - let rec quot_b_rec bA bB n = - match bA with - [] -> [] - | e::bA -> - let a = match e with 0 -> [] | 1 -> bB in - add_n (shift a n) (quot_b_rec bA bB (n+1)) - in match (sign1, sign2) with - (0,0) | (1,1) -> 0::mult_b_rec bA bB 0 - | _ -> 1::mult_b_rec bA bB 0 + let (quot, _) = div_b bA bB in quot;; @@ -383,10 +419,7 @@ let quot_b bA bB = @param bA Bitarray the modulo of which you're computing. @param bB Bitarray which is modular base. *) -let mod_b bA bB = [] +let mod_b bA bB = + let (_, rest) = div_b bA bB in rest;; + -(** 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 = ([], [])