Next highest int from digits: Difference between revisions
Added Delphi example
(Added Wren) |
MaiconSoft (talk | contribs) (Added Delphi example) |
||
Line 430:
Permutations unique: OK = true
Permutation count: Actual = 10, Expected = 10, OK = true</pre>
=={{header|Delphi}}==
{{libheader| System.SysUtils}}
{{libheader| System.Generics.Collections}}
{{Trans|Go}}
<lang Delphi>
program Next_highest_int_from_digits;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
System.Generics.Collections;
function StrToBytes(str: AnsiString): TArray<byte>;
begin
SetLength(result, Length(str));
Move(Pointer(str)^, Pointer(result)^, Length(str));
end;
function BytesToStr(bytes: TArray<byte>): AnsiString;
begin
SetLength(Result, Length(bytes));
Move(Pointer(bytes)^, Pointer(Result)^, Length(bytes));
end;
function Commatize(s: string): string;
begin
var le := length(s);
var i := le - 3;
while i >= 1 do
begin
s := s.Substring(0, i) + ',' + s.Substring(i);
inc(i, -3);
end;
Result := s;
end;
function Permute(s: string): TArray<string>;
var
res: TArray<string>;
b: string;
procedure rc(np: Integer);
begin
if np = 1 then
begin
SetLength(res, Length(res) + 1);
res[High(res)] := b;
exit;
end;
var np1 := np - 1;
var pp := length(b) - np1;
rc(np1);
for var i := pp downto 1 do
begin
var tmp := b[i + 1];
b[i + 1] := b[i];
b[i] := tmp;
rc(np1);
end;
var w := b[1];
delete(b, 1, 1);
Insert(w, b, pp + 1);
end;
begin
if s.Length = 0 then
exit;
res := [];
b := s;
rc(length(b));
result := res;
end;
procedure Algorithm1(nums: TArray<string>);
begin
writeln('Algorithm 1');
writeln('-----------');
for var num in nums do
begin
var perms := permute(num);
var le := length(perms);
if le = 0 then
Continue;
TArray.Sort<string>(perms);
var ix := 0;
TArray.BinarySearch<string>(perms, num, ix);
var next := '';
if ix < le - 1 then
for var i := ix + 1 to le - 1 do
if perms[i] > num then
begin
next := perms[i];
Break;
end;
if length(next) > 0 then
writeln(format('%29s -> %s', [Commatize(num), Commatize(next)]))
else
writeln(format('%29s -> 0', [Commatize(num)]));
end;
writeln;
end;
procedure Algorithm2(nums: TArray<string>);
var
ContinueMainFor: boolean;
begin
writeln('Algorithm 2');
writeln('-----------');
for var num in nums do
begin
ContinueMainFor := false;
var le := num.Length;
if le = 0 then
Continue;
var b := StrToBytes(num);
var max := b[le - 1];
var mi := le - 1;
for var i := le - 2 downto 0 do
begin
if b[i] < max then
begin
var min := max - b[i];
for var j := mi + 1 to le - 1 do
begin
var min2 := b[j] - b[i];
if (min2 > 0) and (min2 < min) then
begin
min := min2;
mi := j;
end;
end;
var tmp := b[i];
b[i] := b[mi];
b[mi] := tmp;
var c := copy(b, i + 1, le);
TArray.Sort<byte>(c);
var next: string := BytesToStr(copy(b, 0, i + 1));
next := next + BytesToStr(c);
writeln(format('%29s -> %s', [Commatize(num), Commatize(next)]));
ContinueMainFor := true;
Break;
end
else if b[i] > max then
begin
max := b[i];
mi := i;
end;
end;
if ContinueMainFor then
Continue;
writeln(format('%29s -> 0', [Commatize(num)]));
end;
end;
begin
var nums: TArray<string> := ['0', '9', '12', '21', '12453', '738440',
'45072010', '95322020'];
algorithm1(nums); // exclude the last one
SetLength(nums, Length(nums) + 1);
nums[High(nums)] := '9589776899767587796600';
algorithm2(nums); // include the last one
{$IFNDEF UNIX}
readln; {$ENDIF}
end.</lang>
=={{header|Factor}}==
| |||