Data commit

Task/Next-highest-int-from-digits/Delphi/next-highest-int-from-digits.delphi

@@ -0,0 +1,172 @@
+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.