Blokk-szívósság

Boros Benedek

<<Combinatorica`
SetDirectory[NotebookDirectory[]];

A szívósságot vizsgáló függvény:
(paraméter: egy gráf)

Toughness[G_]:=(
subsetlist=Delete[Subsets[VertexList[G]],{{1},{-1}}];
subsetsizelist=Map[Length,subsetlist];
componentsizelist=Map[Length,Map[System`ConnectedComponents,VertexDelete[G,#]&/@subsetlist]];
positionlist=Position[componentsizelist,1];
Min[(Delete[subsetsizelist,positionlist])/(Delete[componentsizelist,positionlist])]
)

Külső állományból beolvasott gráfok szívósságának maximumát, és a maximumot adó gráfok sorszámát megállapító függvény: (paraméterek: egy graph6 formátumú (.g6 kiterjesztésű) file, valamint az első és az utolsó vizsgálandó gráf sorszáma)

ToughMax[graphs_,imin_,imax_]:=(
i=imin; max=0; maxlist={};
Do[
G=AdjacencyGraph[Import[graphs,{"AdjacencyMatrix",i}]];
t=Toughness[G];
If[max==t,maxlist=Append[maxlist,i]];
If[max<t,max=t;maxlist={i}];
i++,{imax-imin+1}
]
Print["max = ",max,", maxlist = ",maxlist];
)

A ToughMax futtatása 3 - 9 pontú gráfokra:

ToughMax["graphs/graph3c.g6",1,2-1]//AbsoluteTiming

ToughMax["graphs/graph4c.g6",1,6-1]//AbsoluteTiming

ToughMax["graphs/graph5c.g6",1,21-1]//AbsoluteTiming

ToughMax["graphs/graph6c.g6",1,112-1]//AbsoluteTiming

ToughMax["graphs/graph7c.g6",1,853-1]//AbsoluteTiming

ToughMax["graphs/graph8c.g6",1,11117-1]//AbsoluteTiming

ToughMax["graphs/graph9c.g6",1,261080-1]//AbsoluteTiming

A pontpárra vonatkozó blokk-szívósságot vizsgáló függvény:
(paraméterek: egy gráf és egy pontpár)

BlockToughness[G_,{u_,v_}]:=(
subsetlist=Delete[Subsets[VertexList[G]],{{1},{-1}}];
subsetsizelist=Map[Length,subsetlist];
componentlist=Map[System`ConnectedComponents,VertexDelete[G,#]&/@subsetlist];
componentlist=Map[Select[#,FreeQ[#,u]&]&,componentlist];
componentlist=Map[Select[#,FreeQ[#,v]&]&,componentlist];
componentsizelist=Map[Length,componentlist];
positionlist=Position[componentsizelist,0];
Min[(Delete[subsetsizelist,positionlist])/(Delete[componentsizelist,positionlist])]
)

A blokk-szívósságot vizsgáló függvény:
(paraméter: egy szomszédossági mátrix)

BlockToughness[am_]:=(
G=FromAdjacencyMatrix[am];n=V[G];
pairlist=Subsets[Range[n],{2}];
pairlist=Select[pairlist,False==HamiltonianQ[AddEdges[AddVertex[G],{{#[[1]],n+1},{#[[2]],n+1}}]]&];
G=AdjacencyGraph[am];
Max[Map[BlockToughness[G,#]&,pairlist]]
)

Külső állományból beolvasott gráfok blokk-szívósságának maximumát, és a maximumot adó gráfok sorszámát megállapító függvény: (paraméterek: egy graph6 formátumú (.g6 kiterjesztésű) file, valamint az első és az utolsó vizsgálandó gráf sorszáma)

BlockMax[graphs_,imin_,imax_]:=(
i=imin; max=0; maxlist={};
Do[
am=Import[graphs,{"AdjacencyMatrix",i}];
b=BlockToughness[am];
If[max==b,maxlist=Append[maxlist,i]];
If[max<b,max=b;maxlist={i}];
i++,{imax-imin+1}
]
Print["max = ",max,", maxlist = ",maxlist];
)

A BlockMax futtatása 3 - 8 pontú gráfokra:

BlockMax["graphs/graph3c.g6",1,2]//AbsoluteTiming

BlockMax["graphs/graph4c.g6",1,6]//AbsoluteTiming

BlockMax["graphs/graph5c.g6",1,21]//AbsoluteTiming

BlockMax["graphs/graph6c.g6",1,112]//AbsoluteTiming

BlockMax["graphs/graph7c.g6",1,853]//AbsoluteTiming

BlockMax["graphs/graph8c.g6",1,11117]//AbsoluteTiming

A 2-blokk-szívós 8 pontú gráfok:

{AdjacencyGraph[Import["graphs/graph8c.g6",{"AdjacencyMatrix",2564}]],
AdjacencyGraph[Import["graphs/graph8c.g6",{"AdjacencyMatrix",8114}]]}

A BlockMax futtatása 9 pontú gráfokra:
(a program módosult: a blokk-szívósság maximuma 2-re lett átállítva, és futás közben 1000 gráfonként írja ki az eredményt)

BlockMax[graphs_,imin_,imax_]:=(
i=imin; max=2; maxlist={};
Do[
b=BlockToughness[Import[graphs,{"AdjacencyMatrix",i}]];
If[max==b,maxlist=Append[maxlist,i]];
If[max<b,max=b;maxlist={i}];
If[Mod[i,1000]==0,Print["i = ",i,", TimeUsed = ",TimeUsed[],", max = ",max,", maxlist = ",maxlist];maxlist={}];
i++,{imax-imin+1}
]
)

BlockMax["graphs/graph9c.g6",1,261080]

BlockMax["graphs/graph9c.g6",13001,261080]

BlockMax["graphs/graph9c.g6",25001,261080]

BlockMax["graphs/graph9c.g6",30001,261080]

BlockMax["graphs/graph9c.g6",35001,261080]

BlockMax["graphs/graph9c.g6",42001,261080]

BlockMax["graphs/graph9c.g6",48001,261080]

BlockMax["graphs/graph9c.g6",60001,261080]

BlockMax["graphs/graph9c.g6",79001,261080]

BlockMax["graphs/graph9c.g6",114001,261080]

BlockMax["graphs/graph9c.g6",164001,261080]

BlockMax["graphs/graph9c.g6",256001,261080]

A 2-blokk-szívós 9 pontú gráfok:

{AdjacencyGraph[Import["graphs/graph9c.g6",{"AdjacencyMatrix",37098}]],
AdjacencyGraph[Import["graphs/graph9c.g6",{"AdjacencyMatrix",46199}]],
AdjacencyGraph[Import["graphs/graph9c.g6",{"AdjacencyMatrix",157888}]],
AdjacencyGraph[Import["graphs/graph9c.g6",{"AdjacencyMatrix",158182}]]}

A teljes futási idő 9 pontú gráfokra:

h=Plus[32835,47488,11651,15519,14909,15912,27438,63310,98201,115474,197827,11482]/3600//Round;
Print["Futási idő: ",h," óra."]