Anonymous user
Anagrams/Deranged anagrams: Difference between revisions
→{{header|PARI/GP}}: added Pascal copy of Delphi-version
m (better lang tags) |
(→{{header|PARI/GP}}: added Pascal copy of Delphi-version) |
||
Line 2,507:
{{out}}
<pre>%1 = [["excitation", "intoxicate"]]</pre>
=={{header|Pascal}}==
{{Works with|Free Pascal}}{{trans|Delphi}}
Only bubble-Sort replaced by insertion sort runtime 153 ms -> 97 ms (Free Pascal Compiler version 3.3.1 [2019/08/16]?? for x86_64)
<lang pascal>program Anagrams_Deranged;
{$IFDEF FPC}
{$MODE Delphi}
uses
SysUtils,
Classes;
{$ELSE}
{$APPTYPE CONSOLE}
uses
System.SysUtils,
System.Classes,
System.Diagnostics;
{$R *.res}
{$ENDIF}
function Sort(const s: string):string;
//insertion sort
var
pRes : pchar;
i, j, aLength: NativeInt;
tmpc: Char;
begin
aLength := s.Length;
if aLength = 0 then
exit('');
Result := s;
//without it, s will be sorted
UniqueString(Result);
//insertion sort
pRes := pChar(Result);
dec(aLength,1);
for i := 0 to aLength do
Begin
tmpc := pRes[i];
j := i-1;
while (j>=0) AND (tmpc < pRes[j]) do
Begin
pRes[j+1] := pRes[j];
dec(j);
end;
inc(j);
pRes[j]:= tmpc;
end;
//writeln(s,' ',result)
end;
function IsAnagram(const s1, s2: string): Boolean;
begin
if s1.Length <> s2.Length then exit(False);
Result := Sort(s1) = Sort(s2);
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;
function IsDerangement(const word1, word2: string): Boolean;
var
i: Integer;
begin
for i := 1 to word1.Length do
if word1[i] = word2[i] then
exit(False);
Result := True;
end;
var
Dict: TStringList;
words: string;
StopWatch: Int64;
Count, Index: NativeInt;
begin
Dict := TStringList.Create();
Dict.LoadFromFile('unixdict.txt');
StopWatch := GettickCount64;
Dict.CustomSort(CompareLength);
Index := Dict.Count - 1;
words := '';
Count := 1;
while Index - Count >= 0 do
begin
if isAnagram(Dict[Index],Dict[Index - Count]) then
begin
if IsDerangement(Dict[Index],Dict[Index - Count]) then
begin
words := Dict[Index] + ' - ' + Dict[Index - Count];
Break;
end;
Inc(Count);
end
else
begin
Dec(Index, Count);
Count := 1;
end;
end;
StopWatch := GettickCount64-StopWatch;
Writeln(Format('Time pass: %d ms [AMD 2200G-Linux Fossa]', [StopWatch]));
writeln(#10'Longest derangement words are:'#10#10, words);
Dict.Free;
end.</lang>
{{out}}
<pre>
Time pass: 97 ms [AMD 2200G-Linux Fossa]
Longest derangement words are:
excitation - intoxicate</pre>
=={{header|Perl}}==
| |||