Ideone.com

fork download

copy

(* (C) I. Kakoulidis *)
{$mode objfpc}{$H+}{$J-}
{$ASSERTIONS ON}
{$warnings on}
{$hints on}
{$R+}{$Q+}
 
uses SysUtils;
 
type
  generic TTreapNode<T> = class
  private
    // Key
    FKey: T;
    // Random heap priority
    FPriority: extended;
    // Number of nodes in subtree
    FSize: SizeUInt;
    // Left subtree reference
    FLeft: TTreapNode;
    // Right subtree reference
    FRight: TTreapNode;
  public
    (* Tree node constructor. *)
    constructor Create(const k: T);
 
    (* Tree node destructor. *)
    destructor Destroy; override;
 
    (* Returns number of keys in the tree rooted at @code(node). *)
    class function GetSize(const node: TTreapNode): SizeUInt; inline;
 
    (* Recalculates number of keys in the tree rooted at @code(node) after insert, delete operations. *)
    class procedure UpdateSize(const node: TTreapNode); inline;
 
    (* Creates new tree from two trees, where @code(Min(r) >= Max(l)). *)
    class function Meld(l, r: TTreapNode): TTreapNode;
 
    (* Divides tree into two trees. Where @code(Max(l) <= k). *)
    class procedure Divide(node: TTreapNode; k: T; var l, r: TTreapNode);
 
    (* Divides tree into two trees. Where @code(Size(l) = pos). *)
    class procedure DivideAt(node: TTreapNode; const pos: SizeUInt;
      var l, r: TTreapNode);
 
    (* Returns @true if tree rooted at @code(node) is empty, @false otherwise *)
    class function IsEmpty(const node: TTreapNode): boolean; inline;
 
    (* Insert key @code(k) in tree rooted at @code(node). *)
    class procedure Insert(var node: TTreapNode; const k: T); inline;
 
    (* Check if tree rooted at @code(root) node contains key @code(k). *)
    class function Contains(node: TTreapNode; const k: T): boolean; inline;
 
    (* Number of keys less than @code(k) *)
    class function BisectLeft(node: TTreapNode; const k: T): SizeUInt;
    (* Number of keys less or equal @code(k) *)
    class function BisectRight(node: TTreapNode; const k: T): SizeUInt;
 
    class function GetPosition(node: TTreapNode; const k: T): SizeUInt;
 
    (* @raises(EArgumentException) *)
    class function GetAt(node: TTreapNode; pos: SizeUInt): T;
 
    (* Removes key from the tree.
       @returns(@true if successful, @false otherwise) *)
    class function Remove(var node: TTreapNode; const k: T): boolean;
 
    (* Removes key from the given position.
       @returns(key) *)
    class function RemoveAt(var node: TTreapNode; const pos: SizeUInt): T;
 
    (* Destroy tree. *)
    class procedure DestroyTreap(var node: TTreapNode);
 
    class function CheckStucture(node: TTreapNode): boolean;
  end;
 
//
// TTreapNode Class methods
//
constructor TTreapNode.Create(const k: T);
begin
  FKey := k;
  FPriority := Random;
  FSize := 1;
  FLeft := nil;
  FRight := nil;
end;
 
destructor TTreapNode.Destroy;
begin
  FLeft := nil;
  FRight := nil;
  inherited;
end;
 
// PASSED
class function TTreapNode.GetSize(const node: TTreapNode): SizeUInt; inline;
begin
  if node <> nil then
    Exit(node.FSize);
  Exit(0);
end;
 
// PASSED
class procedure TTreapNode.UpdateSize(const node: TTreapNode); inline;
begin
  if node <> nil then
    node.FSize := GetSize(node.FLeft) + GetSize(node.FRight) + 1;
end;
 
class function TTreapNode.IsEmpty(const node: TTreapNode): boolean; inline;
begin
  Exit(node = nil);
end;
 
class function TTreapNode.Meld(l, r: TTreapNode): TTreapNode;
begin
  if l = nil then
    Exit(r);
  if r = nil then
    Exit(l);
  if l.FPriority > r.FPriority then
  begin
    l.FRight := Meld(l.FRight, r);
    Result := l;
  end
  else
  begin
    r.FLeft := Meld(l, r.FLeft);
    Result := r;
  end;
  UpdateSize(Result);
end;
 
class procedure TTreapNode.DivideAt(node: TTreapNode; const pos: SizeUInt;
  var l, r: TTreapNode);
begin
  if node = nil then
  begin
    l := nil;
    r := nil;
    Exit
  end;
  if pos > GetSize(node.FLeft) then
  begin
    DivideAt(node.FRight, pos - GetSize(node.FLeft) - 1, node.FRight, r);
    l := node
  end
  else
  begin
    DivideAt(node.FLeft, pos, l, node.FLeft);
    r := node
  end;
  UpdateSize(node)
