Jump to content

Anagrams: Difference between revisions

2,582 bytes added ,  3 years ago
no edit summary
No edit summary
Line 1,892:
}</lang>
Runtime: about 0.06 seconds.
 
=={{header|Delphi}}==
{{libheader| System.SysUtils}}
{{libheader| System.Classes}}
{{libheader| System.Diagnostics}}
<lang Delphi>
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;
 
var
Dict: TStringList;
i, j, Count, MaxCount: Integer;
words: string;
StopWatch: TStopwatch;
 
begin
Dict := TStringList.Create;
dict.LoadFromFile('unixdict.txt');
StopWatch := TStopwatch.Create;
StopWatch.Start;
 
for i := 0 to Dict.Count - 2 do
begin
if (Dict[i].IsEmpty) then
Continue;
 
Count := 0;
words := Dict[i];
 
for j := i + 1 to Dict.Count - 1 do
if (not Dict[j].IsEmpty) and IsAnagram(Dict[i], Dict[j]) then
begin
words := words + ',' + Dict[j];
Dict[j] := '';
inc(Count);
end;
if Count > 0 then
Dict[i] := format('%.4d', [Count]) + ',' + words
else
Dict[i] := '';
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(s): %.2f sec', [StopWatch.ElapsedMilliseconds / 1000]));
 
Split(Dict[Dict.count - 1], MaxCount, words);
writeln(#10'The anagrams that contain the most words has ', MaxCount, ' chars:'#10);
writeln('Words:'#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.
 
</lang>
 
{{out}}
<pre>
Time pass(s): 90,92 sec
 
The anagrams that contain the most words has 4 chars:
 
Words:
 
evil,levi,live,veil,vile
elan,lane,lean,lena,neal
caret,carte,cater,crate,trace
angel,angle,galen,glean,lange
alger,glare,lager,large,regal
abel,able,bale,bela,elba
</pre>
 
 
=={{header|E}}==
478

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.