I'm reaching my limit with UInt64 and I was wondering if there are functions which do simple operating options such as +/- , etc. with just strings because they can store just as much RAM as you have... (theoretically)
For example I would like to calculate
24758800785707605497982484480 + 363463464326426 and get the result as a string.
I kinda know how to solve this problems with strings using the number system 0123456789 and kinda do digit by digit and overflow the next position - which would cost a lot more power, but I wouldn't mind this issue...
I would like to have this ability to do such calculations until my RAM just blows up (which would be the real limit...)
Are there such functions which already do that?
Arbitrarily large integers are not supported at the language level in Delphi, but a bit of Googling turns up http://www.delphiforfun.org/programs/Library/big_integers.htm, which can support them as alibrary.
On super computers, its called BCD math (Binary Coded Decimals) and each half-byte of RAM represents a decimal digit [0..9] - not an efficient use of RAM, but huge computations take minimal time (i.e. about 3 mSecs to multiply 2 million digit numbers. A BCD Emulator on a fast PC takes 5 or 6 minutes.
I never need to add big numbers, but I do multiply. Actually I call this routine iteratively to compute for example, 1000000 factorial (a 5,565,709 million digit answer. Str6Product refers to how it chops up a pair of string numbers. s1 and s2 have a practical length limit of about 2^31. The function is limited by what a "string can hold". Whatever that limit is, I've never gotten there.
//==============================================================================
function Str6Product(s1: string; s2: string): string; // 6-13 5:15 PM
var
so,snxt6 : string;
z1,z3, i, j, k : Cardinal; // Cardinal is 32-bit unsigned
x1,x3,xm : Cardinal;
countr : Cardinal;
a1, a2, a3 : array of Int64;
inum, icarry : uInt64; // uInt64 is 64-bit signed
begin
s1 := '00000'+s1;
s2 := '00000'+s2;
z1 := length(s1); // set size of Cardinal arrays
z3 := z1 div 6;
x1 := length(s2); // set size of Cardinal arrays
x3 := x1 div 6;
xm := max(x3,z3);
SetLength(a1,xm+1);
SetLength(a2,xm+1);
// try to keep s1 and s2 about the
// same length for best performance
for i := 1 to xm do begin // from rt 2 lft - fill arrays
// with 4-byte integers
if i <= z3 then a1[i] := StrToInt(copy (s1, z1-i*6+1, 6));
if i <= x3 then a2[i] := StrToInt(copy (s2, x1-i*6+1, 6));
if i > z3 then a1[i] := 0;
if i > x3 then a2[i] := 0;
end;
k := max(xm-x3, xm-z3); // k prevents leading zeroes
SetLength(a3,xm+xm+1);
icarry := 0; countr := 0;
icMax := 0; inMax := 0;
for i := 1 to xm do begin // begin 33 lines of "string mult" engine
inum := 0;
for j := 1 to i do
inum := inum + (a1[i-j+1] * a2[j]);
icarry := icarry + inum;
if icMax < icarry then icMax := icarry;
if inMax < inum then inMax := inum;
inum := icarry mod 1000000;
icarry := icarry div 1000000;
countr := countr + 1;
a3[countr] := inum;
end;
if xm > 1 then begin
for i := xm downto k+1 do begin // k or 2
inum := 0;
for j := 2 to i do
inum := inum + (a1[xm+j-i] * a2[xm-j+2]);
icarry := icarry + inum;
if icMax < icarry then icMax := icarry;
if inMax < inum then inMax := inum;
inum := icarry mod 1000000;
icarry := icarry div 1000000;
countr := countr + 1;
a3[countr] := inum;
end;
end;
if icarry >= 1 then begin
countr := countr + 1;
a3[countr] := icarry;
end;
so := IntToStr(a3[countr]);
for i := countr-1 downto 1 do begin
snxt6 := IntToStr(a3[i]+1000000);
so := so+ snxt6[2]+ snxt6[3]+ snxt6[4]+ snxt6[5]+ snxt6[6]+ snxt6[7];
end;
while so[1] = '0' do // leading zeroes may exist
so := copy(so,2,length(so));
result := so;
end;
//==============================================================================
Test call:
StrText := Str6Product ('742136061320987817587158718975871','623450632948509826743508972875');
I should have added that you should be able to add large numbers using the same methodology - From right to left, fragment the strings into 16 byte chunks then convert those chunks to uInt64 variables. Add the least significant digits first and if it produces a 17th byte, carry that over to the 2nd least significant chunk, add those two PLUS any carry over etc. When otherwise done, convert each 16-byte chunk back to string and concatenate accordingly.
The conversions to and from integer to string and vice-versa is a pain, but necessary for big number arithmetic.
Related
I made a program and it constantly tells me that the number I input isn't an integer.
I'm entering 100010110101 and it pops up with this error:
code:
procedure TForm1.Button1Click(Sender: TObject);
var
m,lo,cshl,cdhl,cjhl,csl,cdl,cjl:integer;
begin
m := StrToInt(Edit1.Text);
cshl := m div 100000000000;
cdhl := m div 10000000000 mod 10;
cjhl := m div 10000000000 mod 100;
csl := m div 1000000000 mod 1000;
cdl := m div 100000000 mod 10000;
cjl := m div 10000000 mod 100000;
lo := cjl + cdl * 10 + csl * 100 + cjhl * 1000 + cdhl * 10000 + cshl *100000;
ShowMessage(IntToStr(lo));
end;
Consider how Delphi (and most languages) handle 32-bit integers: Wikipedia
In this context, Integer is a 32-bit integer, and any value less than -2,147,483,648 or greater than 2,147,483,647 IS NOT a valid 32-bit integer.
The "common sense" would indicate, that integers range from -∞ to +∞, but that is not the case in computer architecture.
Use Int64 if you want to "cover" more values.
In your case, the code should look like this:
var
m,lo,cshl,cdhl,cjhl,csl,cdl,cjl:Int64;
begin
m := StrToInt64(Edit1.Text);
...
end;
Cheers
source array(4 bytes)
[$80,$80,$80,$80] =integer 0
[$80,$80,$80,$81] = 1
[$80,$80,$80,$FF] = 127
[$80,$80,$81,$01] = 128
need to convert this to integer.
below is my code and its working at the moment.
function convert(b: array of Byte): Integer;
var
i, st, p: Integer;
Negative: Boolean;
begin
result := 0;
st := -1;
for i := 0 to High(b) do
begin
if b[i] = $80 then Continue // skip leading 80
else
begin
st := i;
Negative := b[i] < $80;
b[i] := abs(b[i] - $80);
Break;
end;
end;
if st = -1 then exit;
for i := st to High(b) do
begin
p := round(Power(254, High(b) - i));
result := result + b[i] * p;
result := result - (p div 2);
end;
if Negative then result := -1 * result
end;
i'm looking for a better function?
Update:
file link
https://drive.google.com/file/d/0ByBA4QF-YOggZUdzcXpmOS1aam8/view?usp=sharing
in uploaded file ID field offset is from 5 to 9
NEW:
Now i got into new problem which is decoding date field
Date field hex [$80,$8F,$21,$C1] -> possible date 1995-12-15
* in uploaded file date field offset is from 199 to 203
Just an example of some improvements as outlined by David.
The array is passed by reference as a const.
The array is fixed in size.
The use of floating point calculations are converted directly into a constant array.
Const
MaxRange = 3;
Type
TMySpecial = array[0..MaxRange] of Byte;
function Convert(const b: TMySpecial): Integer;
var
i, j: Integer;
Negative: Boolean;
Const
// Pwr[i] = Round(Power(254,MaxRange-i));
Pwr: array[0..MaxRange] of Cardinal = (16387064,64516,254,1);
begin
for i := 0 to MaxRange do begin
if (b[i] <> $80) then begin
Negative := b[i] < $80;
Result := Abs(b[i] - $80)*Pwr[i] - (Pwr[i] shr 1);
for j := i+1 to MaxRange do
Result := Result + b[j]*Pwr[j] - (Pwr[j] shr 1);
if Negative then
Result := -Result;
Exit;
end;
end;
Result := 0;
end;
Note that less code lines is not always a sign of good performance.
Always measure performance before optimizing the code in order to find real bottlenecks.
Often code readability is better than optimizing over the top.
And for future references, please tell us what the algorithm is supposed to do.
Code for testing:
const
X : array[0..3] of TMySpecial =
(($80,$80,$80,$80), // =integer 0
($80,$80,$80,$81), // = 1
($80,$80,$80,$FF), // = 127
($80,$80,$81,$01)); // = 128
var
i,j: Integer;
sw: TStopWatch;
begin
sw := TStopWatch.StartNew;
for i := 1 to 100000000 do
for j := 0 to 3 do
Convert(X[j]);
WriteLn(sw.ElapsedMilliseconds);
ReadLn;
end.
For a registration code I want to convert an Int64 to base30 (30 so that only uppercase characters and excluding 0,O,I,1,etc.) and back.
This is not too difficult using functions like:
const
Base = 30;
Base30CharSet = '23456789ABCDEFGHJKLMNPRSTVWXYZ';
function ConvertIntToBase30(ANumber: Int64): string;
begin
if(ANumber = 0) then
Result := Copy(Base30CharSet, 1, 1)
else begin
Result := '';
while(ANumber <> 0) do begin
Result := Copy(Base30CharSet, (ANumber mod Base)+1, 1) + Result;
ANumber := ANumber div Base;
end;
end;
end;
function ConvertBase30ToInt(ANumber: string): Int64;
var
i: integer;
begin
Result := 0;
for i := 1 to Length(ANumber) do begin
Result := Result + (Pos(ANumber[i], Base30CharSet)-1);
if(i < Length(ANumber)) then
Result := Result * Base;
end;
end;
The snag is that I am interested in the Int64's bits, so I could be dealing with a number like $FFFFFFFFFFFFFFFF = -1.
To work around this I thought I would store and remove the sign (abs()) and include the sign as an extra character appended to the base30 result. The problem the occurs at the lower limit of Int64 as calling abs(-9223372036854775808) results in an overflow.
Does anyone have a solution or better algorithm to solve this problem?
The way to deal with it is having a character to indicate it is a negative number so that you can decode back. For negative number, just flip the bit from 1 to 0 and remove the sign bit before encoding and when decode, do a flip back and add the sign bit. Below is working codes
function InvertIntOff(const ANumberL, ANumberH: Integer): Int64;
asm
XOR EAX,$FFFFFFFF
XOR EDX,$FFFFFFFF
end;
function InvertIntOn(const ANumberL, ANumberH: Integer): Int64;
asm
XOR EAX,$FFFFFFFF
XOR EDX,$FFFFFFFF
OR EDX,$80000000
end;
function ConvertIntToBase(ANumber: Int64): string;
const
CBaseMap: array[0..31] of Char = (
'2','3','4','5','6','7','8','9', //0-7
'A','B','C','D','E','F','G','H', //8-15
'J','K','L','M','N', //16-20
'P','Q','R','S','T','U','V','X','W','Y','Z'); //21-31
var
I: Integer;
begin
SetLength(Result, 15);
I := 0;
if ANumber < 0 then
begin
Inc(I);
Result[I] := '1';
ANumber := InvertIntOff(ANumber and $FFFFFFFF, (ANumber and $FFFFFFFF00000000) shr 32);
end;
while ANumber <> 0 do
begin
Inc(I);
Result[I] := CBaseMap[ANumber and $1F];
ANumber := ANumber shr 5;
end;
SetLength(Result, I);
end;
function ConvertBaseToInt(const ABase: string): Int64;
var
I, Index: Integer;
N: Int64;
begin
Result := 0;
if Length(ABase) > 0 then
begin
if ABase[1] = '1' then
Index := 2
else
Index := 1;
for I := Index to Length(ABase) do
begin
case ABase[I] of
'2'..'9':
N := Ord(ABase[I]) - Ord('2');
'A'..'H':
N := Ord(ABase[I]) - Ord('A') + 8;
'J'..'N':
N := Ord(ABase[I]) - Ord('J') + 16;
'P'..'Z':
N := Ord(ABase[I]) - Ord('P') + 21;
else
raise Exception.Create('error');
end;
if I > Index then
Result := Result or (N shl ((I - Index) * 5))
else
Result := N;
end;
if ABase[1] = '1' then
Result := InvertIntOn(Result and $FFFFFFFF, (Result and $FFFFFFFF00000000) shr 32);
end;
end;
procedure TestBase32;
var
S: string;
begin
S := ConvertIntToBase(-1);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -1');
S := ConvertIntToBase(-31);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -31');
S := ConvertIntToBase(1);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? 1');
S := ConvertIntToBase(123456789);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? 123456789');
S := ConvertIntToBase(-123456789);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -123456789');
end;
I think you are almost there by considering abs()...
But rather than using abs() why not simply ignore the sign for processing the value of the Int64 itself ? As far as I can tell, you are in fact already doing this so only one minor addition is needed to the encoding routine:
if aNumber < 0 then
// negative
else
// positive;
The only problem then is the LOSS of sign information in the resulting Base30 string. So treat that as a separate problem to be solved using the new information gained from the aNumber < 0 test...
I see you have excluded all chars that could be confused for 0 or 1 but have also excluded 0 and 1 themselves. You could therefore use 0 and 1 to indicate positive or negative (or vice versa).
Depending on the purpose of these routines, the placement of the 0/1 in the result could be entirely arbitrary (if you wished to obfuscate things and make the placement of the 0/1 random rather than a consistent lead/trail character).
When encoding simply drop a sign indicator into the result string at random, and when decoding handle the 0/1 character whenever as the sign marker it is encountered, but skipped for the purposes of decoding the value.
Of course, if obfuscation is not an issue then simply consistently pre or post fix the sign indicator.
You could even simply choose to use '1' to indicate negative and the LACK of a '1' to indicate/assume positive (this would simplify the zero value case a little I think)
The easy answer is to turn range checking off, even just for the method that you're calling abs in.
If you don't care about an extra char or two you could split the int64 into words or dwords and string those together. I would be more tempted to go to base32 and use bit shifts for speed and ease of use. Then your encoding becomes
Base32CharSet[(ANumber shr 5) % 32]
and a similar pos() based approach for the decode.
I need to calculate Crc16 checksums with a $1021 polynom over large files, below is my current implementation but it's rather slow on large files (eg a 90 MB file takes about 9 seconds).
So my question is how to improve my current implementation (to make it faster), I have googled and looked at some samples implementing a table lookup but my problem is that I don't understand how to modify them to include the polynom (probably my math is failing).
{ based on http://miscel.dk/MiscEl/CRCcalculations.html }
function Crc16(const Buffer: PByte; const BufSize: Int64;
const Polynom: WORD=$1021; const Seed: WORD=0): Word;
var
i,j: Integer;
begin
Result := Seed;
for i:=0 to BufSize-1 do
begin
Result := Result xor (Buffer[i] shl 8);
for j:=0 to 7 do begin
if (Result and $8000) <> 0 then
Result := (Result shl 1) xor Polynom
else Result := Result shl 1;
end;
end;
Result := Result and $FFFF;
end;
If you want this to be fast, you need to implement a table-lookup CRC algorithm.
See chapter 10 of A PAINLESS GUIDE TO CRC ERROR DETECTION ALGORITHMS INDEX V3.00 (9/24/96)
Look for CRC routines from jclMath.pas unit of Jedi Code Library. It uses CRC lookup tables.
http://jcl.svn.sourceforge.net/viewvc/jcl/trunk/jcl/source/common/
Your Result variable is a Word, which means there are 64k possible values it could have upon entry to the inner loop. Calculate the 64k possible results that the loop could generate and store them in an array. Then, instead of looping eight times for each byte of the input buffer, simply look up the next value of the checksum in the array. Something like this:
function Crc16(const Buffer: PByte; const BufSize: Int64;
const Polynom: Word = $1021; const Seed: Word = 0): Word;
{$J+}
const
Results: array of Word = nil;
OldPolynom: Word = 0;
{$J-}
var
i, j: Integer;
begin
if (Polynom <> OldPolynom) or not Assigned(Results) then begin
SetLength(Results, 65535);
for i := 0 to Pred(Length(Results)) do begin
Results[i] := i;
for j := 0 to 7 do
if (Results[i] and $8000) <> 0 then
Results[i] := (Results[i] shl 1) xor Polynom
else
Results[i] := Results[i] shl 1;
end;
OldPolynom := Polynom;
end;
Result := Seed;
for i := 0 to Pred(BufSize) do
Result := Results[Result xor (Buffer[i] shl 8)];
end;
That code recalculates the lookup table any time Polynom changes. If that parameter varies among a set of values, then consider caching the lookup tables you generate for them so you don't waste time calculating the same tables repeatedly.
If Polynom will always be $1021, then don't even bother having a parameter for it. Calculate all 64k values in advance and hard-code them in a big array, so your entire function is reduced to just the last three lines of my function above.
Old thread, i know. Here is my implementation (just one loop):
function crc16( s : string; bSumPos : Boolean = FALSE ) : Word;
var
L, crc, sum, i, x, j : Word;
begin
Result:=0;
L:=length(s);
if( L > 0 ) then
begin
crc:=$FFFF;
sum:=length(s);
for i:=1 to L do
begin
j:=ord(s[i]);
sum:=sum+((i) * j);
x:=((crc shr 8) xor j) and $FF;
x:=x xor (x shr 4);
crc:=((crc shl 8) xor (x shl 12) xor (x shl 5) xor x) and $FFFF;
end;
Result:=crc+(Byte(bSumPos) * sum);
end;
end;
Nice thing is also that you can create an unique id with it, for example to get an unique identifier for a filename, like:
function uniqueId( s : string ) : Word;
begin
Result:=crc16( s, TRUE );
end;
Cheers,
Erwin Haantjes
I wrote this procedure based on integral image algorithm described at this url
http://people.scs.carleton.ca/~roth/iit-publications-iti/docs/gerh-50002.pdf
Is there any way to do this code faster?
Pointers are much faster as dynamic arrays?
procedure TForm1.bBinarizationClick(Sender: TObject);
var
iX1, iY1,
iX2, iY2,
ii, jj,
s, s2,
iSum, iCount, index,
iHeight, iWidth : Integer;
iSize: Integer;
row : ^TRGBTriple;
black : TRGBTriple;
aIntegralIm: array of Integer;
aGrays : array of Byte;
startTime : Cardinal;
begin
iWidth := bBitmap.Width;
iHeight := bBitmap.Height;
iSize := iWidth * iHeight;
SetLength(aGrays, iSize);
SetLength(aIntegralIm, iSize);
black.rgbtRed := (clBlack and $0000FF);
black.rgbtGreen := (clBlack and $00FF00) shr 8;
black.rgbtBlue := (clBlack and $FF0000) shr 16;
bBitmap2.Canvas.Brush.Color := clWhite;
bBitmap2.Canvas.FillRect(Rect(0, 0, bBitmap2.Width, bBitmap2.Height));
s := Round(iWidth / TrackBar2.Position);
s2 := Round(s / 2);
startTime := GetTickCount();
index := 0;
for ii := 0 to iHeight - 1 do begin
row := bBitmap.ScanLine[ii];
for jj := 0 to iWidth - 1 do begin
aGrays[index] := ((row.rgbtRed * 77 + row.rgbtGreen * 150 + row.rgbtBlue * 29) shr 8);
inc(index);
inc(row);
end;
end;
for ii := 0 to iWidth - 1 do begin
iSum := 0;
for jj := 0 to iHeight - 1 do begin
index := jj*iWidth+ii;
iSum := iSum + aGrays[index];
if ii = 0 then aIntegralIm[index] := iSum
else aIntegralIm[index] := aIntegralIm[index - 1] + iSum;
end;
end;
for jj := 0 to iHeight - 1 do begin
row := bBitmap2.ScanLine[jj];
for ii := 0 to iWidth - 1 do begin
index := jj*iWidth+ii;
iX1 := ii-s2;
iX2 := ii+s2;
iY1 := jj-s2;
iY2 := jj+s2;
if (iX1 < 0) then iX1 := 0;
if (iX2 >= iWidth) then iX2 := iWidth-1;
if (iY1 < 0) then iY1 := 0;
if (iY2 >= iHeight) then iY2 := iHeight-1;
iCount := (iX2 - iX1) * (iY2 - iY1);
iSum := aIntegralIm[iY2*iWidth+iX2]
- aIntegralIm[iY1*iWidth+iX2]
- aIntegralIm[iY2*iWidth+iX1]
+ aIntegralIm[iY1*iWidth+iX1];
if (aGrays[index] * iCount) < (iSum * (100 - TrackBar1.Position) / 100) then row^ := black;
inc(row);
end;
end;
ePath.Text := 'Time: ' + inttostr(GetTickCount() - startTime) + ' ms';
imgOryginal.Picture.Bitmap.Assign(bBitmap2);
end;
You can at least do a few simple things:
precalculate (100 - TrackBar1.Position) into a variable
Instead of division: / 100 use * 100 on the other side. You might not need any floating point values.
Use lookup tables for the following (care to explain the identation btw?):
Code:
if (iX1 < 0) then iX1 := 0;
if (iX2 >= iWidth) then iX2 := iWidth-1;
if (iY1 < 0) then iY1 := 0;
if (iY2 >= iHeight) then iY2 := iHeight-1;
Try to keep the index and icremnet, decrement istead of multiplication: index := jj*iWidth+ii;
My guess is that the second loop is the slow bit.
The trick would be to avoid to recalculate everything in the second loop all the time
If S is constant (relative to the loop I mean, not absolute)
iy1,iy2 only change with the main(jj) loop and so do iy1*width (and iy2*width).
Precalculate them, or optimize them away in the same way you do with row. (precalculate once per line, increment inbetween)
change the ii loop into three loops:
the first bit where ix1=0
the second where ix1=ii-s ix2=ii+s;
the third where ix1=ii-s and ix2=iwidth-1
this removes a lot of checks out of the loops, to be done only once.
make a dedicated loop for the condition if (aGrays[index] * iCount) < (iSum * (100 - TrackBar1.Position) / 100) then row^ := black; so that it isn't evaluated for each pixel, since you can precalculate the area's where this happens ?
introduce pointers into the gray calculating loop so that you don't have to recalculate the index each pixel (but e.g. only for the row loop, incrementing a ptr per pixel)
If you are hardy, you can also precalculate the jump between lines. Keep in mind that abs(scanline[j]-scanline[i])-width is a metric for the number of alignment bytes per row.
Even more advanced is optimizing for cache effects on the level of your algorithm. See
rotating bitmaps. In code
to get an idea how this works. Some pointer tricks are demonstrated there too (but only for 8-bit elements)
I would first use a profiler to find out the CPU usage repartition, to figure out the smallest part(s) of code that would benefit the most from optimisation.
Then I would adapt the effort according to the results. If some code represents 90% of the CPU load and is executed zillions of times, even extreme measures (recoding a few sequences using inline assembly language) might make sense.
Use the excellent and free SamplingProfiler to find out the bottleneck in your code. Then optimize and run the profiler again to find the next bottleneck. This approach is much better than guessing what's need to be optimized because even experts are often wrong about that.