Sorting Racers in timing application - delphi

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.

Related

Invalid pointer operation; Recursive Merge Sort

I've attempted to implement a merge sort for strings however I cannot perform the recursive part and I get the error "Invalid Pointer Operation"
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
var i : Integer;
const MyArray : array[1..5]of string = ('hi', 'zebra', 'apple', 'Xylophone', 'dog');
Procedure merge(result, left, right : array of string);
var i, i1, i2 : Integer;
begin
i1 := 0;
i2 := 0;
for i := 0 to Length(result) do
begin
if (i2 >= Length(right)) or (i1 < Length(left)) and (StrComp(PChar(left[i]), PChar(right[i2])) < 0) then
begin
result[i] := left[i1];
inc(i1);
end
else
begin
result[i] := right[i2];
inc(i2);
end;
end;
end;
Procedure mergeSort(OriginalList : array of string);
var left, right : array of string;
i : Integer;
begin
if (Length(OriginalList) >= 2) then
begin
setlength(left, length(OriginalList) div 2);
setlength(right, length(OriginalList) - (length(OriginalList) div 2));
for i := 0 to Length(left) do
begin
left[i] := OriginalList[i];
end;
for i := 0 to Length(right) do
begin
right[i] := OriginalList[i + Length(OriginalList) div 2];
end;
mergeSort(left);
mergeSort(right);
merge(OriginalList, left, right);
end;
end;
begin
writeln('The data before sorting: ');
for i := low(MyArray) to High(MyArray) do
begin
write(MyArray[i]+' ');
end;
writeln;
mergeSort(MyArray);
writeln('The data before sorting: ');
for i := low(MyArray) to High(MyArray) do
begin
write(MyArray[i]+' ');
end;
readln;
end.
On the line in the mereSort function where I recall the merge sort function on the arrays "left" and "right", I get the error message but I don't quite understand why?
There are many different things wrong with this, hopefully these points will help you in the right direction.
Problems with Array Indexes
You are indexing beyond the end of your arrays:
Dynamic arrays are indexed starting from zero so the line
for i := 0 to Length(left) do
should be
for i := 0 to Length(left) - 1 do
or you can use
for i := Low(left) to High(left) do
As you did later.
I would recommend you choose a standard form and use it consistently, and also that you avoid declaring constant arrays with non-zero based indexing unless you have good reason, this way you can use the same forms consistently or change the type of array later without running into trouble
This first fix will stop your program crashing, but you'll notice your sort code isn't changing anything...
Problems with parameter passing
Delphi has several different ways to pass parameters into procedures:
procedure doSomething(a : array of string);
procedure doSomething(var a : array of string);
procedure doSomething(out a : array of string);
procedure doSomething(const a : array of string);
These determine how what happens inside the procedure can affect the original variable passed
This is something you will need to understand, read up in the documentation:
http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Parameters_(Delphi)
There is IMO some very confusing behaviour and syntax relating to array parameters and a lot of stuff that seems intuitive is not allowed especially with XE/older version, its worth reading the documentation about the standard data types
In the current state, your merge procedure will have no effect because it only operates on a new copy of the array you pass in, which you have also declared as constant
Other
I would avoid the use of result as a procedure parameter since this is the name used for function return values, it seems like asking for trouble to use it like that.
PS: I haven't looked at the logic of the merging, just the basic language mistakes

Sort TStringList by first character after whitespace

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.

How to remove empty/nil elements from Array?

