Anagrams: Difference between revisions

Content added Content deleted
Line 1,934: Line 1,934:
begin
begin
if s1.Length <> s2.Length then
if s1.Length <> s2.Length then
exit(false);
exit(False);

Result := Sort(s1) = Sort(s2);
Result := Sort(s1) = Sort(s2);

end;
end;


Line 1,945: Line 1,947:
words := s.Substring(5);
words := s.Substring(5);
Result := TryStrToInt(sCount, Count);
Result := TryStrToInt(sCount, Count);
end;

function CompateLength(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;
end;


var
var
Dict: TStringList;
Dict: TStringList;
i, j, Count, MaxCount: Integer;
i, j, Count, MaxCount, WordLength, Index: Integer;
words: string;
words: string;
StopWatch: TStopwatch;
StopWatch: TStopwatch;


begin
begin
⚫
Dict := TStringList.Create;
⚫
dict.LoadFromFile('unixdict.txt');
StopWatch := TStopwatch.Create;
StopWatch := TStopwatch.Create;
StopWatch.Start;
StopWatch.Start;


⚫
Dict := TStringList.Create();
for i := 0 to Dict.Count - 2 do
⚫
Dict.LoadFromFile('unixdict.txt');
⚫
begin
if (Dict[i].IsEmpty) then
⚫
Continue;


Dict.CustomSort(CompateLength);
⚫
Count := 0;
⚫
words := Dict[i];


Index := 0;
for j := i + 1 to Dict.Count - 1 do
words := Dict[Index];
⚫
if (not Dict[j].IsEmpty) and IsAnagram(Dict[i], Dict[j]) then
begin
Count := 1;

⚫
words := words + ',' + Dict[j];
Dict[j] := '';
while Index + Count < Dict.Count do
begin
⚫
inc(Count);
⚫
if IsAnagram(Dict[Index], Dict[Index + Count]) then
⚫
end;
begin
⚫
if Count > 0 then
Dict[i] := format('%.4d', [Count+1]) + ',' + words
words := words + ',' + Dict[Index + Count];
⚫
Dict[Index + Count] := '';
⚫
inc(Count);
end
else
else
begin
⚫
Dict[i] := '';
Dict[Index] := format('%.4d', [Count]) + ',' + words;
⚫
inc(Index, Count);
⚫
words := Dict[Index];
⚫
Count := 1;
⚫
end;
end;
end;


Line 1,985: Line 1,997:


Dict.Sort;
Dict.Sort;

while Dict[0].IsEmpty do
while Dict[0].IsEmpty do
Dict.Delete(0);
Dict.Delete(0);


StopWatch.Stop;
StopWatch.Stop;

writeln(Format('Time pass(s): %.2f sec', [StopWatch.ElapsedMilliseconds / 1000]));
Writeln(Format('Time pass: %d ms [i7-4500U Windows 7]', [StopWatch.ElapsedMilliseconds]));


Split(Dict[Dict.count - 1], MaxCount, words);
Split(Dict[Dict.count - 1], MaxCount, words);
writeln(#10'The anagrams that contain the most words has ', MaxCount, ' words:'#10);
writeln(#10'The anagrams that contain the most words, has ', MaxCount, ' words:'#10);
writeln('Words:'#10);
writeln('Words found:'#10);


Writeln(words);
Writeln(' ', words);


for i := Dict.Count - 2 downto 0 do
for i := Dict.Count - 2 downto 0 do
Line 2,001: Line 2,015:
Split(Dict[i], Count, words);
Split(Dict[i], Count, words);
if Count = MaxCount then
if Count = MaxCount then
Writeln(words)
Writeln(' ', words)
else
else
Break;
Break;
Line 2,014: Line 2,028:
{{out}}
{{out}}
<pre>
<pre>
Time pass(s): 90,92 sec
Time pass: 700 ms [i7-4500U Windows 7]


The anagrams that contain the most words has 5 words:
The anagrams that contain the most words, has 5 words:


Words:
Words found:


evil,levi,live,veil,vile
veil,live,vile,evil,levi
trace,crate,cater,carte,caret
elan,lane,lean,lena,neal
regal,glare,large,lager,alger
caret,carte,cater,crate,trace
neal,lean,elan,lane,lena
angel,angle,galen,glean,lange
glean,angel,galen,angle,lange
alger,glare,lager,large,regal
abel,able,bale,bela,elba
able,bale,abel,bela,elba
</pre>
</pre>


Retrieved from "https://rosettacode.org/wiki/Anagrams"