125 lines
2.4 KiB
Text
125 lines
2.4 KiB
Text
program AnagramsTest;
|
|
|
|
{$APPTYPE CONSOLE}
|
|
|
|
{$R *.res}
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Classes,
|
|
System.Diagnostics;
|
|
|
|
function Sort(s: string): string;
|
|
var
|
|
c: Char;
|
|
i, j, aLength: Integer;
|
|
begin
|
|
aLength := s.Length;
|
|
|
|
if aLength = 0 then
|
|
exit('');
|
|
|
|
Result := s;
|
|
|
|
for i := 1 to aLength - 1 do
|
|
for j := i + 1 to aLength do
|
|
if result[i] > result[j] then
|
|
begin
|
|
c := result[i];
|
|
result[i] := result[j];
|
|
result[j] := c;
|
|
end;
|
|
end;
|
|
|
|
function IsAnagram(s1, s2: string): Boolean;
|
|
begin
|
|
if s1.Length <> s2.Length then
|
|
exit(False);
|
|
|
|
Result := Sort(s1) = Sort(s2);
|
|
|
|
end;
|
|
|
|
function Split(s: string; var Count: Integer; var words: string): Boolean;
|
|
var
|
|
sCount: string;
|
|
begin
|
|
sCount := s.Substring(0, 4);
|
|
words := s.Substring(5);
|
|
Result := TryStrToInt(sCount, Count);
|
|
end;
|
|
|
|
function CompareLength(List: TStringList; Index1, Index2: Integer): Integer;
|
|
begin
|
|
result := List[Index1].Length - List[Index2].Length;
|
|
if Result = 0 then
|
|
Result := CompareText(Sort(List[Index2]), Sort(List[Index1]));
|
|
end;
|
|
|
|
var
|
|
Dict: TStringList;
|
|
i, j, Count, MaxCount, WordLength, Index: Integer;
|
|
words: string;
|
|
StopWatch: TStopwatch;
|
|
|
|
begin
|
|
StopWatch := TStopwatch.Create;
|
|
StopWatch.Start;
|
|
|
|
Dict := TStringList.Create();
|
|
Dict.LoadFromFile('unixdict.txt');
|
|
|
|
Dict.CustomSort(CompareLength);
|
|
|
|
Index := 0;
|
|
words := Dict[Index];
|
|
Count := 1;
|
|
|
|
while Index + Count < Dict.Count do
|
|
begin
|
|
if IsAnagram(Dict[Index], Dict[Index + Count]) then
|
|
begin
|
|
words := words + ',' + Dict[Index + Count];
|
|
Dict[Index + Count] := '';
|
|
inc(Count);
|
|
end
|
|
else
|
|
begin
|
|
Dict[Index] := format('%.4d', [Count]) + ',' + words;
|
|
inc(Index, Count);
|
|
words := Dict[Index];
|
|
Count := 1;
|
|
end;
|
|
end;
|
|
|
|
// The last one not match any one
|
|
if not Dict[Dict.count - 1].IsEmpty then
|
|
Dict.Delete(Dict.count - 1);
|
|
|
|
Dict.Sort;
|
|
|
|
while Dict[0].IsEmpty do
|
|
Dict.Delete(0);
|
|
|
|
StopWatch.Stop;
|
|
|
|
Writeln(Format('Time pass: %d ms [i7-4500U Windows 7]', [StopWatch.ElapsedMilliseconds]));
|
|
|
|
Split(Dict[Dict.count - 1], MaxCount, words);
|
|
writeln(#10'The anagrams that contain the most words, has ', MaxCount, ' words:'#10);
|
|
writeln('Words found:'#10);
|
|
|
|
Writeln(' ', words);
|
|
|
|
for i := Dict.Count - 2 downto 0 do
|
|
begin
|
|
Split(Dict[i], Count, words);
|
|
if Count = MaxCount then
|
|
Writeln(' ', words)
|
|
else
|
|
Break;
|
|
end;
|
|
|
|
Dict.Free;
|
|
Readln;
|
|
end.
|