
//////////////////////////////////////////////////////////////
// GenHamPathStrip_2
//////////////////////////////////////////////////////////////

function TGraph.GenHamPathStrip_2(aStart, aFin, aStrip: TNode;
  var aCost: integer): TBuffer;
//      :
// mDist    --  
// mPower   --      
// mColor   --  
// mRoot    --  
// mFlow    --     

var    Que : TSet;    //     
      Tree : TSet;    //     
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //    mDist ( )

  procedure ClearFines;
  var Node: TNode;      //  
  begin
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Node.mDist:= 0;    // 
      Node.mRoot:= nil;  //  
      Node:= NodeNext;
    end;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //     ,    
  // (      )
  // mColor = CWhite   --  
  // mPower = 0        --    

  procedure ResetNodesAndLinks;
  var Node : TNode;
      Link : TLink;
  begin
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Node.mColor:= CWhite; // 
      Node.mPower:= 0;      //     
      //   
      Link:= Node.OutLinkFirst;
      while Assigned(Link) do begin
        Link.mColor:= CWhite;
        Link:= Node.OutLinkNext;
      end;
      Node:= NodeNext;
    end;
    //    :
    if Assigned(aStrip) then aStrip.mColor:= CRed;
  end;

  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //      
  //         Buf

  function GenCover: boolean;

  var Node : TNode;     //  
      Link : TLink;     //    
        HL : THamLink;  //    
    // - - - - - - - - - - - - - - - - - - - - - - - - - - -
    //    Que     .
    //  HL     

    procedure AddTreeLinks(aNode: TNode);
    var  Link : TLink;
           HL : THamLink;
    begin
      //   
      Link:= aNode.OutLinkFirst;
      while Assigned(Link) do begin
        //   ,    
        if (Link.mDest.mColor = CWhite) then begin
          //   :
          HL:= THamLink.Create(Link);
          // :
          if not Que.Insert(HL) then HL.Free;
        end;
        Link:= aNode.OutLinkNext;
      end;
    end;
    // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  var N : integer;  //   

  begin  { GenCover }
    Result:= true;
    //  :
    Tree.ClrAndDestroy;   //  
    ResetNodesAndLinks;   //   : mColor = CWhite
    Node:= NodeFirst;     //  
    Node.mColor:= CBlack; //     
    //      
    // (    )
    N:= mNodes.GetCount-1;
    if Assigned(aStrip) then Dec(N); //   
    while Assigned(Node) and (Tree.GetCount < N) do  begin
      //    Que     :
      AddTreeLinks(Node);
      //   Que     
      Node:= nil;                     //     
      HL:= Que.GetFirst as THamLink;  //   -- 
      while Assigned(HL) do begin
        Que.Delete(HL);               //    
        //      ,   
        with HL.mLink do if mDest.mColor = CWhite
            then Node:= mDest;   //  
        if Assigned(Node) then begin
          //     :
          Node.mColor:= CBlack;     //     
          Tree.Insert(HL);          //    
          HL.mLink.mColor:= CBlack; //     
          //     :
          Link:= HL.mLink.GetReverse;
          if Assigned(Link) then Link.mColor:= CBlack;
          Break; // while
        end else begin
          //       ,  
          HL.Free;
          HL:= Que.GetNext as THamLink; //   
        end;
      end; // while
    end; // while
    //    ,    
    if Tree.GetCount < N then begin
      Tree.ClrAndDestroy;
      Result:= false;
    end; // if
    Que.ClrAndDestroy;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //    ,     TNode.mPower
  //      

  function CalcPowerNodes: integer;
  var HL : THamLink;   //    Tree
      Node: TNode;
  begin
    //    mPower
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Node.mPower:= 0;  //     
      Node:= NodeNext;
    end;
    //     Tree:
    HL:= Tree.GetFirst as THamLink;
    while Assigned(HL) do begin
      //     :
      Inc(HL.mLink.mOwner.mPower);    //   
      Inc(HL.mLink.mDest.mPower);     //   
      HL:= Tree.GetNext as THamLink;
    end;
    //      1-  2
    Result:=-2;
    Node:= NodeFirst;
    while Assigned(Node) do begin
      if Node.mPower=1 then Inc(Result);
      Node:= NodeNext;
    end;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -

  //  
  procedure FinesExpo;
  var Node: TNode;
  begin
    Node:= NodeFirst;
    Writeln;
    Writeln('Name Power Delta  Fine');
    while Assigned(Node) do begin
      if (Node<>aStart) and (Node<>aFin) then
        with Node do Writeln(GetName, mPower:7, mFlow:6, mDist:6);
      Node:= NodeNext;
    end;
    Writeln;
  end;

  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //      (  mRoot)
  //       
  //         1

  procedure Mark(aNode: TNode);
  var   Link : TLink;
        Node : TNode;
      Marked : TBuffer;  //  
  begin
    Marked:= TBuffer.Create;  //  
    Marked.Put(aNode);        //     
    Inc(aNode.mColor);        //    
    //    :
    while Marked.GetCount > 0 do begin
      Node:= Marked.Get as TNode;   //   
      Node.mRoot:= aNode;           //      mRoot
      Link:= Node.OutLinkFirst;
      //     ,   :
      while Assigned(Link) do begin
        //   
        if (Link.mColor = CBlack) and
           //      
           (Node.mColor <> Link.mDest.mColor) then begin
          //   :
          Marked.Put(Link.mDest);   //  
          Inc(Link.mDest.mColor);   //    
        end;
        Link:= Node.OutLinkNext;
      end;
    end;
    Marked.Free;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //   ,     aLink
  //   CalcNodeFine

  function CalcLinkFine(aLink: TLink; var aStatus: boolean): integer;
  var Link : TLink;
      Node : TNode;
      Fine : integer;
  begin
    Result:= MaxInt;  aStatus:= false;
    //       ,   :
    //   - ,  - ,  - 
    //     (  mRoot)
    Mark(aLink.mOwner);  //  mOwner
    Mark(aLink.mDest);   //  mDest
    //    ,   
    Node:= NodeFirst;
    while Assigned(Node) do begin
      //     (  ):
      if Node <> aStrip then Node.mColor:= CBlack;
      //     mOwner    
      if (Node.mRoot = aLink.mOwner) and (Node <> aLink.mOwner) then begin
        //   ,   
        Link:= Node.OutLinkFirst;
        while Assigned(Link) do begin
          //      ,
          //        :
          // Link.mDest.mRoot --  
          // aLink.mDest --   
          if Link.mDest.mRoot = aLink.mDest then begin
            Fine:= CalcValue(Link);
            if Result > Fine then begin
              Result:= Fine;  //  
              aStatus:= true; //   
            end;
          end;
          Link:= Node.OutLinkNext;
        end;
      end;
      Node:= NodeNext;
    end;
    //   ( )
    //   
    if aStatus then Result:= Result - CalcValue(aLink);
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //       
  //   CalcFines

  function CalcNodeFine(aNode: TNode; var aStatus: boolean): integer;
  var Link, Reverse: TLink;
      Fine: integer;
      OK: boolean;
  begin
    Result:= MaxInt;  aStatus:= false;
    //  ""  ,    
    // ( )
    //     ,
    //    
    Link:= aNode.OutLinkFirst;
    while Assigned(Link) and (Result > 0) do begin
      if Link.mColor = CBlack then begin
        //    
        //      ( )
        Link.mColor:= CGray;
        Reverse:= Link.GetReverse;
        if Assigned(Reverse) then Reverse.mColor:= CGray;
        //  
        aNode.OutPosPush;
        Fine:= CalcLinkFine(Link, OK);
        aNode.OutPosPop;
        //       
        Link.mColor:= CBlack;
        if Assigned(Reverse) then Reverse.mColor:= CBlack;
        //    
        if OK and (Result > Fine) then begin
          Result:= Fine;
          aStatus:= true;
        end;
      end;
      Link:= aNode.OutLinkNext;
    end;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //     

  procedure CalcFines;
  var Node: TNode;
      Fine: integer;
      OK: boolean;
  begin
    //  ,    2,
    //        mFlow
    // Node.mPower --    
    // Node.mFlow --     
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Node.mFlow:= 0;  // mFlow --  
      if Node.mPower > 2 then begin
        //   ,   
        PosPush; //    
        Fine:= CalcNodeFine(Node, OK);
        PosPop;  //    
        if OK then begin
          if Fine = 0 then Fine:=1;  //    
          Node.mFlow:= Fine;         // mFlow --  
        end;
      end; // if
      Node:= NodeNext;
    end; // while
    //    mDist:= mDist + Node.mFlow
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Inc(Node.mDist, Node.mFlow);
      Node:= NodeNext;
    end;
  end;

  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //  ,   
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  function FindBestPath(aRes: TSet): integer;
  var
    Level: integer;   //  
       NL: integer;   //  ,   
    Cost: integer;
    BestCost: integer;
       Buf: TSet;
