Data commit

Task/Anagrams/Delphi/anagrams.delphi

@@ -0,0 +1,125 @@
+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.