I have a huge list of users and every user has it's id , but it id numbers are messed up so if anyone can show me how can I sort users by numbers , every value has this form
1:Stackoverflow
or
145000:Google
If I do that manually I think I will lose my mind since tehere are more than 700000 records.Thanks for your time and help....
Extract the number like this:
function ID(const str: string): Integer;
var
p: Integer;
begin
p := Pos(':', str);
if p=0 then
raise Exception.CreateFmt('Invalid string format: %s', [str]);
Result := StrToInt(Copy(str, 1, p-1));
end;
Once you can extract the ID as an integer you can then write a compare function. Like this:
function CompareIDs(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := CompareValue(
ID(List[Index1]),
ID(List[Index2])
);
end;
CompareValue is an RTL function that returns -1, 0 or 1 depending on the relative values of the two operands.
Feed these building blocks into TStringList.CustomSort and your job is done.
MyStringList.CustomSort(CompareIDs);
Related
I know, I can write
if C in ['#', ';'] then ...
if C is an AnsiChar.
But this
function CheckValid(C: Char; const Invalid: array of Char; OtherParams: TMyParams): Boolean;
begin
Result := C in Invalid; // <-- Error because Invalid is an array not a set
//maybe other tests...
//Result := Result and OtherTestsOn(OtherParams);
end;
yields E2015: Operator not applicable to this operand type.
Is there an easy way to check if a character is contained in an array of characters (other than iterate through the array)?
I know you don't want to, but this is one of those cases where iterating through the array really is your best option, for performance reasons:
function CheckValid(C: Char; const Invalid: array of Char): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(Invalid) to High(Invalid) do begin
if Invalid[I] = C then begin
Result = True;
Exit;
end;
end;
end;
Or:
function CheckValid(C: Char; const Invalid: array of Char): Boolean;
var
Ch: Char;
begin
Result := False;
for Ch in Invalid do begin
if Ch = C then begin
Result = True;
Exit;
end;
end;
end;
Converting the input data to strings just to search it can cause huge performance bottlenecks, especially if the function is called often, such as in a loop.
If one tries to avoid iterating through the array and if speed is of no concern then IndexOfAny can be helpful:
function CheckValid(C: Char; const Invalid: array of Char; OtherParams: TMyParams): Boolean;
begin
Result := string(C).IndexOfAny(Invalid) >= 0;
//maybe other test...
//....
end;
From the Delphi documentation:
[IndexOfAny r]eturns an integer indicating the position of the first given character found in the 0-based string. [It returns -1 if the character is not found.]
If speed is of concern, this should be avoided as #RemyLebeau explains in the comments:
Casting C to String to call IndexOfAny() will create 1 temp String. [...] if CheckValid() is called often, those conversions can be a BIG performance bottleneck, not to mention a waste of memory.
In this case #RemyLebeau's answer is the better solution.
I have a TStringList in Delphi.
after the items are inserted i call .sort procedure to sort the items.
the Items are first names followed by last names. for example: "John Smith".
I want to sort the items by last name. I mean by the first character after the space.
how can I do this?
and also the items may be unicode strings like persian characters.
I'd use the CustomSort method of TStringList to supply a custom compare function. First of all, let's imagine that we have already got the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := ...;
end;
This function will (in due course) return negative to mean less than, positive to mean greater than and zero to mean equal.
Then we sort the list like this:
List.CustomSort(NameCompareFunc);
So, that's the easy bit done. But how do we implement NameCompareFunc? First of all let's split the name into last name and the rest.
procedure SplitName(const Name: string; out Last, Rest: string);
var
P: Integer;
begin
P := Pos(' ', Name);
if P = 0 then begin
Last := Trim(Name);
Rest := '';
end else begin
Last := Trim(Copy(Name, P+1, MaxInt));
Rest := Trim(Copy(Name, 1, P-1));
end;
end;
This is a pretty naive way to split a name. You'd probably want to search for separators starting from the end of the name, but I'll let you decide how to do that.
Now we can implement the compare function:
function NameCompareFunc(List: TStringList; Index1, Index2: Integer): Integer;
var
Last1, Last2, Rest1, Rest2: string;
begin
SplitName(List[Index1], Last1, Rest1);
SplitName(List[Index2], Last2, Rest2);
Result := AnsiCompareText(Last1, Last2);
if Result = 0 then begin
Result := AnsiCompareText(Rest1, Rest2);
end;
end;
Some notes:
I'm assuming that name comparison should always be case-insensitive.
We use AnsiCompareText to perform locale aware comparison.
If we encounter two names that have the same last name, then we implement a secondary comparison o the rest of the name.
You could use the CustomSort methos of Stringlist:
function LastNameCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
var
S1, S2: string;
SpaceIndex: Integer;
begin
S1 := List[Index1];
SpaceIndex := Pos(' ', S1);
if SpaceIndex <> 0 then
S1 := Copy(S1, 1, SpaceIndex - 1);
S2 := List[Index2];
SpaceIndex := Pos(' ', S2);
if SpaceIndex <> 0 then
S2 := Copy(S2, 1, SpaceIndex - 1);
if List.CaseSensitive then
Result := AnsiCompareStr(S1, S2)
else
Result := AnsiCompareText(S1, S2);
end;
procedure TForm7.ButtonFirstNameClick(Sender: TObject);
begin
NameBuffer.Sort;
Memo1.Lines.Assign(NameBuffer);
end;
procedure TForm7.ButtonLastNameClick(Sender: TObject);
begin
NameBuffer.CustomSort(#LastNameCompareStrings);
Memo1.Lines.Assign(NameBuffer);
end;
I my example I have all your names in a StringList called NameBuffer. Then I've added two buttons to a form where I sort mylist, and display the result on the Screen.
You could iterate through each item of your StringList (lets call it FullNames),
split each string and put the "splits" in two new separate stringlists which you could call
FirstNameList and LastNameList.
Now create a third stringlist which you can call ReverseFirstLast,
and combine the items from LastNameList with FirstNameList and put them in ReverseNames.
Now you have all names in reverse order. Last name first, and first name last.
You can now sort the ReverseFirstLast-list and do a split&combine method again to reverse orders again and maintain the sorting.
That is one way to do it to get a rough method up and running.
I am creating an application which uses the AMB MyLaps decoder P3 Protocols.
I can't get my head around a way to sort the racers out based on laps and lap times. For example, the person in 1st has done 3 laps, the person in 2nd has done 2 laps. But then how do I order a situation where 2 people are on the same lap?
This is the record I'm using to hold the information:
type
TTimingRecord = record
position: integer;
transId: integer;
racerName: string;
kartNumber: integer;
lastPassingN: integer;
laps: integer;
lastRTCTime: TDateTime;
bestTimeMs: Extended;
lastTimeMs: Extended;
gapTimeMs: Extended;
splitTimeMs: Extended;
timestamp: TDateTime;
end;
A new record is created for each racer.
The code I'm currently using is:
procedure sortRacers();
var
Pos, Pos2: Integer;
Temp: TTimingRecord;
GapTime: Extended;
begin
for Pos := 0 to length(DriversRecord)-1 do
begin
for Pos2 := 0 to Length(DriversRecord)-2 do
begin
if(DriversRecord[Pos2].laps < DriversRecord[Pos2+1].laps)then
begin
Temp := DriversRecord[Pos2];
DriversRecord[Pos2] := DriversRecord[Pos2+1];
DriversRecord[Pos2+1] := Temp;
end
else if DriversRecord[Pos2].laps = DriversRecord[Pos2+1].laps then
begin
if DriversRecord[Pos2].lastRTCTime > DriversRecord[Pos2+1].lastRTCTime then
begin
Temp := DriversRecord[Pos2];
DriversRecord[Pos2] := DriversRecord[Pos2+1];
DriversRecord[Pos2+1] := Temp;
end;
end;
end;
end;
for pos := 1 to length(DriversRecord) -1 do //Gap Time
begin
if DriversRecord[Pos].laps = DriversRecord[0].laps then
begin
DriversRecord[Pos].gapTimeMs := DriversRecord[Pos].lastRTCTime - DriversRecord[0].lastRTCTime;
DriversRecord[Pos].splitTimeMs := DriversRecord[Pos].lastRTCTime - DriversRecord[Pos-1].lastRTCTime;
end;
end;
end;
But doesn't work too well :)
I'm assuming from your comment to the question, that you have decomposed the problem into sorting and comparing, and that you have got the sorting part covered. Which leaves order comparison.
You need a function that will perform a lexicographic order comparison based first on the number of laps completed, and secondly on the time since the start of this lap. Basically it will look like this:
function CompareRacers(const Left, Right: TTimingRecord): Integer;
begin
Result := CompareValue(Left.laps, Right.laps);
if Result=0 then
Result := CompareDateTime(Left.lastRTCTime, Right.lastRTCTime);
end;
You'll find CompareValue in Math and CompareDateTime in DateUtils.
What I'm not sure about is what the sense of the lastRTCTime values is. You may need to negate the result of the call to CompareDateTime to get the result you desire.
Result := -CompareDateTime(Left.lastRTCTime, Right.lastRTCTime);
Also, what happens if there is overtaking during the lap? Presumably you won't be able to detect that until the racers complete the current lap.
Instead of doing the sort algorithm yourself, try this technique (if you have a Delphi version compatible) : Best way to sort an array
And your function could look like this :
uses Types;
function CustomSort(const Left, Right: TTimingRecord): Integer
begin
If (left.laps > right.laps) then
result := GreaterThanValue
else
if (left.laps < right.laps) then
result := LessThanValue
else
begin
// Same laps count... Test on LastRTCTime
if (left.lastRTCTime < right.lastRTCTime) then
result := GreaterThanValue1
else
if (left.lastRTCTime > right.lastRTCTime) then
result := LessThanValue
else
result := EqualsValue;
end;
end));
It might be easier to look at this as 2 separate sorts.
Obviously you know the bubble-sort method, so I will not go into that.
Make 2 passes on your sorting.
1st, you sort the laps.
2nd, you run through the entire list of sorted laps. find begin point and end point in array for identical lap-values. Do the sorting again from begin and end points, but this time compare only the secondary value. iterate through all identical secondary values if the count of identical values are larger than 1.
This code is about sorting data using an Index. Way faster than bubble-sort.
It is dynamic and provides for ability to sort from a start-point to an end-point in an array.
The code itself is bigger than Bubble-Sort, but not many algorithms can compare on speed.
The code (when understanding how it works) can easily be modified to suit most kinds of sorting. On an array of 65536 strings, it only need to do 17 compares (or there about)
Some more CPU Cycles per compare cycle compared with Bubble Sort, but still among the fastest methods.
To search is equally as fast as BTREE. The actual sorting is perhaps slower, but the data is easier manageable afterwards with no real need for balancing the tree.
Enjoy.
Note: The routine is not the full solution to the actual problem, but it provides the beginning of an extreemely fast approach.
TYPE
DynamicIntegerArray = ARRAY OF INTEGER;
DynamicStringArray = ARRAY OF STRING;
VAR
BinSortLo, BinSortMid, BinSortHi : INTEGER;
FUNCTION FindMid:INTEGER;
BEGIN
FindMid:=BinSortLo+((BinSortHi-BinSortLo) DIV 2);
END;
PROCEDURE ShiftIndexUpAndStorePointer(VAR ArrParamIndex: DynamicIntegerArray; HighBound:INTEGER);
VAR
x : INTEGER;
BEGIN
FOR x:=HighBound-1 DOWNTO BinSortMid DO ArrParamIndex[x+1] := ArrParamIndex[x];// Shift the index.
ArrParamIndex[BinSortMid]:=HighBound;// Store the pointer to index at its sorted place
END;
PROCEDURE BinarySortUp(CONST ArrParam:DynamicStringArray; VAR ArrParamIndex: DynamicIntegerArray; CONST LoBound,HighBound:INTEGER); OVERLOAD;
VAR
TempVar : STRING;
BEGIN
BinSortLo:=LoBound; BinSortHi:=HighBound; BinSortMid:=FindMid;
TempVar := ArrParam[HighBound];
REPEAT
IF TempVar>ArrParam[ArrParamIndex[BinSortMid]] THEN BinSortLo:=BinSortMid ELSE BinSortHi:=BinSortMid;
BinSortMid:=FindMid;
UNTIL (BinSortMid=BinSortLo); {OR (BinSortMid=BinSortHi);}
IF TempVar>ArrParam[ArrParamIndex[BinSortMid]] THEN INC(BinSortMid);// We always need a last check just in case.
ShiftIndexUpAndStorePointer(ArrParamIndex,HighBound);
END;
PROCEDURE DynamicCreateIndex(CONST ArrParam:DynamicStringArray; VAR ArrParamIndex: DynamicIntegerArray; CONST LoBound,HighBound:INTEGER);
VAR
x : INTEGER;
BEGIN
FOR x:=LoBound TO HighBound DO
BinarySortUp(ArrParam,ArrParamIndex,LoBound,x);
END;
BEGIN
{
1. Create your STRING ARRAY as a DynamicStringArray.
2. Create your INDEX ARRAY as a DynamicIntegerArray.
3. Set the size of these arrays to any INTEGER size and fill the strings with data.
4. Run a call to DynamicCreateIndex(YourStringArray,YourIndexArray,0,SizeOfArray
Now you have a sorted Index of all the strings.
}
END.
I want to create a function that receive multiples strings as parameters.
Like the function printf("Hello %s",name); of C. but I don't want to pass a ready array, it wouldn't be readable.
Edit1.text:=lang('Hello');
Edit2.text:=lang('Welcome to {1} guest',place);
Edit3.text:=lang('Hi {1}, is your {2} time in {3}','Victor','first','Disney');
output should be:
Hello
Welcome to Disney guest
Hi Victor is your first time in Disney
how I create the function TForm1.lang(parameters:String):String;, I did a research, but I can't get it work.
I need to access the parameters[] and the parameters.length also.
I'm needing this to turn my App to multilang.
Here's an example function of how you can do this:
function TForm1.lang(s: String; params: array of String): String;
var
i: Integer;
begin
for i := 0 to High(params) do
begin
ShowMessage(params[i]);
end;
end;
Call it like this:
lang('My format string', ['this', 'that']);
or like this:
var
b: String;
begin
b := 'this';
lang('My format string', [b, 'that']);
end;
Not sure what you mean by not readable
DoSomething(['Param1','Param2']);
for
procedure DoSomething(args : Array of String);
Var
Index : Integer;
Begin
for index := Low(args) to High(args) Do
ShowMessage(args[Index]);
End;
Seems okay to me. Course if you want to call it from outside delphi then you have an issue.
Quick fix is just to pass in a delimited string and then user TStringList to split it.
You could write a wee function to do that, don't forget to free it when you are done.
All your three examples could be fixed by using SysUtils.Format:
Edit1.text := format('%s',['Hello']));
Edit1.text := format('Welcome to %s guest',[place]));
Edit1.text := format('Hi %s, is your %s time in %s',['Victor','first','Disney']));
Personally I think it's quite readable. If you can have what you need from a basic sysutils function, you should seriously consider doing that, rather than to write your own version. On the other hand, you may need more complex functionality that doesn't show in your question. If that's the case, I think paulsm4's suggestion of using a stringlist seems like a good way to go.
Delphi does not support CREATING functions withvararg-style parameters that work exactly like printf() does. It only supports CONSUMING such functions from external libraries. The closest Delphi comes to supporting the creation of functions with variable parameter lists is to use "open array" parameters, like what SysUtils.Format() uses.
As Tony mentions above, I also recommend using a deliminated string. Except, a little more than just deliminating, but using more of a parsing technique. If I understand right, this function you're making for formatting shall NOT include an array in the parameters, but technically, that doesn't mean we can't use arrays anywhere at all (arrays are very ideal to use for this scenario for fast performance).
This method will allow virtually anything to be passed in the parameters, including the deliminator, without affecting the output. The idea is to do A) Size of parameter string, B) Deliminator between size and parameter, and C) parameter string... And repeat...
const
MY_DELIM = '|'; //Define a deliminator
type
TStringArray = array of String;
/////////////////////////////////
//Convert an array of string to a single parsable string
// (Will be the first step before calling your format function)
function MakeParams(const Params: array of String): String;
var
X: Integer;
S: String;
begin
Result:= '';
for X:= 0 to Length(Params)-1 do begin
S:= Params[X];
Result:= Result + IntToStr(Length(S)) + MY_DELIM + S;
end;
end;
//Convert a single parsable string to an array of string
// (Will be called inside your format function to decode)
// This is more or less called parsing
function ExtractParams(const Params: String): TStringArray;
var
S: String; //Used for temporary parsing
T: String; //Used for copying temporary data from string
P: Integer; //Used for finding positions
C: Integer; //Used for keeping track of param count
Z: Integer; //Used for keeping track of parameter sizes
begin
S:= Params; //Because we'll be using 'Delete' command
C:= 0; //Set count to 0 to start
SetLength(Result, 0); //Prepare result array to 0 parameters
while Length(S) > 0 do begin //Do loop until nothing's left
P:= Pos(MY_DELIM, S); //Get position of next deliminator
if P > 1 then begin //If deliminator was found...
C:= C + 1; //We have a new parameter
SetLength(Result, C); //Set array length to new parameter count
T:= Copy(S, 1, P-1); //Get all text up to where deliminator was found
Delete(S, 1, P); //Delete what we just copied, including deliminator
Z:= StrToIntDef(T, 0); //Convert T:String to Z: Integer for size of parameter
T:= Copy(S, 1, Z); //Get all text up to 'Z' (size of parameter)
Delete(S, 1, Z); //Delete what we just copied
Result[C-1]:= T; //Assign the new parameter to end of array result
end else begin //If deliminator was NOT found...
S:= ''; //Clear S to exit loop (possible bad format if this happens)
end;
end;
end;
//Main formatting routine
function MyFormat(const Input: String; const Params: String): String;
var
A: TStringArray;
X: Integer;
S: String;
P: Integer;
R: String;
begin
R:= Input;
A:= ExtractParams(Params);
//At this point, A contains all the parameters parsed from 'Params'
for X:= 0 to Length(A)-1 do begin
S:= A[X];
P:= Pos('%s', R);
if P > 0 then begin
Delete(R, P, 2);
Insert(S, R, P);
end;
end;
Result:= R;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Pars: String;
begin
Pars:= MakeParams(['this', 'that', 'something else']);
Edit1.Text:= MyFormat('%s is %s but not %s', Pars);
end;
As you probably know, SysUtils.Format() implements "varargs" by using a set.
In your case, however, why not just pass a TStringList? The function will simply check "list.Count". Voila - you're done!
I'm trying to sort a TStringList in an especific order.
Instead of A,B,C.. I'm trying to order it in B,C,A.
I've declarated a const array with the order that I need.
I've tried with CustomSorte, but I can't understand how to write the function.
I'm trying with for loops now, but it is going really hard and confusing!
I'm not a Delphi Expert...
Thank you guys in advance!
From the help about the TStringListSortCompare function type:
Index1 and Index2 are indexes of the items in List to compare.
The callback returns:
a value less than 0 if the string identified by Index1 comes before the string identified by Index2
0 if the two strings are equivalent
a value greater than 0 if the string with Index1 comes after the string identified by Index2.
So if you subtract your custom order of the second item from the custom order of the first one, then the items will be sorted like you want.
const
Order: array[0..6] of String = ('B', 'C', 'A', 'D', 'G', 'F', 'E');
function GetStringOrder(const S: String; CaseSensitive: Boolean): Integer;
begin
for Result := 0 to Length(Order) - 1 do
if (CaseSensitive and (CompareStr(Order[Result], S) = 0)) or
(not CaseSensitive and (CompareText(Order[Result], S) = 0)) then
Exit;
Result := Length(Order);
end;
function MyCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := GetStringOrder(List[Index1], List.CaseSensitive) -
GetStringOrder(List[Index2], List.CaseSensitive);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
List: TStringList;
begin
List := TStringList.Create;
try
List.CommaText := 'A,G,a,C,B,b,F,a,B,C,c,D,d,E,D,F,G,C,A,G,d,e,f,g';
List.CaseSensitive := True;
List.CustomSort(MyCompareStrings);
ListBox1.Items.Assign(List);
finally
List.Free;
end;
end;