Cnt: integer;    //   

    // - - - - - - - - - - - - - - - - - - - - - - - - - - -

    //     Que -  () 
    //    

    procedure AddLinks(aNode: TNode);
    var  L : TLink;
        TL : THamLink;
    begin
      with aNode do begin
        //   
        L:= OutLinkFirst;
        while Assigned(L) do begin
          TL:= THamLink.Create(L);
          if not Que.Insert(TL)
            then TL.Free;
          L:= OutLinkNext;
        end;
      end;
    end;

    procedure Local_Init;
    var Node: TNode;   //  
    begin
      Node:= NodeFirst;
      while Assigned(Node) do begin
        with Node do begin
          mColor:=0;
          mPower:=0;
          mPred:=nil;
          mRoot:= Node;     //  
          AddLinks(Node);  //   
        end;
        Node:= NodeNext;
      end;
    end;
    // - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    //   
    // aTL.mLink.mOwner --   T1
    // aTL.mLink.mDest  --   T2
    procedure Union(aTL: THamLink);
    var   N2: TNode;   //   T2
          p2: TNode;   //  
          tmp: TNode;  //  
    begin
      with aTL.mLink do begin
        Inc(Cost, mValue);
        Inc(mOwner.mPower);
        Inc(mDest.mPower);
        //      mPred
        N2:= mDest;        //     T2
        p2:= N2.mPred;     //    T2
        N2.mPred:=mOwner;  //     T1
        //   :
        while Assigned(p2) do begin
          tmp:= p2.mPred;  //     T2
          p2.mPred:= N2;   //   
          N2:= p2;         //      2- 
          p2:= tmp;        //    T2
        end;
        //  2-   1-:
        // root1 = mOwner.mRoot.Expo
        // root2 = mDest.mRoot.Expo
        p2:= mDest.mRoot;
        N2:= NodeFirst;
        while Assigned(N2) do begin
          if N2.mRoot = p2 then N2.mRoot:= mOwner.mRoot;
          N2:= NodeNext;
        end;
      end;  // with
    end;
    // - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    //     
    procedure Remove(aTL: THamLink);
    var Root: TNode;  //    2- 
        S1 : TSet;    //   
        S2 : TSet;    //   
        Node: TNode;
    begin
      with aTL.mLink do begin
        Dec(Cost, mValue);
        Dec(mOwner.mPower);
        Dec(mDest.mPower);
      end;
      S1:= CreateSet;    S2:= CreateSet;
      //     2- 
      with aTL.mLink do if mOwner.mPred = mDest
        then Root:= mOwner    //  
        else Root:= mDest;    //  
      Root.mRoot:= Root;      //    
      Root.mPred:= nil;       //     
      S1.Insert(Root);        //      
      repeat
        //   :
        Node:= NodeFirst;
        while Assigned(Node) do begin
          //     ,    
          if S1.Exist(Node.mPred) then begin
            Node.mRoot:= Root;
            S2.Insert(Node);
          end;
          Node:= NodeNext;
        end;
        // ,    
        if S2.GetCount=0 then Break;
        //        
        S1.CopyItems(S2);
        S2.Clear;
      until false;
      S1.Free; S2.Free;
    end;
    // - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    function Check(aLink: THamLink): boolean;
    begin
      //       ,
      //     ,  
      with aLink.mLink do begin
        Result:= (mOwner.mRoot <> mDest.mRoot) and
                 (mOwner.mPower < 2) and (mDest.mPower < 2) and
                 (Cost+mValue < BestCost);
        if not Result then Exit;
        if (mOwner=aStart) or (mOwner=aFin)
          then Result:= mOwner.mPower=0;
        if not Result then Exit;
        if (mDest=aStart) or (mDest=aFin)
          then Result:= mDest.mPower=0;
      end;
    end;
    // - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    //    
    // ()  L  N-1 
    // L -      = Links.GetCount
    // N -    = mNodes.GetCount

    var Start : TDateTime; Time: integer;

    procedure Searching(aIndex: integer {   } );
    var  i: integer;
        TL: THamLink;  //    
    begin
      //   
      for i:= aIndex to NL do begin
        TL:= Que.GetItem(i + Level) as THamLink;  //  
        //       ,
        //     ,  
        if Check(TL) then begin
