⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 _algorithms_base_private.inc_pas

📁 delphi的范型代码库
💻 INC_PAS
📖 第 1 页 / 共 2 页
字号:
🔍
12 
    It.Next();
  end;
end;


{$ifdef  _DGL_Algorithms_Object_Function}
class function _TAlgorithms.Search(const ItBegin,ItEnd,ItBeginSub,ItEndSub: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject): {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
{$else}
class function _TAlgorithms.Search(const ItBegin,ItEnd,ItBeginSub,ItEndSub: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction): {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
{$endif}
  function IsEqualsSub(const ItBegin,ItEnd,ItBeginSub,ItEndSub: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ):boolean;
  var
    ItSrc,ItSub :  {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
  begin
    ItSrc:=ItBegin;
    ItSub:=ItBeginSub;

    while not ItSub.IsEqual(ItEndSub) do
    begin
      if ItSrc.IsEqual(ItEnd) or
       ( not TestBinaryFunction(ItSrc.Value,ItSub.Value) ) then
      begin
        result:=false;
        exit;
      end
      else
      begin
        ItSrc.Next;
        ItSub.Next;
      end;
    end;
    result:=true;
  end;

begin
  if ItBeginSub.IsEqual(ItEndSub) then
  begin
    result:=ItEnd;
    exit;
  end;

  result:=FindIf(ItBegin,ItEnd,ItBeginSub.Value,TestBinaryFunction);
  While (not result.IsEqual(ItEnd)) do
  begin
    // test if Equal
    if IsEqualsSub(result,ItEnd,ItBeginSub,ItEndSub) then
    begin
      exit;
    end;
    result.Next();
    result:=FindIf(result,ItEnd,ItBeginSub.Value,TestBinaryFunction);
  end;
end;

{$ifdef  _DGL_Algorithms_Object_Function}
class procedure _TAlgorithms.RandomShuffle(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const RandomGenerateFunction:TRandomGenerateFunctionOfObject);
{$else}
class procedure _TAlgorithms.RandomShuffle(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const RandomGenerateFunction:TRandomGenerateFunction);
{$endif}
var
  It,ItRandom : {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
  MaxStep : integer;
begin
  It:=ItBegin;
  ItRandom:=ItBegin;
  MaxStep:=ItBegin.Distance(ItEnd);
  while not It.IsEqual(ItEnd) do
  begin
    ItRandom.Next(RandomGenerateFunction(MaxStep));
    SwapValue(It,ItRandom);
    It.Next;
    ItRandom.Assign(ItBegin);
  end;
end;


{$ifdef  _DGL_Algorithms_Object_Function}
        procedure __DGL_QuickSort(const ItBegin: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;Right:integer;
            const TestBinaryFunction:TTestBinaryFunctionOfObject);overload;
{$else}
        procedure __DGL_QuickSort(const ItBegin: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;Right:integer;
            const TestBinaryFunction:TTestBinaryFunction);overload;
{$endif}
        var
          i,j : integer;
        begin
          _TAlgorithms.SwapValue(ItBegin,0,random(Right+1));
          i:=0;
          j:=Right+1;
          while true do
          begin
            repeat
              inc(i)
            until not((i<=Right) and (TestBinaryFunction(ItBegin.NextValue[i],ItBegin.Value)));
            repeat                           
              dec(j)
            until not(TestBinaryFunction(ItBegin.Value,ItBegin.NextValue[j]));
            if i>j then break;

            _TAlgorithms.SwapValue(ItBegin,i,j);
          end;
          _TAlgorithms.SwapValue(ItBegin,0,j);
          if j>1 then
            __DGL_QuickSort(ItBegin,j-1,TestBinaryFunction);
          inc(j);
          dec(Right,j);
          if Right>0 then
            __DGL_QuickSort(ItBegin.Clone(j),Right,TestBinaryFunction);
        end;


{$ifdef  _DGL_Algorithms_Object_Function}
class procedure _TAlgorithms.Sort(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject);
{$else}
class procedure _TAlgorithms.Sort(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction);
{$endif}
var
  Right: integer;
begin
  if (ItBegin._ObjIteratorClass=_TVectorIterator) then
  begin
    Sort(_PValueType_Iterator(ItBegin._Data0),_PValueType_Iterator(ItEnd._Data0),TestBinaryFunction);
    exit;
  end;

  Right:=ItBegin.Distance(ItEnd)-1;
  if Right>0 then
    __DGL_QuickSort(ItBegin,Right,TestBinaryFunction);
end;

{$ifdef  _DGL_Algorithms_Object_Function}
class function _TAlgorithms.IsSorted(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject):boolean;
{$else}
class function _TAlgorithms.IsSorted(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction):boolean;
{$endif}
var
  It :  {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
  Itp :  {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
begin
  if (ItBegin._ObjIteratorClass=_TVectorIterator) then
  begin
    result:=IsSorted(_PValueType_Iterator(ItBegin._Data0),_PValueType_Iterator(ItEnd._Data0),TestBinaryFunction);
    exit;
  end;

  if ItBegin.IsEqual(ItEnd) then
  begin
    result:=true;
    exit;
  end;

  It:=ItBegin;
  Itp:=ItBegin;
  Itp.Next();
  while (not ItP.IsEqual(ItEnd)) do
  begin
    if TestBinaryFunction(ItP.Value,It.Value) then
    begin
      result:=false;
      exit;
    end;
    It.Next();
    Itp.Next();
  end;
  result:=true;
end;


{$ifdef  _DGL_Algorithms_Object_Function}
class function _TAlgorithms.BinarySearch(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const Value:_ValueType;const TestBinaryFunction:TTestBinaryFunctionOfObject): {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
{$else}
class function _TAlgorithms.BinarySearch(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const Value:_ValueType;const TestBinaryFunction:TTestBinaryFunction): {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
{$endif}
begin
  result:=LowerBound(ItBegin,ItEnd,Value,TestBinaryFunction);
  if not result.IsEqual(ItEnd) then
  begin
    if TestBinaryFunction(result.Value,Value)
         or TestBinaryFunction(Value,result.Value) then
      result.Assign(ItEnd);
  end;
end;

{$ifdef  _DGL_Algorithms_Object_Function}
class function _TAlgorithms.LowerBound(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const Value:_ValueType;const TestBinaryFunction:TTestBinaryFunctionOfObject): {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
{$else}
class function _TAlgorithms.LowerBound(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const Value:_ValueType;const TestBinaryFunction:TTestBinaryFunction): {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
{$endif}
var
  left,LowerBound : integer;
  m : integer;
  Count : integer;                       
begin
  {todo：if (ItBegin._ObjIteratorClass=_TVectorIterator) then
  begin
    result._ObjIteratorClass:=_TVectorIterator;
    _PValueType_Iterator(result._Data0):=
                LowerBound(_PValueType_Iterator(ItBegin._Data0),_PValueType_Iterator(ItEnd._Data0),Value,TestBinaryFunction);
    exit;
  end; }

  Count:=ItBegin.Distance(ItEnd);
  left:=-1;
  LowerBound:=Count;
  while (left+1<>LowerBound) do
  begin
    m:=(left+LowerBound) div 2;
    if TestBinaryFunction(ItBegin.GetNextValue(m),Value) then
      left:=m
    else
      LowerBound:=m;
  end;

  if (LowerBound>=Count)  then //or (LowerBound<0)
    result:=ItEnd
  else
  begin
    result:={$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif}(ItBegin.Clone(LowerBound));
  end;
end;


{$ifdef  _DGL_Algorithms_Object_Function}
class procedure _TAlgorithms.PushHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject);
{$else}
class procedure _TAlgorithms.PushHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction);
{$endif}
var
  ip,isub : integer;
begin
  isub:=ItBegin.Distance(ItEnd)-1;
  while true do
  begin
    if (isub<=0) then
      break;
    ip:=(isub-1) shr 1;//== div 2;
    if not TestBinaryFunction(ItBegin.NextValue[ip],ItBegin.NextValue[isub]) then
      break;
    SwapValue(ItBegin,isub,ItBegin,ip);
    isub:=ip;
  end;
end;


{$ifdef  _DGL_Algorithms_Object_Function}
class procedure _TAlgorithms.PopHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject);
{$else}
class procedure _TAlgorithms.PopHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction);
{$endif}
var
  ip,isub : integer;
  Count   : integer;
begin
  Count:=ItBegin.Distance(ItEnd);
  dec(Count);
  if Count<=0 then exit;
  SwapValue(ItBegin,0,ItBegin,Count);

  ip:=0;
  while true do
  begin
    isub:=ip*2+1;
    if (isub>=Count) then
      break;
    if (isub+1<Count) then
    begin
      if (TestBinaryFunction(ItBegin.NextValue[isub],ItBegin.NextValue[isub+1])) then
        inc(isub);
    end;
    
    if not TestBinaryFunction(ItBegin.NextValue[ip],ItBegin.NextValue[isub]) then
      break;
    SwapValue(ItBegin,isub,ItBegin,ip);
    ip:=isub;
  end;
end;

{$ifdef  _DGL_Algorithms_Object_Function}
class procedure _TAlgorithms.MakeHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject);
{$else}
class procedure _TAlgorithms.MakeHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction);
{$endif}
var
  It:  {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
begin
  if ItBegin.IsEqual(ItEnd) then exit;

  It:=ItBegin;
  while true do
  begin
    It.Next;
    PushHeap(ItBegin,It,TestBinaryFunction);
    if It.IsEqual(ItEnd) then exit;
  end;
end;

{$ifdef  _DGL_Algorithms_Object_Function}
class procedure _TAlgorithms.SortHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunctionOfObject);
{$else}
class procedure _TAlgorithms.SortHeap(const ItBegin,ItEnd: {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;const TestBinaryFunction:TTestBinaryFunction);
{$endif}
var
  It:  {$ifdef _DGL_VectorItType}_IVectorIterator{$else}_IIterator{$endif} ;
begin
  self.MakeHeap(ItBegin,ItEnd,TestBinaryFunction);
  It:=ItEnd;
  while (not It.IsEqual(ItBegin)) do
  begin
    PopHeap(ItBegin,It,TestBinaryFunction);
    It.Previous();
  end;
end;

//_Algorithms_Base_Private.inc_pas
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -