program OccurrenceCounter;
{$mode Delphi}
{$ImplicitExceptions Off}
{$MODESWITCH NESTEDPROCVARS}
uses
SysUtils, DateUtils,
Generics.Defaults, Generics.Collections,
LGUtils, LGHashMultiSet, LGArrayHelpers,
gutil, gmap;
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;
procedure SortCountAvk1;
type
TCounter = TGHashMultiSetLP<Integer>;
TCountRef = TGAutoRef<TCounter>;
TEntry = TCounter.TEntry;
function EntryCmp(constref L, R: TEntry): SizeInt;
begin
if L.Key > R.Key then
Result := 1
else
if L.Key < R.Key then
Result := -1
else
Result := 0;
end;
var
CountRef: TCountRef;
InOut: Text;
Counter: TCounter;
e: TEntry;
I: Integer;
begin
Counter := CountRef;
Counter.LoadFactor := 0.7;
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 SortCountJulkas;
type
TIntLess = TLess<LongInt>;
TDict = TMap<LongInt, LongInt, TIntLess>;
var
sc: TDict;
scit: TDict.TIterator;
InOut: Text;
key, cnt: LongInt;
begin
sc := TDict.Create;
Assign(InOut, ParamStr(1));
Reset(InOut);
while not EOF(InOut) do
begin
ReadLn(InOut, key);
Inc(Total);
cnt := 0;
sc.TryGetValue(key, cnt);
sc[key] := cnt + 1;
end;
Close(InOut);
Unique := sc.Size;
if Unique > 0 then
begin
Assign(InOut, ParamStr(2));
Rewrite(InOut);
scit := sc.Min;
repeat
WriteLn(InOut, scit.Key, ' - ', scit.Value);
until not scit.Next;
Close(InOut);
scit.Free;
end;
sc.Free;
end;
procedure SortCountMangakissa;
type
TMyTime = packed record
Unixtime : Integer;
Counter : word;
end;
function Find(var aMyTime : array of TMytime; aLine : Integer) : boolean;
var index : integer;
begin
result := false;
if length(aMyTime) > 0 then
begin
for index := low(aMyTime) to high(aMyTime) do
begin
if aMyTime[index].Unixtime = aLine then
begin
aMyTime[index].Counter := aMyTime[index].Counter + 1;
result := true;
break;
end;
end;
end;
end;
procedure QuickSort(var A: array of tMytime; iLo, iHi: Integer) ;
var
Lo, Hi, Pivot : Integer;
T : TMyTime;
begin
Lo := iLo;
Hi := iHi;
Pivot := A[(Lo + Hi) div 2].Unixtime;
repeat
while A[Lo].Unixtime < Pivot do Inc(Lo) ;
while A[Hi].Unixtime > Pivot do Dec(Hi) ;
if Lo <= Hi then
begin
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo) ;
Dec(Hi) ;
end;
until Lo > Hi;
if Hi > iLo then QuickSort(A, iLo, Hi) ;
if Lo < iHi then QuickSort(A, Lo, iHi) ;
end;
var
InOut : Text;
MyTime : array of TMyTime = nil;
Item : TMyTime;
myline, index : integer;
begin
Assign(InOut, ParamStr(1));
Reset(InOut);
index := 0;
while not EOF(InOut) do
begin
ReadLn(InOut, myline);
Inc(Total);
if not find(MyTime, myline) then
begin
index := index + 1;
setlength(MyTime,index);
MyTime[index - 1].Unixtime := myLine;
MyTime[index - 1].Counter := 1;
end;
end;
Close(InOut);
if MyTime = nil then
exit;
Unique := Length(MyTime);
QuickSort(Mytime, low(MyTime), high(mytime));
Assign(InOut, ParamStr(2));
Rewrite(InOut);
for Item in Mytime do
with Item do
WriteLn(InOut, Unixtime, ' - ', Counter);
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: ', Total, ', #unique: ', 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);
WriteLn;
WriteLn('running SortCountJulkas:');
Run(SortCountJulkas);
WriteLn;
WriteLn('running SortCountMangakissa:');
Run(SortCountMangakissa);
end.