hamilton.pas

图论算法

   end;
  connectiveVertexs.free;
  if result= nil then NotconnectiveVertexs.free;
end;

function checkGraphConnexion(theVertexlist:Tlist;ConnexionNum:integer):boolean;
var i,j:integer;
    restVertexs:Tlist;
    NotconnectiveVertexs:Tlist;
    realConnexionNum:integer;
begin
  result := true;
  realConnexionNum:= 1;
  restVertexs := Tlist.create;
  for i := 0 to theVertexlist.count-1 do restVertexs.add(theVertexlist[i]);
  repeat
    NotconnectiveVertexs := CheckConnexion(restVertexs);
    restVertexs.free;
    restVertexs := NotconnectiveVertexs;
    if (restVertexs <> nil) then realConnexionNum := realConnexionNum + 1;
    if realConnexionNum > ConnexionNum then
       begin
         result := false;
         break;
       end;
  until restVertexs = nil;
  if restVertexs <> nil then restVertexs.free;
end;

function checkisolateVertex0(theVertexlist:Tlist):boolean;
var i:integer;
begin
  result := true;
  for i := 0 to theVertexlist.count - 1 do
    begin
      if Tvertex(theVertexlist[i]).Neighbourcount < 2 then
         begin
           result := false;
           exit;
         end;
    end;
end;

function checkisolateVertex1(theVertexlist:Tlist;deleteVertex:Tvertex):boolean;
var isolatenum:integer;
    isolateVertex:array[1..2] of Tvertex;
    i,j :integer;
    isolateVertexRoot:Tvertex;
    conflictnum:integer;
begin
  result := true;
  isolatenum := 0;
  for i := 0 to theVertexlist.count - 1 do
    begin
      if Tvertex(theVertexlist[i]).visibleNeighbourcount = 1 then
         begin
           inc(isolatenum);
           if isolatenum < 3 then isolateVertex[isolatenum] := Tvertex(theVertexlist[i]);
         end;
    end;
  if isolatenum >= 3 then result := false
  else
    begin
      for j := 1 to isolatenum do
        begin
          with isolateVertex[j] do
          for i := 1 to Neighbourcount do
            if (NV[i] <> deleteVertex) then
               isolateVertexRoot := NV[i];
          conflictnum := 0;
          with isolateVertexRoot do
          for i := 1 to Neighbourcount do
            if (NV[i] <> isolateVertex[j]) and (NV[i] <> deleteVertex) then
               begin
                 if NV[i].Neighbourcount <= 2 then
                    conflictnum := conflictnum + 1;
               end;
          if conflictnum >= 2 then
             begin
               result := false;
               break;
             end;
        end;
    end;
end;

function checkisolateVertex2(theVertexlist:Tlist;deleteVertex1,deleteVertex2:Tvertex):boolean;
var isolatenum:integer;
    isolateVertex:array[1..2] of Tvertex;
    i,j :integer;
    isconnective:boolean;
    isolateVertexRoot:Tvertex;
    conflictnum:integer;
begin
  result := true;
  isolatenum := 0;
  for i := 0 to theVertexlist.count - 1 do
    begin
      if Tvertex(theVertexlist[i]).visibleNeighbourcount = 1 then
         begin
           inc(isolatenum);
           if isolatenum < 3 then isolateVertex[isolatenum] := Tvertex(theVertexlist[i]);
         end;
    end;
  if isolatenum >= 3 then result := false
  else
    begin
      if isolatenum = 2 then
         begin
           isconnective := false;
           for i:= 1 to 2 do
             if deleteVertex1.isConsiderVisibleNV(isolateVertex[i]) then
                isconnective :=true;
           if not isconnective then
              begin
                result := false;
                exit;
              end;
           isconnective := false;
           for i:= 1 to 2 do
             if deleteVertex2.isConsiderVisibleNV(isolateVertex[i]) then
                isconnective :=true;
           if not isconnective then
              begin
                result := false;
                exit;
              end;
         end;
      for j := 1 to isolatenum do
        begin
          with isolateVertex[j] do
          for i := 1 to Neighbourcount do
            if (NV[i] <> deleteVertex1) and (NV[i] <> deleteVertex2) then
               isolateVertexRoot := NV[i];
          conflictnum := 0;
          with isolateVertexRoot do
          for i := 1 to Neighbourcount do
            if (NV[i] <> isolateVertex[j]) and
               (NV[i] <> deleteVertex1) and (NV[i] <> deleteVertex2) then
               begin
                 if NV[i].Neighbourcount <= 2 then
                    conflictnum := conflictnum + 1;
               end;
          if conflictnum >= 2 then
             begin
               result := false;
               break;
             end;
        end;
    end;
end;

function checkisolateVertex3(theVertexlist:Tlist;deleteVertex1,deleteVertex2:Tvertex):boolean;
var isolatenum:integer;
    i,j :integer;
    isolateVertexRoot:Tvertex;
    conflictnum:integer;