How can I remove empty elements or elements with nil pointers from an Array? A generic solution would be welcome.
You could write it like this:
type
TArrayHelper = class
class function RemoveAll<T>(var Values: TArray<T>; const Value: T); static;
end;
....
function TArrayHelper.RemoveAll<T>(var Values: TArray<T>; const Value: T);
var
Index, Count: Integer;
DefaultComparer: IEqualityComparer<T>;
begin
// obtain an equality comparer for our type T
DefaultComparer := TEqualityComparer<T>.Default;
// loop over the the array, only retaining non-matching values
Count := 0;
for Index := 0 to high(Values) do begin
if not DefaultComparer.Equals(Values[Index], Value) then begin
Values[Count] := Values[Index];
inc(Count);
end;
end;
// re-size the array
SetLength(Values, Count);
end;
Suppose that you had an array of pointers:
var
arr: TArray<Pointer>;
Then you would remove the nil elements like this:
TArrayHelper.RemoveAll<Pointer>(arr, nil);
This code takes the easy way out and always uses the default comparer. For more complex types that is no good. For instance some records need custom comparers. You would need to supply a comparer to support that.
The above implementation is as simple as possible. In terms of performance, it may well be wasteful in the likely common scenario where no matching values, or very few, are found. That's because the version above unconditionally assigns, even if the two indices are the same.
Instead, if there was an issue with performance, you might optimize the code by stepping through the array as far as the first match. And only then start moving values.
function TArrayHelper.RemoveAll<T>(var Values: TArray<T>; const Value: T);
var
Index, Count: Integer;
DefaultComparer: IEqualityComparer<T>;
begin
// obtain an equality comparer for our type T
DefaultComparer := TEqualityComparer<T>.Default;
// step through the array until we find a match, or reach the end
Count := 0;
while (Count<=high(Values))
and not DefaultComparer.Equals(Values[Count], Value) do begin
inc(Count);
end;
// Count is either the index of the first match or one off the end
// loop over the rest of the array copying non-matching values to the next slot
for Index := Count to high(Values) do begin
if not DefaultComparer.Equals(Values[Index], Value) then begin
Values[Count] := Values[Index];
inc(Count);
end;
end;
// re-size the array
SetLength(Values, Count);
end;
As you can see this is a lot more difficult to analyse. You would only contemplate doing this if the original version was a bottleneck.

Easy way to add stable sorting to TList and TStringList

