Anagrams: Difference between revisions

Line 1,934:
begin
if s1.Length <> s2.Length then
exit(falseFalse);
 
Result := Sort(s1) = Sort(s2);
 
end;
 
Line 1,945 ⟶ 1,947:
words := s.Substring(5);
Result := TryStrToInt(sCount, Count);
end;
 
function CompateLength(List: TStringList; Index1, Index2: Integer): Integer;
begin
result := List[Index1].Length - List[Index2].Length;
if CountResult >= 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
Dict := TStringList.Create;
dict.LoadFromFile('unixdict.txt');
StopWatch := TStopwatch.Create;
StopWatch.Start;
 
Dict := TStringList.Create();
for i := 0 to Dict.Count - 2 do
dictDict.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
Count := begin1;
 
words := words + ',' + Dict[j];
while Index + Count < Dict[j] :=.Count '';do
begin
inc(Count);
if (not Dict[j].IsEmpty) and IsAnagram(Dict[iIndex], Dict[jIndex + Count]) then
end;
begin
if Count > 0 then
Dict[i]words := format('%.4d', [Count+1])words + ',' + wordsDict[Index + Count];
Dict[iIndex + Count] := '';
Continueinc(Count);
end
else
begin
Dict[i] := '';
Dict[Index] := format('%.4d', [Count]) + ',' + words;
inc(Index, Count);
words := Dict[iIndex];
Count := 01;
end;
end;
 
Line 1,985 ⟶ 1,997:
 
Dict.Sort;
 
while Dict[0].IsEmpty do
Dict.Delete(0);
 
StopWatch.Stop;
 
writelnWriteln(Format('Time pass(s): %.2fd secms [i7-4500U Windows 7]', [StopWatch.ElapsedMilliseconds / 1000]));
 
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
Line 2,001 ⟶ 2,015:
Split(Dict[i], Count, words);
if Count = MaxCount then
Writeln(' ', words)
else
Break;
Line 2,014 ⟶ 2,028:
{{out}}
<pre>
Time pass(s): 90,92700 secms [i7-4500U Windows 7]
 
The anagrams that contain the most words, has 5 words:
 
Words found:
 
evil,levi veil,live,veil,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
glean,angel,angle,galen,gleanangle,lange
alger,glare,lager,large,regal
abel, able,bale,abel,bela,elba
</pre>
 
478

edits