//TL.Expo;
          //     ,   
          Union(TL);
          Buf.Insert(TL);
          if Buf.GetCount = mNodes.GetCount-1 then begin
            //   
Inc(Cnt);    //   
Writeln(Cnt:4,'  Cost= ', Cost);

            //    ,  
            aRes.CopyItems(Buf);
            BestCost:= Cost;
//aRes.Expo;
          end else begin
            Time:= MilliSecondsBetween(Start, Now);
            if (Time > 1000) and (BestCost<MaxInt) then Exit;
            
            //     ,   ,
            //    
            Inc(Level);    // Level+1
            Searching(i);  //    
            Dec(Level);    // Level-1
          end; // else
          //    
          Buf.Delete(TL);  //    
          Remove(TL);      //   
        end; // with
      end; // for
    end;
    // - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  begin
    Start:= Now;
    Cost:= 0;
    BestCost:= MaxInt;
    Buf:= CreateSet;
    Que.ClrAndDestroy;
    Local_Init;
//Que.Expo;
Cnt:= 0;     //   
    Level:=0;    //  
    //  ,    :
    // (mNodes.GetCount - 1) =   
    NL:= Que.GetCount + 1 - (mNodes.GetCount - 1);
    Searching(1);
    Buf.Free;
    Result:= BestCost;
  end;

  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //   :
  //      Start  Fin