I use TList/TObjectList and TStringList (with associated objects) for a multitude of tasks, either as-is, or as basis for more complex structures. While the sort functionality is usually good enough, I sometimes need to do a stable sort, and both lists use quicksort.
What's the easiest way to implement stable sorting for TList and/or TStringList? Do I have to write my own sorting routine, or can it be done by using some clever trick with TStringListSortCompare/TListSortCompare?
You'll have to write your own sorting routine.
You can read the current QuickSort implementation, and write your own stable version (e.g. a Merge sort or any other stable variant).
Some tricks:
If you are sure that an index is < Count, you can use the fast pointer array (TList.List[]) instead of slower Items[] or GetItem(): sub-method calling and range checking slow down the execution;
The comparison function is most of the time the speed bottleneck of the search - so take care of this part;
If you need speed, use a real profiler over real (e.g. random) data - but make it right before making it fast;
Start from an existing implementation of the sort;
To minimize stack space, you may use a temporary record to store and share variables among recursive calls.
This question is rather old, but here goes my answer for future readers:
I also needed this recently and adapted the implementation found in the book "The Tomes of Delphi Algorithms and Data Structures" by Julian Bucknall. Implementation for TList, TObjectList and descendant classes. It works with Delphi 2009 to XE7 and probably other versions as well:
http://alexandrecmachado.blogspot.com.br/2015/02/merge-sort-for-delphi.html
From similar question How Can I Replace StringList.Sort with a Stable Sort in Delphi?, linked here in comment by lkessler I need to copy to here really easy trick as mentioned in question.
You can easily make quick sort behave stable just by adding initial order numbers into data to sort and adding last comparation condition in CustomSort compare function to compare this initial order numbers.
Easy, fast and smart. Costs only one extra integer (or byte, or use some reserved storage like TComponent.Tag if You sort TComponents) on each sortable item and one initialization loop over them.
TObjectToSort = class
...
Index: Integer;
end;
function MyStableSortComparer(List: TStringList; Index1, Index2: Integer): Integer;
var
o1, o2: TObjectToSort;
begin
o1 := TObjectToSort(List.Objects[Index1]);
o2 := TObjectToSort(List.Objects[Index2]);
...
if Result = 0 then
Result := o1.Index - o2.Index;
end;
for i := 0 to MyStrtingList.Count - 1 do
TObjectToSort(MyStrtingList.Objects[i]).Index := i;
MyStrtingList.CustomSort(MyStableSortComparer);
For anyone using generics here is a ready-to-use implementation of insertion and merge sort, both stable sorting algorithms.
uses Generics.Defaults, Generics.Collections;
type
TMySort = class
public
class procedure InsertionSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>); static;
class procedure MergeSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>); static;
end;
implementation
class procedure TMySort.InsertionSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>);
var
UnsortedIdx, CompareIdx: Integer;
AItem: T;
begin
for UnsortedIdx := Succ(FirstIndex) to LastIndex do begin
AItem := AArray[UnsortedIdx];
CompareIdx := UnsortedIdx - 1;
while (CompareIdx >= FirstIndex) and (AComparer.Compare(AItem, AArray[CompareIdx]) < 0) do begin
AArray[CompareIdx + 1] := AArray[CompareIdx]; { shift the compared (bigger) item to the right }
Dec(CompareIdx);
end;
AArray[CompareIdx + 1] := AItem;
end;
end;
class procedure TMySort.MergeSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>);
const
MinMergeSortLimit = 16;
var
LeftLast, RightFirst: Integer;
LeftIdx, RightIdx, SortedIdx: Integer;
LeftCount: Integer;
TmpLeftArray: TArray<T>;
begin
if (LastIndex - FirstIndex) < MinMergeSortLimit then
{ sort small chunks with insertion sort (recursion ends here)}
TMySort.InsertionSort<T>(AArray, FirstIndex, LastIndex, AComparer)
else begin
{ MERGE SORT }
{ calculate the index for splitting the array in left and right halves }
LeftLast := (FirstIndex + LastIndex) div 2;
RightFirst := LeftLast + 1;
{ sort both halves of the array recursively }
TMySort.MergeSort<T>(AArray, FirstIndex, LeftLast, AComparer);
TMySort.MergeSort<T>(AArray, RightFirst, LastIndex, AComparer);
{ copy the first half of the array to a temporary array }
LeftCount := LeftLast - FirstIndex + 1;
TmpLeftArray := System.Copy(AArray, FirstIndex, LeftCount);
{ setup the loop variables }
LeftIdx := 0; { left array to merge -> moved to TmpLeftArray, starts at index 0 }
RightIdx := RightFirst; { right array to merge -> second half of AArray }
SortedIdx := FirstIndex - 1; { range of merged items }
{ merge item by item until one of the arrays is empty }
while (LeftIdx < LeftCount) and (RightIdx <= LastIndex) do begin
{ get the smaller item from the next items in both arrays and move it
each step will increase the sorted range by 1 and decrease the items still to merge by 1}
Inc(SortedIdx);
if AComparer.Compare(TmpLeftArray[LeftIdx], AArray[RightIdx]) <= 0 then begin
AArray[SortedIdx] := TmpLeftArray[LeftIdx];
Inc(LeftIdx);
end else begin
AArray[SortedIdx] := AArray[RightIdx];
Inc(RightIdx);
end;
end;
{ copy the rest of the left array, if there is any}
while (LeftIdx < LeftCount) do begin
Inc(SortedIdx);
AArray[SortedIdx] := TmpLeftArray[LeftIdx];
Inc(LeftIdx);
end;
{ any rest of the right array is already in place }
end;
end;
The implementation is made for arrays and applicable for TList/TObjectList too (as their Items property is an array).
var
AList: TList<T>;
AComparer: IComparer<T>;
begin
...
TMySort.MergeSort<T>(AList.List, 0, AList.Count-1, AComparer);
...
end;
Besides being stable, in my experience, this merge sort implementation does show better performance than the build-in quick sort (though it uses more memory).

Delphi - Is there a better way to get state abbreviations from state names

