I need to check if N values are equals.
var
A, B, C, D : Integer;
begin
...
if(A = B) and (B = C) and (C = D) then
ShowMessage('Same value');
end;
Is there a shorter way to compare N values?
I mean something like:
var
A, B, C, D : Integer;
begin
...
if SameValue([A, B, C, D]) then
ShowMessage('Same value');
end;
Well, the best you can achieve is basically your own suggestion.
You would implement this using an open array parameter:
function AllEqual(const AValues: array of Integer): Boolean;
var
i: Integer;
begin
for i := 1 to High(AValues) do
if AValues[i] <> AValues[0] then
Exit(False);
Result := True;
end;
The correctness of this implementation is obvious:
If the number of values in the array is 0 or 1, it returns True.
Otherwise, and in general, it returns False iff the array contains two non-equal values.
AValues[0] is only accessed if High(AValues) >= 1, in which case the 0th value exists.
A function like this one is straightforward to implement for ordinal types. For real types (floating-point values), it becomes much more subtle, at least if you want to compare the elements with epsilons (like the SameValue function does in the Delphi RTL). Indeed, then you get different behaviour depending on if you compare every element against the first element, or if you compare every element against its predecessor.
Andreas' answer is correct, I'd like to add a different approach though:
uses Math;
function AllEqual(const AValues: array of Integer): Boolean;
begin
Result := (MinIntValue(AValues) = MaxIntValue(AValues));
end;
function AllEqualF(const AValues: array of Double; Epsilon: Double): Boolean;
begin
Result := ((MaxValue(AValues)- MinValue(AValues)) <= Epsilon);
end;
There is quite simple and very fast equality comparison approach for ints without a need of additional method and stuff like this - it's Bitwise Operators
And of course, this could be put in a method with open array or so.
There are even 2 options (or maybe more), with second you also can replace "or" to "+" , OR (not both, it will ruin equality-test logic) you can replace "xor" to "-" (last case)
BUT the resulting condition length is not shorter than original (only the last case is same and all brackets/parenthesis are vital, except first xor/-), here is the testing code:
program Project1;{$APPTYPE CONSOLE}
uses Math; var a, b, c, d, x : Integer; s: string;
begin
Randomize;
repeat
x := Random(10) - 5;
a := x + Sign(Random() - 0.5);
b := x + Sign(Random() - 0.5);
c := x + Sign(Random() - 0.5);
d := x + Sign(Random() - 0.5);
Writeln(a, ' ', b, ' ', c, ' ', d);
Writeln((A = B) and (B = C) and (C = D));
Writeln(a or b or c or d = a and b and c and d);
Writeln(a xor b or (b xor c) or (c xor d) = 0);
Writeln(a - b or (b - c) or (c - d) = 0);
Readln(s);
until s <> '';
end.
Related
I have the following code for creating superscript versions of the digits '0' to '9' and the signs '+' and '-'
const
Digits = ['0' .. '9'];
Signs = ['+', '-'];
DigitsAndSigns = Digits + Signs;
function SuperScript(c: Char): Char;
{ Returns the superscript version of the character c
Only for the numbers 0..9 and the signs +, - }
const
SuperDigits: array ['0' .. '9'] of Char = ('⁰', '¹', '²', '³', '⁴', '⁵', '⁶', '⁷', '⁸', '⁹');
begin
if CharInSet(c, Digits) then
Result := SuperDigits[c]
else if c = '+' then
Result := '⁺'
else if c = '-' then
Result := '⁻'
else
Result := c;
end;
This works, but is not very elegant. Ideally I would like to have something like
SuperDigits: array [DigitsAndSigns] of Char = ('⁰', '¹', '²', '³', '⁴', '⁵', '⁶', '⁷', '⁸', '⁹', '⁺', '⁻');
but this does not even compile.
Is it somehow possible to create and preset an array element for every element in the set?
I am aware that I could use more heavy components like TDictionary, but (if possible) I would like to use sets or enumerations.
Actually there is a solution to achieve what you want, but perhaps not what you expected:
type
SuperDigit = record
private
class function GetItem(const C: Char): Char; static;
public
class property Item[const C: Char]: Char read GetItem; default;
end;
class function SuperDigit.GetItem(const C: Char): Char;
const
cDigitsAndSigns = '0123456789+-';
cSuperScripts = '⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻';
begin
Result := C;
var idx := Pos(C, cDigitsAndSigns);
if idx >= 0 then
Result := cSuperScripts[idx];
end;
With this declaration your can write something like this:
procedure ToSuperScript(var S: string);
begin
for var I := 1 to Length(S) do
S[I] := SuperDigit[S[I]];
end;
Is it somehow possible to create and preset an array element for every element in the set?
No.
This is fundamentally impossible because the set is an unordered container.
In your case, Digits + Signs is exactly the same thing as Signs + Digits, so how could you possibly know in what order to enumerate the elements?
Also, it might be worth pointing out that the brackets in
const
Digits = ['0' .. '9'];
are not of the same kind as the brackets in
array ['0' .. '9'] of Char
The brackets in Digits really do make a set, but the static array syntax has nothing to do with sets. A static array is indexed by an ordinal type.
In theory, you could create an enumerated type with your characters, but then you need to convert an input character to your enumerated type, and then back to the mapped character. So this is not convenient.
In your particular case, you have a mapping Char → Char. The underlying Unicode code points aren't really nice enough to facilitate any clever tricks (like you can do with ASCII lower case -> upper case, for example). In fact, the superscript digits are not even contiguous! So you have no choice but to do a plain, data-based mapping of some sort.
I'd just use a case construct like in UnicodeSuperscript here:
function UnicodeSuperscript(const C: Char): Char;
begin
case C of
'0':
Result := '⁰';
'1':
Result := '¹';
'2':
Result := '²';
'3':
Result := '³';
'4':
Result := '⁴';
'5':
Result := '⁵';
'6':
Result := '⁶';
'7':
Result := '⁷';
'8':
Result := '⁸';
'9':
Result := '⁹';
'+':
Result := '⁺';
'-', '−':
Result := '⁻';
else
Result := C;
end;
end;
In terms of elegance, I guess you may want to separate data from logic. One (overkill and slower!) approach would be to store a constant array like in
function UnicodeSuperscript(const C: Char): Char;
const
Chars: array[0..12] of
record
B,
S: Char
end
=
(
(B: '0'; S: '⁰'),
(B: '1'; S: '¹'),
(B: '2'; S: '²'),
(B: '3'; S: '³'),
(B: '4'; S: '⁴'),
(B: '5'; S: '⁵'),
(B: '6'; S: '⁶'),
(B: '7'; S: '⁷'),
(B: '8'; S: '⁸'),
(B: '9'; S: '⁹'),
(B: '+'; S: '⁺'),
(B: '-'; S: '⁻'),
(B: '−'; S: '⁻')
);
begin
for var X in Chars do
if C = X.B then
Exit(X.S);
Result := C;
end;
I have the following formula
X := X + F*(1-i div n);
Where
X, F, i, n: integer;
The code I'm using is this
F := 7; // the initial speed with no friction.
n := 10; // the animation number of steps.
Hn := n * 2 ;
X := 0; // first Pos
i := 1;
J := 1;
while J < Hn do
begin
X := X + F * (1 - i div n);
if X > Xmax then X := 0; <-- line (1).
if i >= n then Dec(i)
else Inc(i);
Inc(J);
end;
If it was possible I would like to use this but without class/record implementation(not inside a class/record implementation/method).not the exact syntax, just the same principle, instead of direct assignment to X the SetX is called then the result is assigned to X.
X: integer write SetX; // This is not a correct delphi syntax. I added it to explain the behavior I want.
function SetX(aValue: integer): integer;
const
Xmax: SomeIntegerValue;
begin
if aValue > Xmax then result := 0
else result := aValue;
end;
So I could omit Line (1). If this was possible, all the lines after the formula would be omitted and the while loop would look like this
while J < Hn do // J will be incremented each time the loop wants to read it.
begin
X := X + F * (1 - i div n);
end;
Is there anyway to use the property like behavior?
Note: I'm looking for a way to alter the assignment and reading ways of a variable like you do in a property of a record/class.
Is there anyway to use the property like approach outside a class/record?
No, property getters and setters can only be implemented in records and classes.
You can use local function like
procedure YourProcedure;
var
X: Integer;
LJ: Integer;
function J: Integer;
begin
Inc(LJ);
Result := LJ;
end;
procedure SetX(const AValue: Integer);
const
Xmax: SomeIntegerValue;
begin
if aValue > Xmax then X := 0
else X := aValue;
end;
//...
begin
while J < Hn do // J will be incremented each time the loop wants to read it.
begin
SetX(X + F * (1 - i div n));
end
end.
I found a way to do what I wanted. I know that overloading the := operator is not possible, However forcing the compiler to produce the same behavior as the overloaded operator would behave is possible.
The overloading would not let me control the LSA (Left Side Argument). but it gave full control to implicitly convert any TType (in my case it is an integer) to TXinteger. So all I had to do is make sure that every operator would result in a TType which will force the compiler to implicitly convert that to a TXinteger.
Forcing the compiler to use my implicit operator every time it wants to assign something to TXinteger means I control the assignment Hence I overloaded the := operator.
the following is a test example that makes omitting Line(1) possible.
program Project4;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TXinteger = record
X: integer;
class operator Add(a, b: TXinteger): integer;
class operator Add(a: TXinteger; b:integer): integer;
class operator Add(a: integer; b:TXinteger): integer;
class operator Implicit(a: Integer): TXinteger;
class operator Implicit(a: TXinteger): Integer;
end;
// Example implementation of Add
class operator TXinteger.Add(a, b: TXinteger): integer;
begin
result := a.X + b.X;
end;(**)
class operator TXinteger.Add(a: TXinteger; b:integer): integer;
begin
result := a.X + b;
end;
class operator TXinteger.Add(a: integer; b:TXinteger): integer;
begin
result := a + b.X;
end;
class operator TXinteger.Implicit(a: Integer): TXinteger;
const
Xmax: integer = 10;
begin
if a > Xmax then result.X := 0 else result.X := a;
end;
class operator TXinteger.Implicit(a: TXinteger): Integer;
begin
result := a.X;
end;
var
X: TXinteger;
Hn, F, i,J, n: integer;
begin
try
F := 7;
n := 10;
Hn := n * 2 ;
X := 0;
i := 1;
J := 1;
while J < Hn do
begin
X := X + F * (1 - i div n);
// Line (1) is gone now.
if i >= n then Dec(i)
else Inc(i);
Inc(J);
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Note: for this case it is pointless to do all of this just to omit one line of code. I wanted to share this because it gives an idea of how one could overload the := operator.
What I wanted is this:
Alter how X:Integer is read (value read from the variable x's storage).
Alter how X:Integer is assigned.
by overloading all the operators that use the value of X, I completed the first.
And by forcing the compiler as explained above, I completed the second.
Thank you all for your help.
Delphi has a number of documented operator overloads:
For records and ARC_classes (in the NexGen compiler).
Officially it does not support operator overloading for classes, interfaces or simple types.
Except...
There are undocumented operator overloads that do work on interfaces, classes and simple types.
(Although the undocumented operators do not seem to work on records).
E.g. The following code will compile and works:
Operator overloading for classes in Win32/64
//sorry for the horrible use of `or` to use for nil testing.
//I'd code this into a function (function FirstAssigned(a,b: TObject): TObject;
//It's just an example to demonstrate the concept.
type
TObjectHelper = class helper for TObject
public
class function &&op_LogicalOr<T: class>(A, B: T): T; static;
end;
class function TObjectHelper.&&op_LogicalOr<T>(A, B: T): T;
begin
if A <> nil then
Result := A
else
Result := B;
end;
procedure Test;
var
sl1, sl2, sl3: TStringList;
begin
sl1 := nil;
sl2 := TStringList.Create;
sl3 := sl1 or sl2; // -> sl3 = sl2
end;
For reference, here is a list of all allowed operators:
List of operators
class operator class function example
---------------------------------------------------
Implicit &&op_Implicit x:= y;
Explicit &&op_Explicit x:= integer(y);
Negative &&op_UnaryNegation x:= -y
Positive &&op_UnaryPlus x:= +y
Inc &&op_Increment Inc(x);
Dec &&op_Decrement Dec(y);
LogicalNot &&op_LogicalNot Not(y); //can be used for bitwise not as well
Trunc &&op_Trunc i:= trunc(f);
Round &&op_Round i:= round(f);
In &&op_In if (i in s) then
Equal &&op_Equality a = b
NotEqual &&op_Inequality a <> b
GreaterThan &&op_GreaterThan a > b
GreaterThanOrEqual &&op_GreaterThanOrEqual a >= b
LessThan &&op_LessThan a < b
LessThanOrEqual &&op_LessThanOrEqual a <= b
Add &&op_Addition a + b
Subtract &&op_Subtraction a - b
Multiply &&op_Multiply a * b
Divide &&op_Division a / b //floating point div
IntDivide &&op_IntDivide a div b //integer div
Modulus &&op_Modulus a mod b
LeftShift &&op_LeftShift a shl b
RightShift &&op_RightShift a shr b
LogicalAnd &&op_LogicalAnd if (a and b) then ...
LogicalOr &&op_LogicalOr if (a or b) then ....
LogicalXor &&op_ExclusiveOr if (a xor b) then
BitwiseAnd &&op_BitwiseAnd x:= a and b
BitwiseOr &&op_BitwiseOr x:= a or b
BitwiseXor &&op_BitwiseXOR x:= a xor b
Include &&op_Include include(s, i);
Exclude &&op_Exclude exclude(s, i);
How do I avoid running into memory leaks when using these overloads with (non-arc) classes?
How can you get cxGrid to preform sorting in
Latin-2 (ISO-8859-2) encoding ?
I don't want the grid to be dependent on the regional settings of Windows.
Problem is that I am in Slovenia but I need sorting in Croatian language.
(Right now Ć,Č,Š are not sorted properly)
Can it be done ?
You could hook the OnCompare-event exposed by the DataController of the DBTableView for the cxGrid and implement the handler something like this:
procedure TMyForm.cxGrid1DBTableView1DataControllerCompare(
ADataController: TcxCustomDataController;
ARecordIndex1, ARecordIndex2, AItemIndex: Integer;
const V1, V2: Variant;
var Compare: Integer );
var
S1, S2 : String;
CompareResult: Integer;
begin
S1 := V1;
S2 := V2;
CompareResult := CompareStringW( LANG_CROATIAN, 0, pWideChar( S1 ), -1,
pWideChar( S2 ), -1 );
case CompareResult of
CSTR_LESS_THAN : Compare := -1;
CSTR_EQUAL : Compare := 0;
CSTR_GREATER_THAN : Compare := 1;
end;
end;
If S1 = 'Ć,Č,Š' and S2 = 'Č,Ć,Š' then S1 > S2, which I think is what is expected. If you switch to LOCALE_NEUTRAL you get the opposite result.
Care should be taken when casting V1 and V2 to strings as not all columns may cast in the desired way. Dates - for example - might need special treatment.
Also note, that CompareStringW return 0 if the function fails. A full implementation may have to deal with this.
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.