begin
  result := true;
  isolatenum := 0;
  for i := 0 to theVertexlist.count - 1 do
    begin
      if Tvertex(theVertexlist[i]).visibleNeighbourcount = 1 then
         begin
           inc(isolatenum);
         end;
    end;
  if isolatenum >= 5 then result := false;
end;

function checkHamiltonian:boolean;
var i,j,k:integer;
    deleteVertex:Tvertex;
    deleteVertexI,deleteVertexJ:Tvertex;
    checkVertexList:Tlist;
    splitVertexlist1,splitVertexlist2:Tlist;
begin
  result := true;
  checkVertexList := Tlist.create;
  if not checkGraphConnexion(vertexlist,1) then result := false
  else if not checkisolateVertex0(vertexlist) then result := false
  else
   begin
    for i := 0 to vertexlist.count - 1 do
      begin
        deleteVertex := Tvertex(vertexlist[i]);
        deleteVertex.considervisible := false;
        checkVertexList.clear;
        for j := 0 to vertexlist.count - 1 do
          if vertexlist[j] <> deleteVertex then
             checkVertexList.add(vertexlist[j]);
        if not checkGraphConnexion(checkVertexList,1) then
           begin
             result := false;
             deleteVertex.considervisible := true;
             checkVertexList.free;
             exit;
           end;
        if not checkisolateVertex1(checkVertexList,deleteVertex) then
           begin
             result := false;
             deleteVertex.considervisible := true;
             checkVertexList.free;
             exit;
           end;
        deleteVertex.considervisible := true;
      end;

    for i := 0 to vertexlist.count - 2 do
      begin
        //except
        application.processmessages;
        if not isruning then break;

        deleteVertexI := Tvertex(vertexlist[i]);
        deleteVertexI.considervisible := false;
        for j := i + 1 to vertexlist.count - 1 do
          begin
            deleteVertexJ := Tvertex(vertexlist[j]);
            deleteVertexJ.considervisible := false;
            checkVertexList.clear;
            for k := 0 to vertexlist.count - 1 do
              if (vertexlist[k] <> deleteVertexI) and (vertexlist[k] <> deleteVertexJ) then
                 checkVertexList.add(vertexlist[k]);
            if not checkGraphConnexion(checkVertexList,2) then
               begin
                 result := false;
                 deleteVertexI.considervisible := true;
                 deleteVertexJ.considervisible := true;
                 checkVertexList.free;
                 exit;
               end
            else
               begin
                 splitVertexlist1 := CheckConnexion(checkVertexList);
                 if splitVertexlist1 = nil then
                    begin
                      if not checkisolateVertex3(checkVertexList,deleteVertexI,deleteVertexJ) then
                         begin
                           result := false;
                           deleteVertexI.considervisible := true;
                           deleteVertexJ.considervisible := true;
                           checkVertexList.free;
                           exit;
                         end;
                    end
                 else
                    begin
                      splitVertexlist2 := Tlist.create;
                      for k := 0 to checkVertexList.count - 1 do
                        if splitVertexlist1.indexof(checkVertexList[k]) = -1 then
                           splitVertexlist2.add(checkVertexList[k]);
                      if not checkisolateVertex2(splitVertexlist1,deleteVertexI,deleteVertexJ) then
                         begin
                           result := false;
                           deleteVertexI.considervisible := true;
                           deleteVertexJ.considervisible := true;
                           splitVertexlist1.free;
                           splitVertexlist2.free;
                           checkVertexList.free;
                           exit;
                         end;
                      if not checkisolateVertex2(splitVertexlist2,deleteVertexI,deleteVertexJ) then
                         begin
                           result := false;
                           deleteVertexI.considervisible := true;
                           deleteVertexJ.considervisible := true;
                           splitVertexlist1.free;
                           splitVertexlist2.free;
                           checkVertexList.free;
                           exit;
                         end;
                      splitVertexlist1.free;
                      splitVertexlist2.free;
                    end;
               end;
            deleteVertexJ.considervisible := true;
          end;
        deleteVertexI.considervisible := true;
      end;
   end;
  checkVertexList.free;

end;

function satureDeleteVertex(theDeleteVertex:Tvertex):boolean;
var i:integer;
begin
  if theDeleteVertex.ConnectiveDegree = 2 then result := true
  else result := false;
