program OccurrenceCounter;
{$mode Delphi}
{$ImplicitExceptions Off}
uses
SysUtils, DateUtils,
Generics.Defaults, Generics.Collections,
LGUtils, , LGAbstractContainer, LGHashMultiSet, LGArrayHelpers;
type
TIntPair = TPair<LongInt, LongInt>;
function ComparePairs(constref L, R: TIntPair): LongInt;
begin
if L.Key < R.Key then
Result := -1
else if L.Key = R.Key then
Result := 0
else
Result := 1;
end;
var
Total, Unique: Integer;
Start: TDateTime;
procedure SortCountAkira;
var
I: LongInt;
InOut: Text;
Map: TDictionary<LongInt, LongInt>;
Pair: TIntPair;
Pairs: TArray<TIntPair>;
begin
Map := TDictionary<LongInt, LongInt>.Create();
Map.Capacity := 10000000;
Assign(InOut, ParamStr(1));
Reset(InOut);
while not EOF(InOut) do begin
ReadLn(InOut, I);
Inc(Total);
if not Map.ContainsKey(I) then
begin
Map.Add(I, 1);
Inc(Unique);
end
else
Map[I] := Map[I] + 1;
end;
Close(InOut);
Pairs := Map.ToArray();
Map.Free();
TArrayHelper<TIntPair>.Sort(
Pairs,
TComparer<TIntPair>.Construct(ComparePairs)
);
Assign(InOut, ParamStr(2));
Rewrite(InOut);
for Pair in Pairs do with Pair do
WriteLn(InOut, Key, ' - ', Value);
Close(InOut);
end;
procedure SortCountHoward;
var
arr: array of Integer;
textf: TextFile;
min: Integer = High(Integer);
max: Integer = -1;
i: Integer;
begin
AssignFile(textf, ParamStr(1));
Reset(textf);
while not EOF(textf) do
begin
ReadLn(textf, i);
Inc(Total);
if i < min then
min := i;
if i > max then
max := i;
end;
SetLength(arr, max-min+1);
Reset(textf);
while not EOF(textf) do
begin
ReadLn(textf, i);
Dec(i, min);
Inc(arr[i]);
end;
CloseFile(textf);
AssignFile(textf, ParamStr(2));
Rewrite(textf);
for i := Low(arr) to High(arr) do
case (arr[i] > 0) of
True:
begin
WriteLn(textf, Format('%d - %d',[i+min, arr[i]]));
Inc(Unique);
end;
end;
CloseFile(textf);
SetLength(arr, 0);
end;
function EntryCmp(constref L, R: TGMultisetEntry<Integer>): SizeInt;
begin
if L.Key > R.Key then
Result := 1
else
if L.Key < R.Key then
Result := -1
else
Result := 0;
end;
procedure SortCountAvk1;
type
TCounter = TGHashMultiSetLP<Integer>;
TCountRef = TGAutoRef<TCounter>;
TEntry = TCounter.TEntry;
var
CountRef: TCountRef;
InOut: Text;
Counter: TCounter;
e: TEntry;
I: Integer;
begin
Counter := CountRef;
Assign(InOut, ParamStr(1));
Reset(InOut);
while not EOF(InOut) do
begin
ReadLn(InOut, I);
Counter.Add(I);
end;
Close(InOut);
Total := Counter.Count;
Unique := Counter.EntryCount;
if Counter.NonEmpty then
begin
Assign(InOut, ParamStr(2));
Rewrite(InOut);
for e in Counter.Entries.Sorted(@EntryCmp) do
with e do
WriteLn(InOut, Key, ' - ', Count);
Close(InOut);
end;
end;
procedure SortCountAvk2;
var
List: array of Integer;
InOut: Text;
I, J, Count, DupCount: Integer;
begin
Assign(InOut, ParamStr(1));
Reset(InOut);
SetLength(List, 4096);
I := 0;
while not EOF(InOut) do
begin
ReadLn(InOut, J);
Inc(Total);
if Length(List) = I then
SetLength(List, I * 2);
List[I] := J;
Inc(I);
end;
Close(InOut);
SetLength(List, I);
if List = nil then
exit;
TGOrdinalArrayHelper<Integer>.Sort(List);
Count := I;
DupCount := 0;
I := 0;
Assign(InOut, ParamStr(2));
Rewrite(InOut);
repeat
J := List[I];
while (I < Count) and (List[I] = J) do
begin
Inc(DupCount);
Inc(I);
end;
WriteLn(InOut, J, ' - ', DupCount);
Inc(Unique);
DupCount := 0;
until I = Count;
Close(InOut);
end;
procedure Run(aProc: TProcedure);
begin
Total := 0;
Unique := 0;
Start := Now;
try
aProc();
WriteLn('elapsed time: ', MilliSecondsBetween(Now(), Start) / 1000.0 : 0 : 4);
WriteLn('total values: ', Total, ', unique values: ', Unique);
except
on e: Exception do
WriteLn('crashes with message "', e.Message, '"');
end;
end;
begin
if ParamCount <> 2 then
begin
WriteLn('Usage: occurrencecounter infilename outfilename');
exit;
end;
if not FileExists(ParamStr(1)) then
begin
WriteLn('Input file "', ParamStr(1), '" not found');
exit;
end;
WriteLn('running SortCountAkira:');
Run(@SortCountAkira);
WriteLn;
WriteLn('running SortCountHoward:');
Run(@SortCountHoward);
WriteLn;
WriteLn('running SortCountAvk1:');
Run(@SortCountAvk1);
WriteLn;
WriteLn('running SortCountAvk2:');
Run(@SortCountAvk2);
end.