//  function ConvertLinksToNodes(var aCost: integer): TBuffer;
  function ConvertLinksToNodes: TBuffer;

    //    Tree   aNode 

    function FindNext(aNode: TNode): TNode;
    var HL: THamLink;
        i: integer;
    begin
      Result:= nil;
      HL:= Tree.GetFirst as THamLink;
      while Assigned(HL) do begin
        //   ,   
        with HL.mLink do begin
          if aNode = mOwner then begin
            Result:= mDest;  Tree.Delete(HL);
            Break;
          end;
          if aNode = mDest then begin
            Result:= mOwner;  Tree.Delete(HL);
            Break;
          end;
        end;
        HL:= Tree.GetNext as THamLink;
      end;
    end;

  var  Node: TNode;

  begin { ConvertLinksToNodes }

    Result:= TBuffer.Create;
    //     aStart
    Node:= aStart;
    repeat
      Result.Put(Node);       //   
      Node:= FindNext(Node);  //   
    until Node = aFin;
    //    aFin
    Result.Put(Node);
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //    mDist   mLimit
  procedure  FinesSave;
  var Node: TNode;
  begin
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Node.mLimit:= Node.mDist;
      Node:= NodeNext;
    end;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -
  //    mDist   mLimit
  procedure  FinesRestore;
  var Node: TNode;
  begin
    Node:= NodeFirst;
    while Assigned(Node) do begin
      Node.mDist:= Node.mLimit;
      Node:= NodeNext;
    end;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - -

var
    Delta : integer;    // ,    
    MinDelta : integer; //   
    OK : boolean;       //   
    Limit: integer;     //    
Cnt : integer;      //  

begin  { TGraph.GenHamPath }

Cnt:=0; //  

  aCost:= -1;

  //      :
  Result:= TBuffer.Create;
  //   ,  :
  if mDirect then Exit;

  // :
  Que:= CreateSet;      //    
  Tree:= CreateSet;     //    

  //    mFines:
  ClearFines;

  //    (mDist)   :
  aStart.mDist:= MaxInt div 4;
  aFin.mDist:= aStart.mDist;

  Limit:= mNodes.GetCount; //    
  MinDelta:= MaxInt;       //  

//OK:= GenCover;
//FinesSave;                //   

  // ,   > 0     
  repeat
    //       
    OK:= GenCover;
    if not OK then Break;
    //   Delta   
    Delta:= CalcPowerNodes;
    //   
    //      --  mPower
    CalcFines;
//Inc(Cnt);  Writeln(Cnt:5, '  Delta= ',Delta:2);
//if Delta < MinDelta then FinesExpo;

    //   Delta  ,   
    // if Delta <= MinDelta  then Force;

    //   
    if Delta < MinDelta then begin
      MinDelta:= Delta;         //  
      FinesSave;                //   
      Limit:= mNodes.GetCount;  //    
    end else begin
      Dec(Limit);  //    ,   
    end;
  until (Delta = 0) or (Limit = 0);

  if OK then begin
    //   :
//    FinesRestore;
    //         
    aCost:= FindBestPath(Tree);
    //     :
    //  -->    Start ...  Fin
    Result:= ConvertLinksToNodes;
  end;

  //  :
  Tree.Free;
  Que.ClrAndDestroy;
  Que.Free;
end;