end;
function isConnective(vertex1,vertex2:Tvertex):boolean;
var publicEdge:Tedge;
begin
  result := false;
  if vertex1.isConsiderVisibleNV(vertex2) then
     begin
       if vertex1.isVirtual or vertex2.isVirtual then result := true
       else if (not vertex1.isDelete) and (not vertex2.isDelete) then result := true
       else if vertex1.isDelete  and (not vertex2.isDelete) then
         begin
           if satureDeleteVertex(vertex1) then
              begin
                publicEdge := vertex1.getConsiderVisibleNE(vertex2);
                if publicEdge <> nil then publicEdge.ConsiderVisible := false;
                exit;
              end;
           result := true;
         end
       else if vertex2.isDelete and (not vertex1.isDelete) then
         begin
           if satureDeleteVertex(vertex2) then
              begin
                publicEdge := vertex1.getConsiderVisibleNE(vertex2);
                if publicEdge <> nil then publicEdge.ConsiderVisible := false;
                exit;
              end;
           result := true;
         end
       else if vertex1.isDelete and vertex2.isDelete then
         begin
           if satureDeleteVertex(vertex1) then
              begin
                publicEdge := vertex1.getConsiderVisibleNE(vertex2);
                if publicEdge <> nil then publicEdge.ConsiderVisible := false;
                exit;
              end;
           if satureDeleteVertex(vertex2) then
              begin
                publicEdge := vertex1.getConsiderVisibleNE(vertex2);
                if publicEdge <> nil then publicEdge.ConsiderVisible := false;
                exit;
              end;
           result := true;
         end;
     end;
end;

function SubgraphConnexion(theVertexlist:Tlist):boolean;
var i,j:integer;
    connectiveVertexs:Tlist;
    NotconnectiveVertexs:Tlist;
    checkVertex:Tvertex;
    isExist:boolean;
    connectiveVertexNum:integer;
begin
  result := true;
  if theVertexlist.count <= 1 then exit;
  connectiveVertexs := Tlist.create;
  NotconnectiveVertexs := Tlist.create;
  connectiveVertexs.add(theVertexlist.first);
  i := 1;
  repeat
    checkVertex := Tvertex(theVertexlist[i]);
    isExist := false;
    for j := 0 to connectiveVertexs.count - 1 do
      begin
        if isConnective(Tvertex(connectiveVertexs[j]),checkVertex) then
           begin
             isExist := true;
             connectiveVertexs.add(checkVertex);
             break;
           end;
      end;
    if not isExist then
      begin
        NotconnectiveVertexs.add(checkVertex);
      end;
    inc(i);
  until i >= theVertexlist.count;
  if NotconnectiveVertexs.count > 0 then
  begin
   if connectiveVertexs.count = 1 then result := false
   else
     begin
      repeat
        connectiveVertexNum := connectiveVertexs.count;
        i := 0 ;
        repeat
          checkVertex := Tvertex(NotconnectiveVertexs[i]);
          isExist := false;
          for j := 0 to connectiveVertexs.count - 1 do
            begin
              if isConnective(Tvertex(connectiveVertexs[j]),checkVertex)  then
                begin
                  isExist := true;
                  connectiveVertexs.add(checkVertex);
                  NotconnectiveVertexs[i] := nil;
                  break;
                end;
            end;
          inc(i);
        until i >= NotconnectiveVertexs.count;
        NotconnectiveVertexs.pack;
      until (connectiveVertexNum = connectiveVertexs.count)
            or (NotconnectiveVertexs.count = 0 );
      if NotconnectiveVertexs.count > 0 then result := false;
     end;
  end;
  connectiveVertexs.free;
  NotconnectiveVertexs.free;
end;

function getsubgraph(thevertexlist:Tlist;var vertexlist1,vertexlist2:Tlist):integer;//1:one subgraph 2: two subgraph 3: > two subgraph
var i,j:integer;
    connectiveVertexs:Tlist;
    NotconnectiveVertexs:Tlist;
    checkVertex:Tvertex;
    isExist:boolean;
    connectiveVertexNum:integer;
begin
  result := 1;
  vertexlist1 := nil;
  vertexlist2 := nil;
  if thevertexlist.count <= 1 then exit;

  for i := 0 to thevertexlist.count - 1 do
    with Tvertex(thevertexlist[i]) do
    if isDelete then
       begin
         ConnectiveDegree := 0;
         for j := 1 to Neighbourcount do
         if NV[j].isVirtual and (thevertexlist.indexof(NV[j])> -1) then
            inc(ConnectiveDegree);
       end;

  connectiveVertexs := Tlist.create;
  NotconnectiveVertexs := Tlist.create;
  connectiveVertexs.add(theVertexlist.first);

  i := 1;
  repeat
    checkVertex := Tvertex(theVertexlist[i]);
    isExist := false;
    for j := 0 to connectiveVertexs.count - 1 do
      begin
        if isConnective(Tvertex(connectiveVertexs[j]),checkVertex) then
           begin
             isExist := true;
             connectiveVertexs.add(checkVertex);
             break;
           end;
      end;
    if not isExist then
      begin
        NotconnectiveVertexs.add(checkVertex);
      end;
    inc(i);
  until i >= theVertexlist.count;
  if NotconnectiveVertexs.count > 0 then
  begin
   if connectiveVertexs.count > 1 then
     begin
      repeat
        connectiveVertexNum := connectiveVertexs.count;
        i := 0 ;