end;
 
// DivideRight
class procedure TTreapNode.Divide(node: TTreapNode; k: T; var l, r: TTreapNode);
begin
  if node = nil then
  begin
    l := nil;
    r := nil;
    Exit;
  end;
  if k < node.FKey then
  begin
    Divide(node.FLeft, k, l, node.FLeft);
    r := node;
  end
  else
  begin
    Divide(node.FRight, k, node.FRight, r);
    l := node;
  end;
  UpdateSize(node);
end;
 
class procedure TTreapNode.Insert(var node: TTreapNode; const k: T); inline;
var
  l: TTreapNode = nil;
  r: TTreapNode = nil;
begin
  Divide(node, k, l, r);
  node := Meld(l, Meld(TTreapNode.Create(k), r));
end;
 
// PASSED
class function TTreapNode.Contains(node: TTreapNode; const k: T): boolean; inline;
begin
  while node <> nil do
  begin
    if k = node.FKey then
      Exit(True);
    if k > node.FKey then
      node := node.FRight
    else
      node := node.FLeft;
  end;
  Exit(False);
end;
 
class function TTreapNode.BisectLeft(node: TTreapNode; const k: T): SizeUInt;
var
  pos: SizeUInt = 0;
begin
  while node <> nil do
  begin
    if k > node.FKey then
    begin
      pos := pos + GetSize(node.FLeft) + 1;
      node := node.FRight;
    end
    else
      node := node.FLeft;
  end;
  Exit(pos);
end;
 
class function TTreapNode.BisectRight(node: TTreapNode; const k: T): SizeUInt;
var
  pos: SizeUInt = 0;
begin
  while node <> nil do
  begin
    if k < node.FKey then
      node := node.FLeft
    else
    begin
      pos := pos + GetSize(node.FLeft) + 1;
      node := node.FRight;
    end;
  end;
  Exit(pos);
end;
 
// PASSED
class function TTreapNode.GetPosition(node: TTreapNode; const k: T): SizeUInt;
var
  pos: SizeUInt = 0;
begin
  while node <> nil do
  begin
    if k = node.FKey then
      Exit(pos + GetSize(node.FLeft));
    if k > node.FKey then
    begin
      pos := pos + GetSize(node.FLeft) + 1;
      node := node.FRight;
    end
    else
      node := node.FLeft;
  end;
  raise Exception.Create('No such key');
end;
 
// PASSED
class function TTreapNode.GetAt(node: TTreapNode; pos: SizeUInt): T;
var
  lsize: SizeUInt = 0;
begin
  if (node = nil) or (pos > GetSize(node) - 1) then
    raise EArgumentException.Create('Set is empty or position is out of range.');
  while node <> nil do
  begin
    lsize := GetSize(node.FLeft);
    if pos = lsize then
      Exit(node.FKey);
    if pos > lsize then
    begin
      node := node.FRight;
      pos := pos - lsize - 1;
    end
    else
      node := node.FLeft;
  end;
  raise Exception.Create('Unreachable point.');
end;
 
class function TTreapNode.Remove(var node: TTreapNode; const k: T): boolean;
var
  n: TTreapNode;
begin
  Result := False;
  if node <> nil then
  begin
    if k = node.FKey then
    begin
      n := node;
      node := Meld(node.FLeft, node.FRight);
      FreeAndNil(n);
      Exit(True);
    end;
    if k > node.FKey then
      Result := Remove(node.FRight, k)
    else
      Result := Remove(node.FLeft, k);
    if Result then
      UpdateSize(node);
  end;
end;
 
// RWRT
class function TTreapNode.RemoveAt(var node: TTreapNode; const pos: SizeUInt): T;
var
  n: TTreapNode;
begin
  if (node = nil) or (pos > GetSize(node) - 1) then
    raise EArgumentException.Create('Set is empty or position is out of range.');
  if pos = GetSize(node.FLeft) then
  begin
    Result := node.FKey;
    n := node;
    node := Meld(node.FLeft, node.FRight);
    FreeAndNil(n);
    Exit;
  end;
  if pos > GetSize(node.FLeft) then
    Result := RemoveAt(node.FRight, pos - GetSize(node.FLeft) - 1)
  else
    Result := RemoveAt(node.FLeft, pos);
  UpdateSize(node);
end;
 
class procedure TTreapNode.DestroyTreap(var node: TTreapNode);
begin
  if node <> nil then
  begin
    DestroyTreap(node.FLeft);
    DestroyTreap(node.FRight);
    FreeAndNil(node);
  end;
end;
 
