MathgeomGLS

1
{**********************************************************************}
2
{                                                                      }
3
{    "The contents of this file are subject to the Mozilla Public      }
4
{    License Version 1.1 (the "License"); you may not use this         }
5
{    file except in compliance with the License. You may obtain        }
6
{    a copy of the License at http://www.mozilla.org/MPL/              }
7
{                                                                      }
8
{    Software distributed under the License is distributed on an       }
9
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
10
{    or implied. See the License for the specific language             }
11
{    governing rights and limitations under the License.               }
12
{                                                                      }
13
{    Copyright Creative IT.                                            }
14
{    Current maintainer: Eric Grange                                   }
15
{                                                                      }
16
{**********************************************************************}
17
unit dwsBigInteger;
18

19
{$I dws.inc}
20

21
interface
22

23
uses
24
   Classes, System.SysUtils, dwsUtils, gmp_lib;  // gmp_obj
25

26
type
27

28
   TBigInteger = class;
29

30
   IBigInteger = interface
31
      ['{C78B75B3-DF67-4E60-8B38-AD8719F175D4}']
32
      function Obj : TBigInteger;
33
      function Clone : TBigInteger;
34
   end;
35

36
   TBigInteger = class (TInterfacedObject, IBigInteger)
37
      private
38
         mpz : mpz_t;
39

40
         function Obj : TBigInteger;
41

42
      public
43
         constructor Create;
44
         destructor Destroy; override;
45

46
         function Clone : TBigInteger;
47
   end;
48

49
   BigInteger = record
50
      private
51
         FData : IBigInteger;
52

53
         procedure Allocate; inline;
54

55
      public
56
         procedure Assign(const v : Integer); overload; inline;
57
         procedure Assign(const v : Int64); overload; inline;
58

59
         function ToHexString : String;
60
         procedure FromHexString(const s : String);
61

62
         function ToFloat : Double;
63
(*
64
         class operator Explicit(const v : Int64) : BigInteger; inline;
65
*)
66
         class operator Add(const a, b : BigInteger) : BigInteger;
67
(*         class operator Add(const a : BigInteger; const b : Int64) : BigInteger;
68
         class operator Add(const a : Int64; const b : BigInteger) : BigInteger;
69
         class operator Subtract(const a, b : BigInteger) : BigInteger;
70
         class operator Subtract(const a : BigInteger; const b : Int64) : BigInteger;
71
         class operator Subtract(const a : Int64; const b : BigInteger) : BigInteger;
72

73
         class operator BitwiseAnd(const a, b : BigInteger) : BigInteger;
74
         class operator BitwiseOr(const a, b : BigInteger) : BigInteger;
75
         class operator BitwiseXor(const a, b : BigInteger) : BigInteger;
76
*)
77
         class operator Equal(const a, b : BigInteger) : Boolean;
78
         class operator NotEqual(const a, b : BigInteger) : Boolean; inline;
79
   end;
80

81
   EBigIntegerException = class (Exception);
82

83
// ------------------------------------------------------------------
84
// ------------------------------------------------------------------
85
// ------------------------------------------------------------------
86
implementation
87
// ------------------------------------------------------------------
88
// ------------------------------------------------------------------
89
// ------------------------------------------------------------------
90

91
// ------------------
92
// ------------------ TBigInteger ------------------
93
// ------------------
94

95
// Create
96
//
97
constructor TBigInteger.Create;
98
begin
99
   mpz_init(mpz);
100
end;
101

102
// Destroy
103
//
104
destructor TBigInteger.Destroy;
105
begin
106
   inherited;
107
   mpz_clear(mpz);
108
end;
109

110
// Obj
111
//
112
function TBigInteger.Obj : TBigInteger;
113
begin
114
   Result := Self;
115
end;
116

117
// Clone
118
//
119
function TBigInteger.Clone : TBigInteger;
120
begin
121
   Result := TBigInteger.Create;
122
   mpz_set(Result.mpz, mpz);
123
end;
124

125
// ------------------
126
// ------------------ BigInteger ------------------
127
// ------------------
128

129
// Allocate
130
//
131
procedure BigInteger.Allocate;
132
begin
133
   if FData=nil then FData := TBigInteger.Create;
134
end;
135

136
// Assign
137
//
138
procedure BigInteger.Assign(const v : Int32);
139
begin
140
   Allocate;
141
   mpz_set_si(FData.Obj.mpz, v);
142
end;
143

144
// Assign
145
//
146
procedure BigInteger.Assign(const v : Int64);
147
begin
148
   Allocate;
149
   mpz_set_int64(FData.Obj.mpz, v);
150
end;
151

152
// ToHexString
153
//
154
function BigInteger.ToHexString : String;
155
var
156
   n : Integer;
157
   obj : TBigInteger;
158
   buf : RawByteString;
159
begin
160
   if FData = nil then Exit('0');
161
   obj := FData.Obj;
162
   n := mpz_sizeinbase(obj.mpz, 16) + 1;
163
   SetLength(buf, n);
164
   mpz_get_str(PAnsiChar(buf), 16, obj.mpz);
165
   RawByteStringToScriptString(buf, Result);
166
end;
167

168
// FromHexString
169
//
170
procedure BigInteger.FromHexString(const s : String);
171
var
172
   i, len, err : Integer;
173
   nb32 : Integer;
174
   buf : RawByteString;
175
begin
176
   if s = '0' then begin
177
      FData := nil;
178
      Exit;
179
   end;
180
   ScriptStringToRawByteString(s, buf);
181
   Allocate;
182
   err := mpz_set_str(FData.Obj.mpz, PAnsiChar(s), 16);
183
   if err <> 0 then
184
      raise EBigIntegerException.CreateFmt('Conversion error from hexadecimal (%d)', [err]);
185
end;
186

187
// ToFloat
188
//
189
function BigInteger.ToFloat : Double;
190
begin
191
   if FData = nil then Exit(0);
192
   Result := mpz_get_d(FData.Obj.mpz);
193
end;
194

195
(*
196
// Explicit
197
//
198
class operator BigInteger.Explicit(const v : Int64) : BigInteger;
199
begin
200
   Result.Assign(v);
201
end;
202
*)
203
// Add
204
//
205
class operator BigInteger.Add(const a, b : BigInteger) : BigInteger;
206
begin
207
   if a.FData = nil then begin
208
      if b.FData = nil then
209
         Result.FData := nil
210
      else Result.FData := b.FData.Clone
211
   end else if b.FData = nil then
212
      Result.FData := a.FData.Clone
213
   else begin
214
      Result.Allocate;
215
      mpz_add(Result.FData.Obj.mpz, a.FData.Obj.mpz, b.FData.Obj.mpz);
216
   end;
217
end;
218
(*
219
// Add
220
//
221
class operator BigInteger.Add(const a : BigInteger; const b : Int64) : BigInteger;
222
begin
223
   Result := a + BigInteger(b);
224
end;
225

226
// Add
227
//
228
class operator BigInteger.Add(const a : Int64; const b : BigInteger) : BigInteger;
229
begin
230
   Result := BigInteger(a) + b;
231
end;
232

233
// Subtract
234
//
235
class operator BigInteger.Subtract(const a, b : BigInteger) : BigInteger;
236
begin
237
   Result.High := a.High - b.High;
238
   Result.Low := a.Low - b.Low;
239
   if Result.Low > a.Low then
240
      Dec(Result.High);
241
end;
242

243
// Subtract
244
//
245
class operator BigInteger.Subtract(const a : BigInteger; const b : Int64) : BigInteger;
246
begin
247
   Result := a - BigInteger(b);
248
end;
249

250
// Subtract
251
//
252
class operator BigInteger.Subtract(const a : Int64; const b : BigInteger) : BigInteger;
253
begin
254
   Result := BigInteger(a) - b;
255
end;
256

257
// BitwiseAnd
258
//
259
class operator BigInteger.BitwiseAnd(const a, b : BigInteger) : BigInteger;
260
begin
261
   Result.High := a.High and b.High;
262
   Result.Low := a.Low and b.Low;
263
end;
264

265
// BitwiseOr
266
//
267
class operator BigInteger.BitwiseOr(const a, b : BigInteger) : BigInteger;
268
begin
269
   Result.High := a.High or b.High;
270
   Result.Low := a.Low or b.Low;
271
end;
272

273
// BitwiseXor
274
//
275
class operator BigInteger.BitwiseXor(const a, b : BigInteger) : BigInteger;
276
begin
277
   Result.High := a.High xor b.High;
278
   Result.Low := a.Low xor b.Low;
279
end;
280
*)
281
// Equal
282
//
283
class operator BigInteger.Equal(const a, b : BigInteger) : Boolean;
284
var
285
   i, na : Integer;
286
begin
287
   mpz_cm
288
   Result:=(a.FHigh32=b.FHigh32);
289
   if Result then begin
290
      a.Pack;
291
      b.Pack;
292
      na:=Length(a.FData);
293
      if na = Length(b.FData) then begin
294
         for i := 0 to na-1 do begin
295
            if a.FData[i] <> b.FData[i] then begin
296
               Result := False;
297
               Break;
298
            end;
299
         end;
300
      end else Result := False;
301
   end;
302
end;
303

304
// NotEqual
305
//
306
class operator BigInteger.NotEqual(const a, b : BigInteger) : Boolean;
307
begin
308
   Result := not (a = b);
309
end;
310

311
end.
312