Reading bit by bit out of bytes - simplification/speed-up suggestions - Delphi - delphi
I have a device that sends couple bytes of info about its status, and the first 5 bytes are statuses of 40 pushbuttons. Each bit represents one button, being 1 for released and 0 for pressed.
From that matter, I was doing a checkout using this piece of code:
procedure TForm2.ServerUDPRead(AThread: TIdUDPListenerThread;
AData: array of Byte; ABinding: TIdSocketHandle);
var received: array [0..4] of string; a1, a2 integer;
bits: array [0..40] of boolean;
begin
for a1 := 0 to 4 do
Received[a1] := (ByteToBin(AData[a1]));
for a1 := 4 downto 0 do
begin
for a2 := 1 to 8 do
begin
if Copy(Received[a1], a2, 1) = '0' then bits[(4-a1)*8+(a2-1)]:=False else bits[(4-a1)*8+(a2-1)]:=True;
end;
end;
ByteToBin being function for coverting byte to string of 8 bits...
Is there an alternate "easier", simplified and (what I'm actually interested in) faster procedure for achieving what I need, or is this way good enough?
I find it a bit sluggish and dirty... :/ (although ultimately, does it's intention... so interested mostly out of learning point of view)
With this you an convert directly from AData to array of boolean:
for i := 0 to 39 do
bits[i] := (AData[i div 8] and (1 shl (i mod 8))) <> 0;
I'm not sure if the order of the booleans is exactly the same, I lost count with all your indexes :)
An alternative approach is using a set:
type
TByteSet = set of 0..7;
...
for I := 0 to 39 do begin
bits[I] := (I mod 8) in TByteSet(AData[I div 8]);
end;
Related
CRC-32 check fails with DEC 5.2
I've written two simple button handlers to test/demonstrate CRC16 and CRC32 from the Delphi Encryption Compendium 5.2. The code for CRC16 works fine, but the validation for CRC32 allways fails. I'm using a 512 byte array where the last 2 or 4 bytes (for crc16 or crc32) are reserved for the checksum. Whats wrong with the code for CRC-32? My first idea was that there is an issue with byte order, but then crc16 code should fail, too. procedure TForm3.CRC16Click(Sender: TObject); var LData: array[1..512] of Byte; FSum: Cardinal; FIntPtr: Pointer; begin FillChar(LData, sizeof(LData), 0); LData[1] := $FF; // set some test data FSum := CRCCalc(CRC_16, LData, (SizeOf(LData)-sizeof(Word))); FIntPtr := #LData[512-1]; // don't get confused by -1... PWord(FIntPtr)^ := FSum and $FFFF; Assert( CRCCalc(CRC_16, LData, (SizeOf(LData))) = 0); // THIS WORKS! end; procedure TForm3.CRC32Click(Sender: TObject); var LData: array[1..512] of Byte; FSum: Cardinal; FIntPtr: Pointer; begin FillChar(LData, sizeof(LData), 0); LData[1] := $FF; // set some test data FSum := CRCCalc(CRC_32, LData, (SizeOf(LData)-sizeof(Cardinal))); FIntPtr := #LData[512-3]; // don't get confused by -3... PCardinal(FIntPtr)^ := FSum; Assert( CRCCalc(CRC_32, LData, (SizeOf(LData))) = 0); // ASSERT FAILURE! <<< end;
Your assertion is based on the following property holding: CRC(arr + [CRC(arr)]) = 0 where I am using + to indicate array concatenation. I believe that the particular CRC32 implementation that DEC exposes does not have this property. DEC offers three CRC32 variants, named CRC_32, CRC_32CCITT and CRC_32ZModem. Only CRC_32ZModem has the property that you assert. Serg suggests that you should be asserting that: not CRC(arr + [not CRC(arr)]) = 0 which holds for CRC_32 and CRC_32CCITT, but not for CRC_32ZModem.
Convert an Octal number to Decimal and Hexadecimal
I am writing a program that converts an Octal number to Decimal and Hexadecimal. I wrote a function called OctToInt. function OctToInt(Value: string): Longint; var i: Integer; int: Integer; begin int := 0; for i := 0 to Length(Value) do begin int := int * 8 + StrToInt(Copy(Value, i, 1)); end; Result := int; end; I call this function in this way: var oct:integer; begin oct:=OctToInt(Edit13.Text); Edit15.Text:=IntToStr(oct); end; When I type 34 (Octal) the decimal number should be 28 but the program gives me 220. Do you know why? Also, do you have any idea about a converter OctToHex?
You have to change the start of "your" for with 1. function OctToInt(Value: string): Longint; var i: Integer; int: Integer; begin int := 0; for i := 1 to Length(Value) do //here you need 1, not 0 begin int := int * 8 + StrToInt(Copy(Value, i, 1)); end; Result := int; end; The conversion Octal-Hexadecimal could be hard to do, so I suggest you another way: EditHexadecimal.Text:=(IntToHex(StrToInt(EditInteger.Text),8)); As you can see here, with this code the EditHexadecimal is the Edit where you put the hexadecimal number. With that line I convert a number from decimal to hexadecimal. You already have the decimal number because you get it with the function OctToInt, so you don't need more code.
This code accepts a string with a base-8 representation of an integer, and returns the corresponding integer: function IntPower(const N, k: integer): integer; var i: Integer; begin result := 1; for i := 1 to k do result := result * N; end; function OctToInt(const Value: string): integer; var i: integer; begin result := 0; for i := 1 to Length(Value) do inc(result, StrToInt(Value[i]) * IntPower(8, Length(Value) - i)); end; When it comes to converting an integer to a hexadecimal string representation, you already have IntToHex.
i made this formula so you can process octals in batches of 3-digits at a time - it's been tested from 000 through 777 to perfectly generate the decimal integer from octals :
if your octals are in a variable oct and temp placeholder o2
then
(37 < oct % 100)*8 + int(0.08*(oct-(o2=oct%10))+0.7017)*8 + o2
if you wanna further streamline that without the placeholder, then its
(37 < oct%100)*8 + int(0.7017+0.08*(oct-(oct%=10)))*8 + oct
the "0.7017" is possibly sin(-10*π/8) or 1/sqrt(2), or just 2^(1/-2), but since i found the formula via regression i'm not 100% sure on this.
Another fast trick is that if all 3 digits are the same number - 222 333 555 etc, simply take the first digit then multiply by 73 (cuz 73 in octal is 111). The sequence chain of multipliers for 2-6 consecutive matching digits are
9, 73, 585, 4681, 37449
(it also happens that within this list, for each x,
one of {x-2,x+0,x+2} is prime
Power set of an array in Delphi
I'm trying to write a function that will take an array on input and return array of arrays, containing all possible subsets of input array (power set without empty element). For example for input: [1, 2, 3] the result would be [[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]]. This function does the job in python: def list_powerset(lst): result = [[]] for x in lst: result += [subset + [x] for subset in result] result.pop(0) return result But I'm looking for implementation of it in Delphi. Is this possible to accomplish this way or should I look for something else?
type TIdArray = array of Integer; TPowerSet = array of TIdArray; function PowerSet(Ids: TIdArray): TPowerSet; // Implementation loosely based on the explanation on // http://www.mathsisfun.com/sets/power-set.html var TotalCombinations: Integer; TotalItems: Integer; Combination: Integer; SourceItem: Integer; ResultItem: Integer; Bit, Bits: Integer; begin TotalItems := Length(Ids); // Total number of combination for array of n items = 2 ^ n. TotalCombinations := 1 shl TotalItems; SetLength(Result, TotalCombinations); for Combination := 0 to TotalCombinations - 1 do begin // The Combination variable contains a bitmask that tells us which items // to take from the array to construct the current combination. // Disadvantage is that because of this method, the input array may contain // at most 32 items. // Count the number of bits set in Combination. This is the number of items // we need to allocate for this combination. Bits := 0; for Bit := 0 to TotalItems - 1 do if Combination and (1 shl Bit) <> 0 then Inc(Bits); // Allocate the items. SetLength(Result[Combination], Bits); // Copy the right items to the current result item. ResultItem := 0; for SourceItem := 0 to TotalItems - 1 do if Combination and (1 shl SourceItem) <> 0 then begin Result[Combination][ResultItem] := Ids[SourceItem]; Inc(ResultItem); end; end; end;
My other answer is a piece of code I created a while ago when I needed in in Delphi 2007. To make it more generic, you can use generics. Now I haven't actually used generics before, but it seems to work like this. I must admit I had to peek here to check the syntax. If there's an easier way, I hope someone else can post it. The code is in fact practically unaltered, except the name of the input parameter. (Yay, generics!) type TGenericArray<T> = array of T; TGenericPowerSet<T> = array of array of T; TPowerSet<T> = class(TObject) public class function Get(a: TGenericArray<T>): TGenericPowerSet<T>; end; class function TPowerSet<T>.Get(a: TGenericArray<T>): TGenericPowerSet<T>; var TotalCombinations: Integer; TotalItems: Integer; Combination: Integer; SourceItem: Integer; ResultItemIncluded: Integer; Bit, Bits: Integer; begin TotalItems := Length(a); // Total number of combination for array of n items = 2 ^ n. TotalCombinations := 1 shl TotalItems; SetLength(Result, TotalCombinations); for Combination := 0 to TotalCombinations - 1 do begin // The Combination variable contains a bitmask that tells us which items // to take from the array to construct the current combination. // Disadvantage is that because of this method, the input array may contain // at most 32 items. // Count the number of bits set in Combination. This is the number of items // we need to allocate for this combination. Bits := 0; for Bit := 0 to TotalItems - 1 do if Combination and (1 shl Bit) <> 0 then Inc(Bits); // Allocate the items. SetLength(Result[Combination], Bits); // Copy the right items to the current result item. ResultItemIncluded := 0; for SourceItem := 0 to TotalItems - 1 do if Combination and (1 shl SourceItem) <> 0 then begin Result[Combination][ResultItemIncluded] := a[SourceItem]; Inc(ResultItemIncluded); end; end; end; And use like this: var p: TPowerSet<String>; a: TGenericArray<String>; r: TGenericPowerSet<String>; begin SetLength(a, 2); a[0] := 'aaa'; a[1] := 'bbb'; r := p.Get(a); ShowMessage(IntToStr(Length(r))); ShowMessage(r[1][0]);
how to improve the code (Delphi) for loading and searching in a dictionary?
I'm a Delphi programmer.
I have made a program who uses dictionaries with words and expressions (loaded in program as "array of string").
It uses a search algorithm based on their "checksum" (I hope this is the correct word).
A string is transformed in integer based on this:
var
FHashSize: Integer; //stores the value of GetHashSize
HashTable, HashTableNoCase: array[Byte] of Longword;
HashTableInit: Boolean = False;
const
AnsiLowCaseLookup: array[AnsiChar] of AnsiChar = (
#$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07,
#$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F,
#$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17,
#$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F,
#$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27,
#$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F,
#$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37,
#$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F,
#$40, #$61, #$62, #$63, #$64, #$65, #$66, #$67,
#$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F,
#$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77,
#$78, #$79, #$7A, #$5B, #$5C, #$5D, #$5E, #$5F,
#$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67,
#$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F,
#$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77,
#$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F,
#$80, #$81, #$82, #$83, #$84, #$85, #$86, #$87,
#$88, #$89, #$8A, #$8B, #$8C, #$8D, #$8E, #$8F,
#$90, #$91, #$92, #$93, #$94, #$95, #$96, #$97,
#$98, #$99, #$9A, #$9B, #$9C, #$9D, #$9E, #$9F,
#$A0, #$A1, #$A2, #$A3, #$A4, #$A5, #$A6, #$A7,
#$A8, #$A9, #$AA, #$AB, #$AC, #$AD, #$AE, #$AF,
#$B0, #$B1, #$B2, #$B3, #$B4, #$B5, #$B6, #$B7,
#$B8, #$B9, #$BA, #$BB, #$BC, #$BD, #$BE, #$BF,
#$C0, #$C1, #$C2, #$C3, #$C4, #$C5, #$C6, #$C7,
#$C8, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE, #$CF,
#$D0, #$D1, #$D2, #$D3, #$D4, #$D5, #$D6, #$D7,
#$D8, #$D9, #$DA, #$DB, #$DC, #$DD, #$DE, #$DF,
#$E0, #$E1, #$E2, #$E3, #$E4, #$E5, #$E6, #$E7,
#$E8, #$E9, #$EA, #$EB, #$EC, #$ED, #$EE, #$EF,
#$F0, #$F1, #$F2, #$F3, #$F4, #$F5, #$F6, #$F7,
#$F8, #$F9, #$FA, #$FB, #$FC, #$FD, #$FE, #$FF);
implementation
function GetHashSize(const Count: Integer): Integer;
begin
if Count < 65 then
Result := 256
else
Result := Round(IntPower(16, Ceil(Log10(Count div 4) / Log10(16))));
end;
function Hash(const Hash: LongWord; const Buf; const BufSize: Integer): LongWord;
var P: PByte;
I: Integer;
begin
P := #Buf;
Result := Hash;
for I := 1 to BufSize do
begin
Result := HashTable[Byte(Result) xor P^] xor (Result shr 8);
Inc(P);
end;
end;
function HashStrBuf(const StrBuf: Pointer; const StrLength: Integer; const Slots: LongWord): LongWord;
var P: PChar;
I, J: Integer;
begin
if not HashTableInit then
InitHashTable;
P := StrBuf;
if StrLength <= 48 then // Hash all characters for short strings
Result := Hash($FFFFFFFF, P^, StrLength)
else
begin
// Hash first 16 bytes
Result := Hash($FFFFFFFF, P^, 16);
// Hash last 16 bytes
Inc(P, StrLength - 16);
Result := Hash(Result, P^, 16);
// Hash 16 bytes sampled from rest of string
I := (StrLength - 48) div 16;
P := StrBuf;
Inc(P, 16);
for J := 1 to 16 do
begin
Result := HashTable[Byte(Result) xor Byte(P^)] xor (Result shr 8);
Inc(P, I + 1);
end;
end;
// Mod into slots
if Slots <> 0 then
Result := Result mod Slots;
end;
procedure InitHashTable;
var I, J: Byte;
R: LongWord;
begin
for I := $00 to $FF do
begin
R := I;
for J := 8 downto 1 do
if R and 1 <> 0 then
R := (R shr 1) xor $EDB88320
else
R := R shr 1;
HashTable[I] := R;
end;
Move(HashTable, HashTableNoCase, Sizeof(HashTable));
for I := Ord('A') to Ord('Z') do
HashTableNoCase[I] := HashTableNoCase[I or 32];
HashTableInit := True;
end;
The result of the HashStrBuf is "and (FHashSize - 1)" and is used as index in an "array of array of Integer" (of FHashSize size) to store the index of the string from that "array of string".
This way, when searches for a string, it's transformed in "checksum" and then the code searches in the "branch" with this index comparing this string with the strings from dictionary who have the same "checksum".
Ideally each string from dictionary should have unique checksum. But in the "real world" about 2/3 share the same "checksum" with other words. Because of that the search is not that fast.
In these dictionaries strings are composed of this characters: ['a'..'z',#224..#246,#248..#254,#154,#156..#159,#179,#186,#191,#190,#185,'0'..'9', '''']
Is there any way to improve the "hashing" so the strings would have more unique "checksums"?
Oh, one way is to increase the size of that "array of array of Integer" (FHashSize) but it cannot be increased too much because it takes a lot of Ram.
Another thing: these dictionaries are stored on HDD only as words/expressions (not the "checksums"). Their "checksum" is generated at program startup. But it takes a lot of seconds to do that...
Is there any way to speed up the startup of the program? Maybe by improving the "hashing" function, maybe by storing the "checksums" on HDD and loading them from there...
Any input would be appreciated...
PS: here is the code to search:
function TDictionary.LocateKey(const Key: AnsiString): Integer;
var i, j, l, H: Integer;
P, Q: PChar;
begin
Result := -1;
l := Length(Key);
H := HashStrBuf(#Key[1], l, 0) and (FHashSize - 1);
P := #Key[1];
for i := 0 to High(FHash[H]) do //FHash is that "array of array of integer"
begin
if l <> FKeys.ItemSize[FHash[H][i]] then //FKeys.ItemSize is an byte array with the lengths of strings from dictionary
Continue;
Q := FKeys.Pointer(FHash[H][i]); //pointer to string in dictionary
for j := 0 to l - 1 do
if (P + j)^ <> (Q + j)^ then
Break;
if j = l then
begin
Result := FHash[H][i];
Exit;
end;
end;
end;
Don't reinvent the wheel!
IMHO your hashing is far from efficient, and your collision algorithm can be improved.
Take a look for instance at the IniFiles unit, and the THashedStringList.
It's a bit old, but a good start for a string list using hashes.
There are a lot of good Delphi implementation of such, like in SuperObject and a lot of other code...
Take a look at our SynBigTable unit, which can handle arrays of data in memory or in file very fast, with full indexed searches. Or our latest TDynArray wrapper around any dynamic array of data, to implement TList-like methods to it, including fast binary search. I'm quite sure it could be faster than your hand-tuned code using hashing, if you use an ordered index then fast binary search.
Post-Scriptum:
About pure hashing speed of a string content, take a look at this function - rename RawByteString into AnsiString, PPtrInt into PPointer, and PtrInt into Integer for Delphi 7:
function Hash32(const Text: RawByteString): cardinal;
function SubHash(P: PCardinalArray): cardinal;
{$ifdef HASINLINE}inline;{$endif}
var s1,s2: cardinal;
i, L: PtrInt;
const Mask: array[0..3] of cardinal = (0,$ff,$ffff,$ffffff);
begin
if P<>nil then begin
L := PPtrInt(PtrInt(P)-4)^; // fast lenght(Text)
s1 := 0;
s2 := 0;
for i := 1 to L shr 4 do begin // 16 bytes (4 DWORD) by loop - aligned read
inc(s1,P^[0]);
inc(s2,s1);
inc(s1,P^[1]);
inc(s2,s1);
inc(s1,P^[2]);
inc(s2,s1);
inc(s1,P^[3]);
inc(s2,s1);
inc(PtrUInt(P),16);
end;
for i := 1 to (L shr 2)and 3 do begin // 4 bytes (DWORD) by loop
inc(s1,P^[0]);
inc(s2,s1);
inc(PtrUInt(P),4);
end;
inc(s1,P^[0] and Mask[L and 3]); // remaining 0..3 bytes
inc(s2,s1);
result := s1 xor (s2 shl 16);
end else
result := 0;
end;
begin // use a sub function for better code generation under Delphi
result := SubHash(pointer(Text));
end;
There is even a pure asm version, even faster, in our SynCommons.pas unit. I don't know any faster hashing function around (it's faster than crc32/adler32/IniFiles.hash...). It's based on adler32, but use DWORD aligned reading and summing for even better speed. This could be improved with SSE asm, of course, but here is a fast pure Delphi hash function.
Then don't forget to use "multiplication"/"binary and operation" for hash resolution, just like in IniFiles. It will reduce the number of iteration to your list of hashs.
But since you didn't provide the search source code, we are not able to know what could be improved here.
If you are using Delphi 7, consider using Julian Bucknall's lovely Delphi data types code, EzDsl (Easy Data Structures Library). Now you don't have to reinvent the wheel as another wise person has also said. You can download ezdsl, a version that I have made work with both Delphi 7, and recent unicode delphi versions, here. In particular the unit name EHash contains a hash table implementation, which has various hashing algorithms plug-inable, or you can write your own plugin function that just does the hashing function of your choice. As a word to the wise, if you are using a Unicode Delphi version; I would be careful about hashing your unicode strings with a code library like this, without checking how its hashing algorithms perform on your system. The OP here is using Delphi 7, so Unicode is not a factor for the original question.
I think you'll find a database (without checksums) a lot quicker. Maybe try sqlite which will give you a single file database. There are many Delphi Libraries available.
Improve speed on Crc16 calculation
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