class function TTreapNode.CheckStucture(node: TTreapNode): boolean;
begin
  Result := True;
  if node = nil then
    Exit(Result);
  with node do
  begin
    Result := Result and CheckStucture(node.FLeft);
    Result := Result and CheckStucture(node.FRight);
    Result := Result and (GetSize(node) = GetSize(node.FLeft) +
      GetSize(node.FRight) + 1);
    if node.FLeft <> nil then
    begin
      Result := Result and (node.FPriority >= node.FLeft.FPriority);
      Result := Result and ((node.FKey > node.FLeft.FKey) or
        (node.FKey = node.FLeft.FKey));
    end;
    if node.FRight <> nil then
    begin
      Result := Result and (node.FPriority >= node.FRight.FPriority);
      Result := Result and (node.FKey < node.FRight.FKey);
    end;
  end;
end;
 
type
  TInt64TreapNode = specialize TTreapNode<Int64>;
 
var
  ra: TInt64TreapNode = nil;
  i: longint;
 
begin
  Randomize;
  for i:= 1 to 1600000 do
  begin
    TInt64TreapNode.Insert(ra, Random(9223372036854775807));
  end;
  WriteLn(TInt64TreapNode.GetSize(ra));
end.
(*
100000 - 0.08s
200000 - 0.19s
400000 - 0.42s
800000 - 1.06s
1600000 - 2.58s
*)

