I am trying to get the upper 4 bits of a Byte.
That is my attempt so far:
function Upper4Bits(const X : Byte): Byte;
type
BS = set of 0..7;
var
K : Byte; Q: BS;
begin
Q := [];
for K := 0 to 3 do {is it right? upper?}
{what i need here?}
Include(Q, {what i put here});
Upper4Bits := Byte(Q)
end;
Thanks In Advance.
According to your comment to kotlinski's answer, you want result := (byte1 and $F0) or (byte3 and $0F).
How about Upper4Bits := X Shr 4;?
Related
So I've come up with the code to the values of the triangle itself. What I'm currently strugling is how to aligne/center the values that are printed. I tried many things but, I could use some help now. If anyone has an idea how this can be done feel free to share! Thank you
Program Tri_pas;
Uses Crt;
Var
linha,ordem,a,b: byte;
Function fat(X: byte): real; // factorial
Var fat1: real;
Begin
fat1:=1;
If X <= 1 Then
fat:=1
Else
Begin
Repeat
fat1:=(fat1 * X);
X:=(X - 1);
Until X <= 1;
fat:=fat1;
End;
End;
Procedure nCp(n,p: byte); //Combinations
Var
i: byte;
nCp: real;
Begin
If n < 1 Then
n:=0
Else
n:=(n-1);
For i:=0 to n do
Begin
writeln;
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:1:0,' ');
End;
End;
End;
{ Main Programa }
Begin
Write('Insert a line(1 -> n) : ');
Readln(linha);
nCp(linha,ordem);
readln;
End.
Just add appropriate number of empty spaces before strings. Note that I used double-spaces, and changed placeholder size to 4 (3+1) to make better formatting.
For p := 1 to (n - i) do
Write(' ');
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:3:0,' ');
End;
P.S. There are more effective ways to calculate Ncr in reasonable range without real numbers.
procedure ReverseArray(var A : array of string);
var I,J,L : integer;
begin
for I := Low(A) to High(A) do
begin
L := length(A[I]);
for J := L downto 1 do M := M + A[I];
end;
writeln(M);
end;
begin
for I := 1 to 4 do readln(T[I]);
ReverseArray(T);
sleep(40000);
end.
What I'm trying to do here basically is reverse every string in the array but I'm unable to do it , what the code above do is basically repeat the words depends on their length (I write 'bob' in the array , the procedure will give me 'bob' three times because the length is 3) ... not sure why it's not working properly and what I'm missing
Delphi has a ReverseString() function in the StrUtils unit.
uses
StrUtils;
type
TStrArray = array of string;
procedure ReverseArray(var A : TStrArray);
var
I: integer;
begin
for I := Low(A) to High(A) do
A[I] := ReverseString(A[I]);
end;
var
T: TStrArray;
I: Integer
begin
SetLength(T, 4);
for I := 1 to 4 do Readln(T[I]);
ReverseArray(T);
...
end.
A string is an array of char with some extra bells and whistles added.
So an array of string is a lot like an array of array of char.
If you want to reverse the string, you'll have to access every char and reverse it.
procedure ReverseArray(var A : array of string);
var
i,j,Len : integer;
B: string;
begin
for i := Low(A) to High(A) do begin
Len := length(A[i]);
SetLength(B, Len); //Make B the same length as A[i].
//B[Len] = A[i][1]; B[Len-1]:= A[i][2] etc...
for j := Len downto 1 do B[j]:= A[i][(Len-J)+1];
//Store the reversed string back in the array.
A[i]:= B;
//Because A is a var parameter it will be returned.
//Writeln(B); //Write B for debugging purposes.
end;
end;
var
i: integer;
Strings: array [0..3] of string;
begin
for i := 0 to 3 do readln(Strings[i]);
ReverseArray(Strings);
for i := 0 to 3 do writeln(Strings[i]);
WriteLn('Done, press a key...');
ReadLn;
end.
Some tips:
Do not use global variables like M but declare a local variable instead.
Don't do AStr:= AStr + AChar in a loop, if you can avoid it. If you know how long the result is going to be use the SetLength trick as shown in the code. It's generates much faster code.
Instead of a Sleep you can use a ReadLn to halt a console app. It will continue as soon as you press a key.
Don't put the writeln in your working routine.
Note the first element in a string is 1, but the first element in a array is 0 (unless otherwise defined); Dynamic arrays always start counting from zero.
Note that array of string in a parameter definition is an open array; a different thing from a dynamic array.
Single uppercase identifiers like T, K, etc are usually used for generic types, you shouldn't use them for normal variables; Use a descriptive name instead.
Come on! 'bob' is one of those words you shouldn't try to test a reverse routine. But the problem goes beyond that.
Your problem is in here
for J := L downto 1 do
M := M + A[I];
You are trying to add the whole string to the M variable instead of the character you are trying to access. So, it should be
for J := L downto 1 do
M := M + A[I][J];
Also you need to set M := '' inside the first loop where it will have nothing when you start accumulating characters in to it.
Third, move the writing part, WriteLn(M), inside the first loop where you get a nice, separated outputs.
Putting together, it is going to be:
for I := Low(A) to High(A) do
begin
L := length(A[I]);
M := '';
for J := L downto 1 do
M := M + A[I][J];
writeln(M);
end;
My preferred solution for this is
type
TStringModifier = function(const s: string): string;
procedure ModifyEachOf( var aValues: array of string; aModifier: TStringModifier );
var
lIdx: Integer;
begin
for lIdx := Low(aValues) to High(aValues) do
aValues[lIdx] := aModifier( aValues[lIdx] );
end;
and it ends up with
var
MyStrings: array[1..3] of string;
begin
MyStrings[1] := '123';
MyStrings[2] := '456';
MyStrings[3] := '789';
ModifyEachOf( MyStrings, SysUtils.ReverseString );
end;
uses
System.SysUtils, System.StrUtils;
var
Forwards, backwards : string;
begin
forwards:= 'abcd';
backwards:= ReverseString(forwards);
Writeln(backwards);
Readln;
end;
// dcba
I came across the following (conceptually very simple) problem, and want to write code to do it, but am struggling. Let's say we have two rows of equal length, k. Each cell of each row can be either a 0 or a 1.
For e.g., consider the following row-pair, with k = 5: 01011, 00110
Now if the two rows could freely exchange values at each cell, there would be 2^5 possible combinations of row-pairs (some of which may not be unique). For instance, we could have 00010, 01111 as one possible row-pair from the above data. I want to write code in Delphi to list all the possible row-pairs. This is easy enough to do with a set of nested for-loops. However, if the value of k is known only at run-time, I'm not sure how I can use this approach for I don't know how many index variables I would need. I can't see how case statements will help either because I don't know the value of k.
I am hoping that there is an alternative to a nested for-loop, but any thoughts would be appreciated. Thanks.
Given two vectors A and B of length k, we can generate a new pair of vectors A1 and B1 by selectively choosing elements from A or B. Let our decision to choose from A or B be dictated by a bit vector S, also of length k. For i in [0..k), when Si is 0, store Ai in A1i and Bi in B1i. If Si is 1, then vice versa.
We can define that in Delphi with a function like this:
procedure GeneratePair(const A, B: string; S: Cardinal; out A1, B1: string);
var
k: Cardinal;
i: Cardinal;
begin
Assert(Length(A) = Length(B));
k := Length(A);
Assert(k <= 32);
SetLength(A1, k);
SetLength(B1, k);
for i := 1 to k do
if (S and (1 shl Pred(i))) = 0 then begin
A1[i] := A[i];
B1[i] := B[i];
end else begin
A1[i] := B[i];
B1[i] := A[i];
end;
end;
If we count in binary from 0 to 2k−1, that will give us a sequence of bit vectors representing all the possible combinations of exchanging or not-exchanging characters between A and B.
We can write a loop and use the above function to generate all 2k combinations:
A := '01011';
B := '00110';
for S := 0 to Pred(Round(IntPower(2, Length(A)))) do begin
GeneratePair(A, B, S, A1, B1);
writeln(A1, ', ', B1);
end;
That effectively uses one set of nested loops. The outer loop is the one from 0 to 31. The inner loop is the one inside the function from 1 to k. As you can see, we don't need to know the value of k in advance.
Now that, thanks to Rob, I understand the problem, I offer this recursive solution:
{$APPTYPE CONSOLE}
procedure Swap(var A, B: Char);
var
temp: Char;
begin
temp := A;
A := B;
B := temp;
end;
procedure Generate(const A, B: string; Index: Integer);
var
A1, B1: string;
begin
Assert(Length(A)=Length(B));
inc(Index);
if Index>Length(A) then // termination
Writeln(A, ', ', B)
else
begin // recurse
// no swap
Generate(A, B, Index);
//swap
A1 := A;
B1 := B;
Swap(A1[Index], B1[Index]);
Generate(A1, B1, Index);
end;
end;
begin
Generate('01011', '00110', 0);
Readln;
end.
I have a BIG problem here and do not even know how to start...
In short explanation, I need to know if a number is in a set of results from a random combination...
Let me explain better: I created a random "number" with 3 integer chars from 1 to 8, like this:
procedure TForm1.btn1Click(Sender: TObject);
var
cTmp: Char;
sTmp: String[3];
begin
sTmp := '';
While (Length(sTmp) < 3) Do
Begin
Randomize;
cTmp := IntToStr(Random(7) + 1)[1];
If (Pos(cTmp, sTmp) = 0) Then
sTmp := sTmp + cTmp;
end;
edt1.Text := sTmp;
end;
Now I need to know is some other random number, let's say "324" (example), is in the set of results of that random combination.
Please, someone can help? A link to get the equations to solve this problem will be enough...
Ok, let me try to add some useful information:
Please, first check this link https://en.wikipedia.org/wiki/Combination
Once I get some number typed by user, in an editbox, I need to check if it is in the set of this random combination: S = (1..8) and k = 3
Tricky, hum?
Here is what I got. Maybe it be usefull for someone in the future. Thank you for all people that tried to help!
Function IsNumOnSet(const Min, Max, Num: Integer): Boolean;
var
X, Y, Z: Integer;
Begin
Result := False;
For X := Min to Max Do
For Y := Min to Max Do
For Z := Min to Max Do
If (X <> Y) and (X <> Z) and (Y <> Z) Then
If (X * 100 + Y * 10 + Z = Num) Then
Begin
Result := True;
Exit;
end;
end;
You want to test whether something is a combination. To do this you need to verify that the putative combination satisfies the following conditions:
Each element is in the range 1..N and
No element appears more than once.
So, implement it like this.
Declare an array of counts, say array [1..N] of Integer. If N varies at runtime you will need a dynamic array.
Initialise all members of the array to zero.
Loop through each element of the putative combination. Check that the element is in the range 1..N. And increment the count for that element.
If any element has a count greater than 1 then this is not a valid combination.
Now you can simplify by replacing the array of integers with an array of booleans but that should be self evident.
You have your generator. Once your value is built, do something like
function isValidCode( Digits : Array of Char; Value : String ) : Boolean;
var
nI : Integer;
begin
for nI := 0 to High(Digits) do
begin
result := Pos(Digits[nI], Value ) > 0;
if not result then break;
end;
end;
Call like this...
isValidCode(["3","2","4"], RandomValue);
Note : it works only because you have unique digits, the digit 3 is only once in you final number. For something more generic, you'll have to tweak this function. (testing "3","3","2" would return true but it would be false !)
UPDATED :
I dislike the nested loop ^^. Here is a function that return the nTh digit of an integer. It will return -1 if the digits do not exists. :
function TForm1.getDigits(value : integer; ndigits : Integer ) : Integer;
var
base : Integer;
begin
base := Round(IntPower( 10, ndigits-1 ));
result := Trunc( value / BASE ) mod 10;
end;
nDigits is the digits number from right to left starting at 1. It will return the value of the digit.
GetDigits( 234, 1) returns 4
GetDigits( 234, 2) returns 3
GetDigits( 234, 3) returns 2.
GetDigits( 234, 4) returns 0.
Now this last function checks if a value is a good combination, specifying the maxdigits you're looking for :
function isValidCombination( value : integer; MinVal, MaxVal : Integer; MaxDigits : Integer ) : Boolean;
var
Buff : Array[0..9] of Integer;
nI, digit: Integer;
begin
ZeroMemory( #Buff, 10*4);
// Store the count of digits for
for nI := 1 to MaxDigits do
begin
digit := getDigits(value, nI);
Buff[digit] := Buff[digit] + 1;
end;
// Check if the value is more than the number of digits.
if Value >= Round(IntPower( 10, MaxDigits )) then
begin
result := False;
exit;
end;
// Check if the value has less than MaxDigits.
if Value < Round(IntPower( 10, MaxDigits-1 )) then
begin
result := False;
exit;
end;
result := true;
for nI := 0 to 9 do
begin
// Exit if more than One occurence of digit.
result := Buff[nI] < 2 ;
if not result then break;
// Check if digit is present and valid.
result := (Buff[nI] = 0) or InRange( nI, MinVal, MaxVal );
if not result then break;
end;
end;
Question does not seem too vague to me,
Maybe a bit poorly stated.
From what I understand you want to check if a string is in a set of randomly generated characters.
Here is how that would work fastest, keep a sorted array of all letters and how many times you have each letter.
Subtract each letter from the target string
If any value in the sorted int array goes under 0 then that means the string can not be made from those characters.
I made it just work with case insensitive strings but it can easily be made to work with any string by making the alphabet array 255 characters long and not starting from A.
This will not allow you to use characters twice like the other example
so 'boom' is not in 'b' 'o' 'm'
Hope this helps you.
function TForm1.isWordInArray(word: string; arr: array of Char):Boolean;
var
alphabetCount: array[0..25] of Integer;
i, baseval, position : Integer;
s: String;
c: Char;
begin
for i := 0 to 25 do alphabetCount[i] := 0; // init alphabet
s := UpperCase(word); // make string uppercase
baseval := Ord('A'); // count A as the 0th letter
for i := 0 to Length(arr)-1 do begin // disect array and build alhabet
c := UpCase(arr[i]); // get current letter
inc(alphabetCount[(Ord(c)-baseval)]); // add 1 to the letter count for that letter
end;
for i := 1 to Length(s) do begin // disect string
c := s[i]; // get current letter
position := (Ord(c)-baseval);
if(alphabetCount[position]>0) then // if there is still latters of that kind left
dec(alphabetCount[position]) // delete 1 to the letter count for that letter
else begin // letternot there!, exit with a negative result
Result := False;
Exit;
end;
end;
Result := True; // all tests where passed, the string is in the array
end;
implemented like so:
if isWordInArray('Delphi',['d','l','e','P','i','h']) then Caption := 'Yup' else Caption := 'Nope'; //yup
if isWordInArray('boom',['b','o','m']) then Caption := 'Yup' else Caption := 'Nope'; //nope, a char can only be used once
Delphi rocks!
begin
Randomize; //only need to execute this once.
sTmp := '';
While (Length(sTmp) < 3) Do
Begin
cTmp := IntToStr(Random(7) + 1)[1]; // RANDOM(7) produces # from 0..6
// so result will be '1'..'7', not '8'
// Alternative: clmp := chr(48 + random(8));
If (Pos(cTmp, sTmp) = 0) Then
sTmp := sTmp + cTmp;
IF SLMP = '324' THEN
DOSOMETHING; // don't know what you actually want to do
// Perhaps SET SLMP=''; to make sure '324'
// isn't generated?
end;
edt1.Text := sTmp;
end;
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