Source file batBig_int.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
(*
 * BatInt32 - Extended Big integers
 * Copyright (C) 2007 Bluestorm <bluestorm dot dylc on-the-server gmail dot com>
 *               2008 David Teller
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version,
 * with the special exception on linking described in file LICENSE.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)

let big_int_base_default_symbols =
  let symbol offset base k =
    char_of_int (k - offset + (int_of_char base)) in
  BatBytesCompat.string_init (10 + 26*2) (fun k ->
    if k < 10
    then symbol 0 '0' k
    else if k < 36
    then symbol 10 'a' k
    else symbol 36 'A' k
  )


let to_string_in_custom_base
    symbols (* vector of digit symbols 0,1,...,a,b,... *)
    b       (* base, int > 1 and <= number of defined symbols *)
    n       (* big integer *)
  = let open Big_int in
  if b <= 1 then invalid_arg
      "Big_int.to_string_in_custom_base: base must be > 1";
  if b > String.length symbols then invalid_arg (
      "Big_int.to_string_in_custom_base: big_int_base_default_symbols too small for base "
      ^ (string_of_int b) ^ ": only " ^ string_of_int (String.length symbols));
  let isnegative = sign_big_int n < 0 in
  (* generously over-approximate number of binary digits of n;
     num_digits_big_int actually returns the number of _words_ *)
  let base2digits = Sys.word_size * num_digits_big_int n in
  (* over-approximate resulting digits in base b, using following theorem,
     where k = base2digits :
                                          k                    k      k * Log[2]
      digits in base b <= Ceiling[Log[b, 2 ]]    and   Log[b, 2 ] == -----------
                                                                       Log[b]    *)
  let basebdigits = int_of_float (ceil (
        ((float_of_int base2digits) *. (log 2.))
        /.
          (log (float_of_int b))))
    +
      (if isnegative then 1 else 0) (* the pesky '-' sign *)
  in
  let buff = Bytes.create basebdigits in (* we know the buffer is large enough *)
  let curr = ref (basebdigits - 1) and count = ref 0 in
  let addchar c = Bytes.set buff !curr c ; incr count; decr curr in
  (* switch base to big int representation and n to mutable, and loop *)
  let b = big_int_of_int b and n = ref (abs_big_int n) in
  while compare_big_int !n b >= 0 do
    let q,d = quomod_big_int !n b in
    n := q; addchar symbols.[int_of_big_int d];
  done;
  addchar symbols.[int_of_big_int !n];
  if isnegative then addchar '-';
  Bytes.sub_string buff (!curr + 1) !count

let to_string_in_base b n =
  if b <= 1 || b > 36 then invalid_arg
      "Big_int.to_string_in_base: base must be in 2..36"
  else to_string_in_custom_base big_int_base_default_symbols b n


let to_string_in_binary = to_string_in_base 2
let to_string_in_octal  = to_string_in_base 8
let to_string_in_hexa   = to_string_in_base 16

(*$= to_string_in_base & ~printer:identity
  (to_string_in_base 16 (big_int_of_int 9485))    "250d"
  (to_string_in_base 16 (big_int_of_int (-9485))) "-250d"
  (to_string_in_base 10 (big_int_of_int 9485))    "9485"
  (to_string_in_base  8 (big_int_of_int 9485))    "22415"
  (to_string_in_base  2 (big_int_of_int 9485))    "10010100001101"
  (to_string_in_base 36 (big_int_of_int 948565))  "kbx1"
  (to_string_in_base  3 (big_int_of_int 2765353)) "12012111100111"
*) (*$= to_string_in_custom_base & ~printer:identity
     (to_string_in_custom_base "*/!" 3 (big_int_of_int 2765353)) "/!*/!////**///"
   *) (*$= to_string_in_binary & ~printer:identity
        (to_string_in_binary (big_int_of_int 9485))     "10010100001101"
      *) (*$= to_string_in_octal & ~printer:identity
        (to_string_in_octal (big_int_of_int 9485))      "22415"
      *) (*$= to_string_in_hexa & ~printer:identity
        (to_string_in_hexa (big_int_of_int 9485))       "250d"
      *) (*$T to_string_in_base
        try ignore (to_string_in_base 37 (big_int_of_int 948565)); false \
        with Invalid_argument _ -> true
        try ignore (to_string_in_base 1 (big_int_of_int 948565)); false \
        with Invalid_argument _ -> true
      *) (*$Q to_string_in_base
        Q.int (fun i-> let bi = big_int_of_int i in \
        to_string_in_base 10 bi = string_of_big_int bi)
      *)


open BatNumber

module BaseBig_int : NUMERIC_BASE with type t = Big_int.big_int = struct
  open Big_int

  type t = big_int
  let zero = zero_big_int
  let one  = unit_big_int
  let succ = succ_big_int
  let pred = pred_big_int
  let neg  = minus_big_int
  let abs  = abs_big_int
  let add  = add_big_int
  let sub  = sub_big_int
  let mul  = mult_big_int
  let div  = div_big_int

  let modulo = mod_big_int
  let pow  = power_big_int_positive_big_int

  let to_string = string_of_big_int
  let of_string = big_int_of_string
  let to_int    = int_of_big_int
  let of_int    = big_int_of_int

  let compare   = compare_big_int

  let of_float f =
    try of_string (Printf.sprintf "%.0f" f)
    with Failure _ -> invalid_arg "Big_int.of_float"
  (*$T of_float
    to_int (of_float 4.46) = 4
    to_int (of_float 4.56) = 5
    to_int (of_float (-4.46)) = -4
    to_int (of_float (-4.56)) = -5
    try ignore (of_float nan); false with Invalid_argument _ -> true
    try ignore (of_float (1. /. 0.)); false with Invalid_argument _ -> true
    try ignore (of_float (-1. /. 0.)); false with Invalid_argument _ -> true
  *)

  let to_float  = float_of_big_int
end

include Big_int
include MakeNumeric(BaseBig_int)

let print out t = BatIO.nwrite out (to_string t)
  (*$T print
    BatIO.to_string print (of_int 456) = "456"
    BatIO.to_string print (power_int_positive_int 10 31) = "10000000000000000000000000000000"
    BatIO.to_string print (power_int_positive_int (-10) 31) = "-10000000000000000000000000000000"
  *)

(* Tests for infix operators. Those are a little trickier than usual
 * for big_ints because the generic comparison functions do not work
 * for big_ints and therefore we have to take care the proper ones are
 * used. Cf issue #674. Same reason prevent qcheck to compare big_ints
 * so we convert to int: *)
  (*$< Infix *)
  (*$= (--) & ~printer:(IO.to_string (List.print Int.print))
    ((of_int 1 -- of_int 3) /@ to_int |> List.of_enum) [1; 2; 3]
  *)
  (*$= (---) & ~printer:(IO.to_string (List.print Int.print))
    ((of_int 1 --- of_int 3) /@ to_int |> List.of_enum) [1; 2; 3]
    ((of_int 3 --- of_int 1) /@ to_int |> List.of_enum) [3; 2; 1]
  *)
  (*$>*)


##V<4.5##let big_int_of_string_opt s = try Some (big_int_of_string s) with _ -> None
##V<4.5##let int_of_big_int_opt n = try Some (int_of_big_int n) with _ -> None
##V<4.5##let int32_of_big_int_opt n = try Some (int32_of_big_int n) with _ -> None
##V<4.5##let int64_of_big_int_opt n = try Some (int64_of_big_int n) with _ -> None
##V<4.5##let nativeint_of_big_int_opt n = try Some (nativeint_of_big_int n) with _ -> None