KCogKEMpIEkuIEtha291bGlkaXMgKikKeyRtb2RlIG9iamZwY317JEgrfXskSi19CnskQVNTRVJUSU9OUyBPTn0KeyR3YXJuaW5ncyBvbn0KeyRoaW50cyBvbn0KeyRSK317JFErfQoKdXNlcyBTeXNVdGlsczsKCnR5cGUKICBnZW5lcmljIFRUcmVhcE5vZGU8VD4gPSBjbGFzcwogIHByaXZhdGUKICAgIC8vIEtleQogICAgRktleTogVDsKICAgIC8vIFJhbmRvbSBoZWFwIHByaW9yaXR5CiAgICBGUHJpb3JpdHk6IGV4dGVuZGVkOwogICAgLy8gTnVtYmVyIG9mIG5vZGVzIGluIHN1YnRyZWUKICAgIEZTaXplOiBTaXplVUludDsKICAgIC8vIExlZnQgc3VidHJlZSByZWZlcmVuY2UKICAgIEZMZWZ0OiBUVHJlYXBOb2RlOwogICAgLy8gUmlnaHQgc3VidHJlZSByZWZlcmVuY2UKICAgIEZSaWdodDogVFRyZWFwTm9kZTsKICBwdWJsaWMKICAgICgqIFRyZWUgbm9kZSBjb25zdHJ1Y3Rvci4gKikKICAgIGNvbnN0cnVjdG9yIENyZWF0ZShjb25zdCBrOiBUKTsKCiAgICAoKiBUcmVlIG5vZGUgZGVzdHJ1Y3Rvci4gKikKICAgIGRlc3RydWN0b3IgRGVzdHJveTsgb3ZlcnJpZGU7CgogICAgKCogUmV0dXJucyBudW1iZXIgb2Yga2V5cyBpbiB0aGUgdHJlZSByb290ZWQgYXQgQGNvZGUobm9kZSkuICopCiAgICBjbGFzcyBmdW5jdGlvbiBHZXRTaXplKGNvbnN0IG5vZGU6IFRUcmVhcE5vZGUpOiBTaXplVUludDsgaW5saW5lOwoKICAgICgqIFJlY2FsY3VsYXRlcyBudW1iZXIgb2Yga2V5cyBpbiB0aGUgdHJlZSByb290ZWQgYXQgQGNvZGUobm9kZSkgYWZ0ZXIgaW5zZXJ0LCBkZWxldGUgb3BlcmF0aW9ucy4gKikKICAgIGNsYXNzIHByb2NlZHVyZSBVcGRhdGVTaXplKGNvbnN0IG5vZGU6IFRUcmVhcE5vZGUpOyBpbmxpbmU7CgogICAgKCogQ3JlYXRlcyBuZXcgdHJlZSBmcm9tIHR3byB0cmVlcywgd2hlcmUgQGNvZGUoTWluKHIpID49IE1heChsKSkuICopCiAgICBjbGFzcyBmdW5jdGlvbiBNZWxkKGwsIHI6IFRUcmVhcE5vZGUpOiBUVHJlYXBOb2RlOwoKICAgICgqIERpdmlkZXMgdHJlZSBpbnRvIHR3byB0cmVlcy4gV2hlcmUgQGNvZGUoTWF4KGwpIDw9IGspLiAqKQogICAgY2xhc3MgcHJvY2VkdXJlIERpdmlkZShub2RlOiBUVHJlYXBOb2RlOyBrOiBUOyB2YXIgbCwgcjogVFRyZWFwTm9kZSk7CgogICAgKCogRGl2aWRlcyB0cmVlIGludG8gdHdvIHRyZWVzLiBXaGVyZSBAY29kZShTaXplKGwpID0gcG9zKS4gKikKICAgIGNsYXNzIHByb2NlZHVyZSBEaXZpZGVBdChub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBwb3M6IFNpemVVSW50OwogICAgICB2YXIgbCwgcjogVFRyZWFwTm9kZSk7CgogICAgKCogUmV0dXJucyBAdHJ1ZSBpZiB0cmVlIHJvb3RlZCBhdCBAY29kZShub2RlKSBpcyBlbXB0eSwgQGZhbHNlIG90aGVyd2lzZSAqKQogICAgY2xhc3MgZnVuY3Rpb24gSXNFbXB0eShjb25zdCBub2RlOiBUVHJlYXBOb2RlKTogYm9vbGVhbjsgaW5saW5lOwoKICAgICgqIEluc2VydCBrZXkgQGNvZGUoaykgaW4gdHJlZSByb290ZWQgYXQgQGNvZGUobm9kZSkuICopCiAgICBjbGFzcyBwcm9jZWR1cmUgSW5zZXJ0KHZhciBub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBrOiBUKTsgaW5saW5lOwoKICAgICgqIENoZWNrIGlmIHRyZWUgcm9vdGVkIGF0IEBjb2RlKHJvb3QpIG5vZGUgY29udGFpbnMga2V5IEBjb2RlKGspLiAqKQogICAgY2xhc3MgZnVuY3Rpb24gQ29udGFpbnMobm9kZTogVFRyZWFwTm9kZTsgY29uc3QgazogVCk6IGJvb2xlYW47IGlubGluZTsKCiAgICAoKiBOdW1iZXIgb2Yga2V5cyBsZXNzIHRoYW4gQGNvZGUoaykgKikKICAgIGNsYXNzIGZ1bmN0aW9uIEJpc2VjdExlZnQobm9kZTogVFRyZWFwTm9kZTsgY29uc3QgazogVCk6IFNpemVVSW50OwogICAgKCogTnVtYmVyIG9mIGtleXMgbGVzcyBvciBlcXVhbCBAY29kZShrKSAqKQogICAgY2xhc3MgZnVuY3Rpb24gQmlzZWN0UmlnaHQobm9kZTogVFRyZWFwTm9kZTsgY29uc3QgazogVCk6IFNpemVVSW50OwoKICAgIGNsYXNzIGZ1bmN0aW9uIEdldFBvc2l0aW9uKG5vZGU6IFRUcmVhcE5vZGU7IGNvbnN0IGs6IFQpOiBTaXplVUludDsKCiAgICAoKiBAcmFpc2VzKEVBcmd1bWVudEV4Y2VwdGlvbikgKikKICAgIGNsYXNzIGZ1bmN0aW9uIEdldEF0KG5vZGU6IFRUcmVhcE5vZGU7IHBvczogU2l6ZVVJbnQpOiBUOwoKICAgICgqIFJlbW92ZXMga2V5IGZyb20gdGhlIHRyZWUuCiAgICAgICBAcmV0dXJucyhAdHJ1ZSBpZiBzdWNjZXNzZnVsLCBAZmFsc2Ugb3RoZXJ3aXNlKSAqKQogICAgY2xhc3MgZnVuY3Rpb24gUmVtb3ZlKHZhciBub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBrOiBUKTogYm9vbGVhbjsKCiAgICAoKiBSZW1vdmVzIGtleSBmcm9tIHRoZSBnaXZlbiBwb3NpdGlvbi4KICAgICAgIEByZXR1cm5zKGtleSkgKikKICAgIGNsYXNzIGZ1bmN0aW9uIFJlbW92ZUF0KHZhciBub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBwb3M6IFNpemVVSW50KTogVDsKCiAgICAoKiBEZXN0cm95IHRyZWUuICopCiAgICBjbGFzcyBwcm9jZWR1cmUgRGVzdHJveVRyZWFwKHZhciBub2RlOiBUVHJlYXBOb2RlKTsKCiAgICBjbGFzcyBmdW5jdGlvbiBDaGVja1N0dWN0dXJlKG5vZGU6IFRUcmVhcE5vZGUpOiBib29sZWFuOwogIGVuZDsKCi8vCi8vIFRUcmVhcE5vZGUgQ2xhc3MgbWV0aG9kcwovLwpjb25zdHJ1Y3RvciBUVHJlYXBOb2RlLkNyZWF0ZShjb25zdCBrOiBUKTsKYmVnaW4KICBGS2V5IDo9IGs7CiAgRlByaW9yaXR5IDo9IFJhbmRvbTsKICBGU2l6ZSA6PSAxOwogIEZMZWZ0IDo9IG5pbDsKICBGUmlnaHQgOj0gbmlsOwplbmQ7CgpkZXN0cnVjdG9yIFRUcmVhcE5vZGUuRGVzdHJveTsKYmVnaW4KICBGTGVmdCA6PSBuaWw7CiAgRlJpZ2h0IDo9IG5pbDsKICBpbmhlcml0ZWQ7CmVuZDsKCi8vIFBBU1NFRApjbGFzcyBmdW5jdGlvbiBUVHJlYXBOb2RlLkdldFNpemUoY29uc3Qgbm9kZTogVFRyZWFwTm9kZSk6IFNpemVVSW50OyBpbmxpbmU7CmJlZ2luCiAgaWYgbm9kZSA8PiBuaWwgdGhlbgogICAgRXhpdChub2RlLkZTaXplKTsKICBFeGl0KDApOwplbmQ7CgovLyBQQVNTRUQKY2xhc3MgcHJvY2VkdXJlIFRUcmVhcE5vZGUuVXBkYXRlU2l6ZShjb25zdCBub2RlOiBUVHJlYXBOb2RlKTsgaW5saW5lOwpiZWdpbgogIGlmIG5vZGUgPD4gbmlsIHRoZW4KICAgIG5vZGUuRlNpemUgOj0gR2V0U2l6ZShub2RlLkZMZWZ0KSArIEdldFNpemUobm9kZS5GUmlnaHQpICsgMTsKZW5kOwoKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5Jc0VtcHR5KGNvbnN0IG5vZGU6IFRUcmVhcE5vZGUpOiBib29sZWFuOyBpbmxpbmU7CmJlZ2luCiAgRXhpdChub2RlID0gbmlsKTsKZW5kOwoKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5NZWxkKGwsIHI6IFRUcmVhcE5vZGUpOiBUVHJlYXBOb2RlOwpiZWdpbgogIGlmIGwgPSBuaWwgdGhlbgogICAgRXhpdChyKTsKICBpZiByID0gbmlsIHRoZW4KICAgIEV4aXQobCk7CiAgaWYgbC5GUHJpb3JpdHkgPiByLkZQcmlvcml0eSB0aGVuCiAgYmVnaW4KICAgIGwuRlJpZ2h0IDo9IE1lbGQobC5GUmlnaHQsIHIpOwogICAgUmVzdWx0IDo9IGw7CiAgZW5kCiAgZWxzZQogIGJlZ2luCiAgICByLkZMZWZ0IDo9IE1lbGQobCwgci5GTGVmdCk7CiAgICBSZXN1bHQgOj0gcjsKICBlbmQ7CiAgVXBkYXRlU2l6ZShSZXN1bHQpOwplbmQ7CgpjbGFzcyBwcm9jZWR1cmUgVFRyZWFwTm9kZS5EaXZpZGVBdChub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBwb3M6IFNpemVVSW50OwogIHZhciBsLCByOiBUVHJlYXBOb2RlKTsKYmVnaW4KICBpZiBub2RlID0gbmlsIHRoZW4KICBiZWdpbgogICAgbCA6PSBuaWw7CiAgICByIDo9IG5pbDsKICAgIEV4aXQKICBlbmQ7CiAgaWYgcG9zID4gR2V0U2l6ZShub2RlLkZMZWZ0KSB0aGVuCiAgYmVnaW4KICAgIERpdmlkZUF0KG5vZGUuRlJpZ2h0LCBwb3MgLSBHZXRTaXplKG5vZGUuRkxlZnQpIC0gMSwgbm9kZS5GUmlnaHQsIHIpOwogICAgbCA6PSBub2RlCiAgZW5kCiAgZWxzZQogIGJlZ2luCiAgICBEaXZpZGVBdChub2RlLkZMZWZ0LCBwb3MsIGwsIG5vZGUuRkxlZnQpOwogICAgciA6PSBub2RlCiAgZW5kOwogIFVwZGF0ZVNpemUobm9kZSkKZW5kOwoKLy8gRGl2aWRlUmlnaHQKY2xhc3MgcHJvY2VkdXJlIFRUcmVhcE5vZGUuRGl2aWRlKG5vZGU6IFRUcmVhcE5vZGU7IGs6IFQ7IHZhciBsLCByOiBUVHJlYXBOb2RlKTsKYmVnaW4KICBpZiBub2RlID0gbmlsIHRoZW4KICBiZWdpbgogICAgbCA6PSBuaWw7CiAgICByIDo9IG5pbDsKICAgIEV4aXQ7CiAgZW5kOwogIGlmIGsgPCBub2RlLkZLZXkgdGhlbgogIGJlZ2luCiAgICBEaXZpZGUobm9kZS5GTGVmdCwgaywgbCwgbm9kZS5GTGVmdCk7CiAgICByIDo9IG5vZGU7CiAgZW5kCiAgZWxzZQogIGJlZ2luCiAgICBEaXZpZGUobm9kZS5GUmlnaHQsIGssIG5vZGUuRlJpZ2h0LCByKTsKICAgIGwgOj0gbm9kZTsKICBlbmQ7CiAgVXBkYXRlU2l6ZShub2RlKTsKZW5kOwoKY2xhc3MgcHJvY2VkdXJlIFRUcmVhcE5vZGUuSW5zZXJ0KHZhciBub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBrOiBUKTsgaW5saW5lOwp2YXIKICBsOiBUVHJlYXBOb2RlID0gbmlsOwogIHI6IFRUcmVhcE5vZGUgPSBuaWw7CmJlZ2luCiAgRGl2aWRlKG5vZGUsIGssIGwsIHIpOwogIG5vZGUgOj0gTWVsZChsLCBNZWxkKFRUcmVhcE5vZGUuQ3JlYXRlKGspLCByKSk7CmVuZDsKCi8vIFBBU1NFRApjbGFzcyBmdW5jdGlvbiBUVHJlYXBOb2RlLkNvbnRhaW5zKG5vZGU6IFRUcmVhcE5vZGU7IGNvbnN0IGs6IFQpOiBib29sZWFuOyBpbmxpbmU7CmJlZ2luCiAgd2hpbGUgbm9kZSA8PiBuaWwgZG8KICBiZWdpbgogICAgaWYgayA9IG5vZGUuRktleSB0aGVuCiAgICAgIEV4aXQoVHJ1ZSk7CiAgICBpZiBrID4gbm9kZS5GS2V5IHRoZW4KICAgICAgbm9kZSA6PSBub2RlLkZSaWdodAogICAgZWxzZQogICAgICBub2RlIDo9IG5vZGUuRkxlZnQ7CiAgZW5kOwogIEV4aXQoRmFsc2UpOwplbmQ7CgpjbGFzcyBmdW5jdGlvbiBUVHJlYXBOb2RlLkJpc2VjdExlZnQobm9kZTogVFRyZWFwTm9kZTsgY29uc3QgazogVCk6IFNpemVVSW50Owp2YXIKICBwb3M6IFNpemVVSW50ID0gMDsKYmVnaW4KICB3aGlsZSBub2RlIDw+IG5pbCBkbwogIGJlZ2luCiAgICBpZiBrID4gbm9kZS5GS2V5IHRoZW4KICAgIGJlZ2luCiAgICAgIHBvcyA6PSBwb3MgKyBHZXRTaXplKG5vZGUuRkxlZnQpICsgMTsKICAgICAgbm9kZSA6PSBub2RlLkZSaWdodDsKICAgIGVuZAogICAgZWxzZQogICAgICBub2RlIDo9IG5vZGUuRkxlZnQ7CiAgZW5kOwogIEV4aXQocG9zKTsKZW5kOwoKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5CaXNlY3RSaWdodChub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBrOiBUKTogU2l6ZVVJbnQ7CnZhcgogIHBvczogU2l6ZVVJbnQgPSAwOwpiZWdpbgogIHdoaWxlIG5vZGUgPD4gbmlsIGRvCiAgYmVnaW4KICAgIGlmIGsgPCBub2RlLkZLZXkgdGhlbgogICAgICBub2RlIDo9IG5vZGUuRkxlZnQKICAgIGVsc2UKICAgIGJlZ2luCiAgICAgIHBvcyA6PSBwb3MgKyBHZXRTaXplKG5vZGUuRkxlZnQpICsgMTsKICAgICAgbm9kZSA6PSBub2RlLkZSaWdodDsKICAgIGVuZDsKICBlbmQ7CiAgRXhpdChwb3MpOwplbmQ7CgovLyBQQVNTRUQKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5HZXRQb3NpdGlvbihub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBrOiBUKTogU2l6ZVVJbnQ7CnZhcgogIHBvczogU2l6ZVVJbnQgPSAwOwpiZWdpbgogIHdoaWxlIG5vZGUgPD4gbmlsIGRvCiAgYmVnaW4KICAgIGlmIGsgPSBub2RlLkZLZXkgdGhlbgogICAgICBFeGl0KHBvcyArIEdldFNpemUobm9kZS5GTGVmdCkpOwogICAgaWYgayA+IG5vZGUuRktleSB0aGVuCiAgICBiZWdpbgogICAgICBwb3MgOj0gcG9zICsgR2V0U2l6ZShub2RlLkZMZWZ0KSArIDE7CiAgICAgIG5vZGUgOj0gbm9kZS5GUmlnaHQ7CiAgICBlbmQKICAgIGVsc2UKICAgICAgbm9kZSA6PSBub2RlLkZMZWZ0OwogIGVuZDsKICByYWlzZSBFeGNlcHRpb24uQ3JlYXRlKCdObyBzdWNoIGtleScpOwplbmQ7CgovLyBQQVNTRUQKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5HZXRBdChub2RlOiBUVHJlYXBOb2RlOyBwb3M6IFNpemVVSW50KTogVDsKdmFyCiAgbHNpemU6IFNpemVVSW50ID0gMDsKYmVnaW4KICBpZiAobm9kZSA9IG5pbCkgb3IgKHBvcyA+IEdldFNpemUobm9kZSkgLSAxKSB0aGVuCiAgICByYWlzZSBFQXJndW1lbnRFeGNlcHRpb24uQ3JlYXRlKCdTZXQgaXMgZW1wdHkgb3IgcG9zaXRpb24gaXMgb3V0IG9mIHJhbmdlLicpOwogIHdoaWxlIG5vZGUgPD4gbmlsIGRvCiAgYmVnaW4KICAgIGxzaXplIDo9IEdldFNpemUobm9kZS5GTGVmdCk7CiAgICBpZiBwb3MgPSBsc2l6ZSB0aGVuCiAgICAgIEV4aXQobm9kZS5GS2V5KTsKICAgIGlmIHBvcyA+IGxzaXplIHRoZW4KICAgIGJlZ2luCiAgICAgIG5vZGUgOj0gbm9kZS5GUmlnaHQ7CiAgICAgIHBvcyA6PSBwb3MgLSBsc2l6ZSAtIDE7CiAgICBlbmQKICAgIGVsc2UKICAgICAgbm9kZSA6PSBub2RlLkZMZWZ0OwogIGVuZDsKICByYWlzZSBFeGNlcHRpb24uQ3JlYXRlKCdVbnJlYWNoYWJsZSBwb2ludC4nKTsKZW5kOwoKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5SZW1vdmUodmFyIG5vZGU6IFRUcmVhcE5vZGU7IGNvbnN0IGs6IFQpOiBib29sZWFuOwp2YXIKICBuOiBUVHJlYXBOb2RlOwpiZWdpbgogIFJlc3VsdCA6PSBGYWxzZTsKICBpZiBub2RlIDw+IG5pbCB0aGVuCiAgYmVnaW4KICAgIGlmIGsgPSBub2RlLkZLZXkgdGhlbgogICAgYmVnaW4KICAgICAgbiA6PSBub2RlOwogICAgICBub2RlIDo9IE1lbGQobm9kZS5GTGVmdCwgbm9kZS5GUmlnaHQpOwogICAgICBGcmVlQW5kTmlsKG4pOwogICAgICBFeGl0KFRydWUpOwogICAgZW5kOwogICAgaWYgayA+IG5vZGUuRktleSB0aGVuCiAgICAgIFJlc3VsdCA6PSBSZW1vdmUobm9kZS5GUmlnaHQsIGspCiAgICBlbHNlCiAgICAgIFJlc3VsdCA6PSBSZW1vdmUobm9kZS5GTGVmdCwgayk7CiAgICBpZiBSZXN1bHQgdGhlbgogICAgICBVcGRhdGVTaXplKG5vZGUpOwogIGVuZDsKZW5kOwoKLy8gUldSVApjbGFzcyBmdW5jdGlvbiBUVHJlYXBOb2RlLlJlbW92ZUF0KHZhciBub2RlOiBUVHJlYXBOb2RlOyBjb25zdCBwb3M6IFNpemVVSW50KTogVDsKdmFyCiAgbjogVFRyZWFwTm9kZTsKYmVnaW4KICBpZiAobm9kZSA9IG5pbCkgb3IgKHBvcyA+IEdldFNpemUobm9kZSkgLSAxKSB0aGVuCiAgICByYWlzZSBFQXJndW1lbnRFeGNlcHRpb24uQ3JlYXRlKCdTZXQgaXMgZW1wdHkgb3IgcG9zaXRpb24gaXMgb3V0IG9mIHJhbmdlLicpOwogIGlmIHBvcyA9IEdldFNpemUobm9kZS5GTGVmdCkgdGhlbgogIGJlZ2luCiAgICBSZXN1bHQgOj0gbm9kZS5GS2V5OwogICAgbiA6PSBub2RlOwogICAgbm9kZSA6PSBNZWxkKG5vZGUuRkxlZnQsIG5vZGUuRlJpZ2h0KTsKICAgIEZyZWVBbmROaWwobik7CiAgICBFeGl0OwogIGVuZDsKICBpZiBwb3MgPiBHZXRTaXplKG5vZGUuRkxlZnQpIHRoZW4KICAgIFJlc3VsdCA6PSBSZW1vdmVBdChub2RlLkZSaWdodCwgcG9zIC0gR2V0U2l6ZShub2RlLkZMZWZ0KSAtIDEpCiAgZWxzZQogICAgUmVzdWx0IDo9IFJlbW92ZUF0KG5vZGUuRkxlZnQsIHBvcyk7CiAgVXBkYXRlU2l6ZShub2RlKTsKZW5kOwoKY2xhc3MgcHJvY2VkdXJlIFRUcmVhcE5vZGUuRGVzdHJveVRyZWFwKHZhciBub2RlOiBUVHJlYXBOb2RlKTsKYmVnaW4KICBpZiBub2RlIDw+IG5pbCB0aGVuCiAgYmVnaW4KICAgIERlc3Ryb3lUcmVhcChub2RlLkZMZWZ0KTsKICAgIERlc3Ryb3lUcmVhcChub2RlLkZSaWdodCk7CiAgICBGcmVlQW5kTmlsKG5vZGUpOwogIGVuZDsKZW5kOwoKY2xhc3MgZnVuY3Rpb24gVFRyZWFwTm9kZS5DaGVja1N0dWN0dXJlKG5vZGU6IFRUcmVhcE5vZGUpOiBib29sZWFuOwpiZWdpbgogIFJlc3VsdCA6PSBUcnVlOwogIGlmIG5vZGUgPSBuaWwgdGhlbgogICAgRXhpdChSZXN1bHQpOwogIHdpdGggbm9kZSBkbwogIGJlZ2luCiAgICBSZXN1bHQgOj0gUmVzdWx0IGFuZCBDaGVja1N0dWN0dXJlKG5vZGUuRkxlZnQpOwogICAgUmVzdWx0IDo9IFJlc3VsdCBhbmQgQ2hlY2tTdHVjdHVyZShub2RlLkZSaWdodCk7CiAgICBSZXN1bHQgOj0gUmVzdWx0IGFuZCAoR2V0U2l6ZShub2RlKSA9IEdldFNpemUobm9kZS5GTGVmdCkgKwogICAgICBHZXRTaXplKG5vZGUuRlJpZ2h0KSArIDEpOwogICAgaWYgbm9kZS5GTGVmdCA8PiBuaWwgdGhlbgogICAgYmVnaW4KICAgICAgUmVzdWx0IDo9IFJlc3VsdCBhbmQgKG5vZGUuRlByaW9yaXR5ID49IG5vZGUuRkxlZnQuRlByaW9yaXR5KTsKICAgICAgUmVzdWx0IDo9IFJlc3VsdCBhbmQgKChub2RlLkZLZXkgPiBub2RlLkZMZWZ0LkZLZXkpIG9yCiAgICAgICAgKG5vZGUuRktleSA9IG5vZGUuRkxlZnQuRktleSkpOwogICAgZW5kOwogICAgaWYgbm9kZS5GUmlnaHQgPD4gbmlsIHRoZW4KICAgIGJlZ2luCiAgICAgIFJlc3VsdCA6PSBSZXN1bHQgYW5kIChub2RlLkZQcmlvcml0eSA+PSBub2RlLkZSaWdodC5GUHJpb3JpdHkpOwogICAgICBSZXN1bHQgOj0gUmVzdWx0IGFuZCAobm9kZS5GS2V5IDwgbm9kZS5GUmlnaHQuRktleSk7CiAgICBlbmQ7CiAgZW5kOwplbmQ7Cgp0eXBlCiAgVEludDY0VHJlYXBOb2RlID0gc3BlY2lhbGl6ZSBUVHJlYXBOb2RlPEludDY0PjsKCnZhcgogIHJhOiBUSW50NjRUcmVhcE5vZGUgPSBuaWw7CiAgaTogbG9uZ2ludDsKCmJlZ2luCiAgUmFuZG9taXplOwogIGZvciBpOj0gMSB0byAxNjAwMDAwIGRvCiAgYmVnaW4KICAgIFRJbnQ2NFRyZWFwTm9kZS5JbnNlcnQocmEsIFJhbmRvbSg5MjIzMzcyMDM2ODU0Nzc1ODA3KSk7CiAgZW5kOwogIFdyaXRlTG4oVEludDY0VHJlYXBOb2RlLkdldFNpemUocmEpKTsKZW5kLgooKgoxMDAwMDAgLSAwLjA4cwoyMDAwMDAgLSAwLjE5cwo0MDAwMDAgLSAwLjQycwo4MDAwMDAgLSAxLjA2cwoxNjAwMDAwIC0gMi41OHMKKik=

Success #stdin #stdout 2.59s 150784KB

stdin

copy

Standard input is empty

stdout

copy

https://ideone.com/0YvvRx

language:

Pascal (fpc 3.0.4)

created:

visibility:

secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!

Discover > Sphere Engine API

Discover > IDE Widget

Choose your language