SCAR Code:
program New;
function QueryPerformanceFrequency(out Frequency: Int64): LongBool; external 'QueryPerformanceFrequency@kernel32.dll stdcall';
function QueryPerformanceCounter(out Counter: Int64): LongBool; external 'QueryPerformanceCounter@kernel32.dll stdcall';
procedure MarkTime(var Time: Int64);
var
Freq: Int64;
begin
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(Time)
else
Time := GetTickCount;
end;
function TimeFromMark(Mark: Int64): Double;
var
Freq, Now: Int64;
begin
if QueryPerformanceFrequency(Freq) then
begin
QueryPerformanceCounter(Now);
Result := ((Now - Mark) / Freq) * 1000;
end
else
Result := (GetTickCount - Mark);
end;
function MatchCount(Match, Str: string): Integer;
var
p: Integer;
begin
Result := 0;
p := Pos(Match, Str);
while (p > 0) do
begin
Inc(Result);
p := PosEx(Match, Str, p + 1);
end;
end;
(*function WordCount(Str: string): Integer;
{$IFNDEF SCAR320_UP}
var
InWord: Boolean;
i, l: Integer;
{$ENDIF}
begin
{$IFNDEF SCAR320_UP}
Result := 0;
i := 1;
l := Length(Str);
while (i <= l) do
begin
case Str[i] of
'a'..'z', 'A'..'Z', '0'..'9':
InWord := True;
'_':
if InWord then
while (i < l) do
begin
Inc(i);
case Str[i] of
//'_': {nothing};
'a'..'z', 'A'..'Z', '0'..'9':
Break;
else if (Str[i] <> '_') then
begin
Inc(Result);
InWord := False;
Break;
end;
end;
end;
else if InWord then
begin
InWord := False;
Inc(Result);
end;
end;
Inc(i);
end;
if InWord then
Inc(Result);
{$ELSE}
Result := Length(GetNumbers(ReplaceRegex(ReplaceRegex(Str, '\W+', ' '), '\w+', '1')));
{$ENDIF}
end; *)
function WordCount(Str: string): Integer;
var
i: Integer;
s: TStringArray;
begin
Result := 0;
s := Explode(' ', Str);
for i := High(s) downto 0 do
if (s[i] <> '') then
Inc(Result);
end;
function AlphaIndexSort(InputString: TStringArray; InputIndex: TIntegerArray; Offset: Integer; CaseInsensitive: Boolean): TIntegerArray;
var
i, ii, l: Integer;
Input_Int: array of Word;
{
non AlphaNumeric 0..1, Numberic 2..11, Alpha UP 12..37, Alpha LO 38..63
//CaseInsensitive: Alpha UP + LO combined -> AaBbCcDd
CaseInsensitive: LO = UP
}
Output_Int: array[0..63] of record
Index: TIntegerArray;
Len: Integer;
end;
tmp: TIntegerArray;
c: Char;
s: string;
begin
l := High(InputIndex);
SetLength(Input_Int, l + 1);
SetLength(Result, l + 1);
if (Offset <= 0) then
Offset := 1;
for i := l downto 0 do
begin
if (Offset > Length(InputString[InputIndex[i]])) then
begin
Input_Int[i] := 0;
Continue;
end;
c := InputString[InputIndex[i]][Offset];
case c of
'a'..'z':
if CaseInsensitive then
Input_Int[i] := ((Ord(c) - {97}85) {shl 1}) {+ 13}
else
Input_Int[i] := Ord(c) - 59;
'A'..'Z':
if CaseInsensitive then
Input_Int[i] := ((Ord(c) - {65}53) {shl 1}) {+ 12}
else
Input_Int[i] := Ord(c) - 53;
'0'..'9':
Input_Int[i] := Ord(c) - 46;
else
Input_Int[i] := 1;
end;
end;
for i := l downto 0 do
with Output_Int[Input_Int[i]] do
begin
SetLength(Index, Len + 1);
Index[Len] := InputIndex[i];
Len := Len + 1;
end;
for i := 0 to 63 do
with Output_Int[i] do
if (Len > 1) then
begin
if CaseInsensitive then
begin
s := UpperCase(TrimOthers(InputString[Index[0]]));
for ii := Len - 1 downto 1 do
if (UpperCase(TrimOthers(InputString[Index[ii]])) <> s) then
Break;
end
else
begin
s := TrimOthers(InputString[Index[0]]);
for ii := Len - 1 downto 1 do
if (TrimOthers(InputString[Index[ii]]) <> s) then
Break;
end;
if (ii > 0) then
begin
tmp := AlphaIndexSort(InputString, Index, Offset + 1, CaseInsensitive);
Index := tmp;
end;
end;
l := 0;
for i := 0 to 63 do
with Output_Int[i] do
if (Len > 0) then
for ii := 0 to Len - 1 do
begin
Result[l] := Index[ii];
l := l + 1;
end;
end;
function StringSort(Input: TStringArray; SortMethod: (smAlpha, smWordCount, smMatchCount); MatchStr: string; CaseInsensitive: Boolean): TStringArray;
var
i, ii, l, m: Integer;
Input_Int: TIntegerArray;
Output_Int: array of record
Index: TIntegerArray;
Len: Integer;
end;
tmp: TIntegerArray;
Match: string;
begin
l := High(Input);
m := 0;
SetLength(Input_Int, l + 1);
SetLength(Result, l + 1);
case SortMethod of
smAlpha:
begin
for i := l downto 0 do
Input_Int[i] := i;
Input_Int := AlphaIndexSort(Input, Input_Int, 1, CaseInsensitive);
for i := l downto 0 do
Result[i] := Input[Input_Int[i]];
Exit;
end;
smWordCount:
for i := l downto 0 do
begin
Input_Int[i] := WordCount(Input[i]);
if (Input_Int[i] > m) then
m := Input_Int[i];
end;
smMatchCount:
begin
if CaseInsensitive then
Match := UpperCase(MatchStr)
else
Match := MatchStr;
for i := l downto 0 do
begin
if CaseInsensitive then
Input_Int[i] := MatchCount(Match, UpperCase(Input[i]))
else
Input_Int[i] := MatchCount(Match, Input[i]);
if (Input_Int[i] > m) then
m := Input_Int[i];
end;
end;
else
begin
WriteLn('Invalid SortMethod used in StringSort!');
Exit;
end;
end;
SetLength(Output_Int, m + 1);
for i := l downto 0 do
with Output_Int[Input_Int[i]] do
begin
SetLength(Index, Len + 1);
Index[Len] := i;
Len := Len + 1;
end;
for i := 0 to m do
with Output_Int[i] do
if (Len > 1) then
begin
Match := UpperCase(TrimOthers(Input[Index[0]]));
if CaseInsensitive then
begin
for ii := Len - 1 downto 1 do
if (UpperCase(TrimOthers(Input[Index[ii]])) <> Match) then
Break;
end
else
begin
Match := TrimOthers(Input[Index[0]]);
for ii := Len - 1 downto 1 do
if (TrimOthers(Input[Index[ii]]) <> Match) then
Break;
end;
if (ii > 0) then
begin
tmp := AlphaIndexSort(Input, Index, 1, CaseInsensitive);
Index := tmp;
end;
end;
l := 0;
for i := m downto 0 do
with Output_Int[i] do
if (Len > 0) then
for ii := 0 to Len - 1 do
begin
Result[l] := Input[Index[ii]];
l := l + 1;
end;
end;
var
s, ss: TStringArray;
i: Integer;
t: Int64;
begin
//s := ['z', 'y', 'x', 'Z', 'Y', 'X', 'a', 'b', 'c', 'aa', 'aa', 'ab', 'aaaa', 'aaaa', '.abc', '.0123', '=abcdef', '987', '654', '05', '987A', '987.'];
s := ['say lol 1', 'h^ehehe', 's.ay ONE two three', 'say lol', 'say heho! (not!)', 'Hey', 'Hello', 'Hai', 'Hoi ', 'hello', 'hEY', 'hello', 'Hoi', '.lo l123', '.lol ', '.lol.', '.lolA', '.lola', '.567', '567', '0123', '...lol', 'bye', 'cya', 'zebra', 'ZONK!'];
MarkTime(t);
for i := 1 to 50 do
ss := StringSort(s, smAlpha, 'he', False);
WriteLn(FloatToStr(TimeFromMark(t) / 50.0)+' ms.');
ClearReport;
for i := 0 to High(ss) do
AddToReport(ss[i]);
end.