const
states : array [0..49,0..1] of string =
(
('Alabama','AL'),
('Montana','MT'),
('Alaska','AK'),
('Nebraska','NE'),
('Arizona','AZ'),
('Nevada','NV'),
('Arkansas','AR'),
('New Hampshire','NH'),
('California','CA'),
('New Jersey','NJ'),
('Colorado','CO'),
('New Mexico','NM'),
('Connecticut','CT'),
('New York','NY'),
('Delaware','DE'),
('North Carolina','NC'),
('Florida','FL'),
('North Dakota','ND'),
('Georgia','GA'),
('Ohio','OH'),
('Hawaii','HI'),
('Oklahoma','OK'),
('Idaho','ID'),
('Oregon','OR'),
('Illinois','IL'),
('Pennsylvania','PA'),
('Indiana','IN'),
('Rhode Island','RI'),
('Iowa','IA'),
('South Carolin','SC'),
('Kansas','KS'),
('South Dakota','SD'),
('Kentucky','KY'),
('Tennessee','TN'),
('Louisiana','LA'),
('Texas','TX'),
('Maine','ME'),
('Utah','UT'),
('Maryland','MD'),
('Vermont','VT'),
('Massachusetts','MA'),
('Virginia','VA'),
('Michigan','MI'),
('Washington','WA'),
('Minnesota','MN'),
('West Virginia','WV'),
('Mississippi','MS'),
('Wisconsin','WI'),
('Missouri','MO'),
('Wyoming','WY')
);
function getabb(state:string):string;
var
I:integer;
begin
for I := 0 to length(states) -1 do
if lowercase(state) = lowercase(states[I,0]) then
begin
result:= states[I,1];
end;
end;
function getstate(state:string):string;
var
I:integer;
begin
for I := 0 to length(states) -1 do
if lowercase(state) = lowercase(states[I,1]) then
begin
result:= states[I,0];
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
edit1.Text:=getabb(edit1.Text);
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
edit1.Text:=getstate(edit1.Text);
end;
end.
Is there a bette way to do this?
Should this kind of data be hard coded?
Wouldn't it be better to use something like a XML file or even just a CSV.
Or Name Value Pairs, i.e. IA=Iowa
then loaded into a TStringList to get
States.Values['IA'] = 'Iowa';
Then you just need to write something to search the Values to work backwards like
//***Untested***
//Use: NameOfValue(States, 'Iowa') = 'IA'
function NameOfValue(const strings: TStrings; const Value: string): string;
var
i : integer;
P: Integer;
S: string;
begin
for i := 0 to strings.count - 1 do
begin
S := strings.ValueFromIndex[i];
P := AnsiPos(strings.NameValueSeparator, S);
if (P <> 0) and (AnsiCompareText(Copy(S, 1, P - 1), Value) = 0) then
begin
Result := strings.Names[i];
Exit;
end;
end;
Result := '';
end;
I'm fairly sure its case insensitive too
If you're on D2009 or D2010, use a TDictionary<string, string> from Generics.Collections. Declare the array of constants like you have it, then set up your dictionary by putting each pair in to the dictionary. Then just use the dictionary's default property to do your lookups.
Notice that lowercase(a) = lowercase(b) is slower than sameText(a, b).
In addition, you can speed up the procedure further by storing the strings in the array as lower-case only, and then in the look-up routine start with converting the input to lower-case as well. Then you can use the even faster function sameStr(a, b). But of course, when a match is found, you then need to format it by capitalizing the initial letters. This speed-up approach is probably not very important for such a small list of strings. After all, there are not too many states in the US.
Also, you should declare the functions using const arguments, i.e. write
function getabb(const state:string):string;
instead of
function getabb(state:string):string;
(unless you want to change state in the routine).
Finally, you could make the code more compact and readable by omitting the begin and end of the for loops.
I would have your lists sorted. That way you can use a binary search to cut the lookup times down. It all depends on the number of iterations you will be exercising. Around 50 items doesn't seem like much, until your iterating over the list a few thousand times looking for the last item in the list.
Also you should ALWAYS bail from your loops as soon as you get get a match if you know the rest of the list will not match.
Arrays are fine, and depending on how your using the data, you might need to add some of the "territories" that also have abbreviations (PR = PUERTO RICO, GU = GUAM, etc.).

Resources