# GraphTheory Package: Version 1.26, August, 2006. # Authors: # MK Mahdad Khatirinejad : mahdad@cecm.sfu.ca # JF Jeff Farr : jfarr@cecm.sfu.ca # MBM Michael Monagan : mmonagan@cecm.sfu.ca # MJ Mahdi Javadi : sjavadi@cs.sfu.ca # SK Sara Khodadad : skhodada@cecm.sfu.ca # SL Simon Lo : sclo@cecm.sfu.ca # MG Mohammad Ghebleh : mghebleh@cecm.sfu.ca # AW Allan Wittkopf: wittkopf@cecm.sfu.ca # RP Roman Pearce: rpearcea@cecms.fu.ca # # In the code below, the procedure Graph(...) is the main # constructor for constructing a graph, directed or undirected, # weighted or unweighted. # # MBM: I've put CycleGraph, PathGraph, CompleteGraph in the main package # All other special graphs, including PetersenGraph and OctahedronGraph # are in the SpecialGraphs module. # getdir := proc(G) option inline; op(1,G); end proc: getwt := proc(G) option inline; op(2,G); end proc: vlist := proc(G) option inline; op(3,G); end proc: listn := proc(G) option inline; op(4,G); end proc: ginfo := proc(G) option inline; op(5,G); end proc: eweight := proc(G) option inline; op(6,G); end proc: getops := proc(G) option inline; op(1..6,G); end proc: seqint := proc(v) option inline; $1..v; end proc: makeweights := proc(G,E) option inline; subsop(6=E,2=weighted,G) end: makevertices := proc(G,V) option inline; subsop(3=V,G) end: proc() macro( VERTEXTYPE = {integer, symbol, string, indexed} ) end(): proc() macro( UNDTYPE = set(VERTEXTYPE) ) end(): proc() macro( ARCTYPE = [VERTEXTYPE,VERTEXTYPE] ) end(): proc() macro( EDGETYPE = {ARCTYPE, UNDTYPE, [ARCTYPE,numeric], [UNDTYPE,numeric]} ): end(): macro( INPLACETYPE = {identical(inplace),identical(inplace)=truefalse} ): #macro( GT_DRAW_STYLES_EQUIV = [VP_FIXED="draw-pos-fixed", VP_CIRCLE="draw-pos-circular", VP_TREE="draw-pos-tree", VP_BIPARTITE="draw-pos-bipartite", VP_SPRING="draw-pos-spring", VP_USER="draw-pos-user", VP_DEFAULT="draw-pos-default"] ): macro( VP_FIXED="draw-pos-fixed", VP_CIRCLE="draw-pos-circular", VP_TREE="draw-pos-tree", VP_BIPARTITE="draw-pos-bipartite", VP_SPRING="draw-pos-spring", VP_USER="draw-pos-user", VP_DEFAULT="draw-pos-default" ): macro( GT_DRAW_ATTRIBS = ["draw-pos-fixed", "draw-pos-circular", "draw-pos-tree", "draw-pos-bipartite", "draw-pos-spring", "draw-pos-user", "draw-pos-default", "draw-edge-color", "draw-edge-thickness"] ): ####################### ## GLOBAL Procedures ## ####################### #`type/GRAPHLN` := proc (G) # type(G,function) and op(0,G)=GRAPHLN and # type([op(G)],[symbol,symbol,list,Array,symbol,{Matrix,table,integer}]); # end; `type/GRAPHLN` := GRAPHLN(symbol,symbol,list,Array,symbol,{Matrix,0}): # The structured type avoids a full evaluation of the vertex list of the graph which # occurs with the procedure type (in Maple 9,9.5,10) which matters for large graphs unprotect(GRAPHLN): GRAPHLN := proc() local c; c := 0; proc(D,W,V,A,t,EW) local T; if nargs<>6 or not type(t,table) then return 'GRAPHLN'(args) fi; if type(t,symbol) then return 'GRAPHLN'(args) fi; # MBM: In print/GRAPHLN, we need to recreate the graph object. # MBM: This is so we can attach the graph as an attribute to # MBM: the output of print/GRAPHLN which is a symbol so that the # MBM: Contect menu mechanism can get its hands on the graph. # MBM: But the inputs to print/GRAPHLN have been print processed. # MBM: To avoid print processing the table object, which can have # MBM: arbitrary information in it, I'm making the table into # MBM: a "named table" here so that print/GRAPHLN can access it. # MBM: I'm doing this here in GRAPHLN rather than in each routine # MBM: in the GraphTheory package. # MBM: It would be nice if T could be local, and I could do # MBM: T := t; return 'GRAPHLN'(D,W,V,A,T,EW); # MBM: but sign, the print preprocessing mechanism in the Standard # MBM: GUI replaces symbols with global names!! # MBM: So I need to use a unique global. T := GRAPH_TABLE_NAME(); assign(T,t); 'GRAPHLN'(D,W,V,A,T,EW); end : end(): protect(GRAPHLN): `print/GRAPHLN` := proc() local D, W, V, A, c, n, m, E, R, T, EW, ir, G, output, GUI; # What this code does depends on whether the GUI is the Standard # or Classic GUI. For the Classic GUI, we attach the Graph as # an attribute to the output symbol. We can't do this for the # Standard GUI because in Maple 10 the GUI will not display the # output symbol correctly - it sometimes displays ... which ruins # the context menus. GUI := interface(version); if substring(GUI,1..7) = '`Classic`' then GUI := 0; # classic GUI elif substring(GUI,1..8) = '`Standard`' then GUI := 1; # java GUI else GUI := 2; # Command line interface fi; D, W, V, A, T, EW := args[1..6]; # Now, the table object should be a named table. # If it's not, then we'll lose that info for the Classic GUI context menus. if type(args[5],symbol) then T := args[5] else T := table([]); fi; # Now, the objects D, W, V, A, T, EW have been print preprocessed # fprintf(foo,"A = %a\n",A); # fprintf(foo,"W = %a\n",EW); if op(0,A)=RTABLE then A := pointto(op(1,A)); fi; # A = RTABLE( , [....] ). if op(0,EW)=RTABLE then EW := pointto(op(1,EW)); fi; # get handle to edge-weight matrix G := GRAPHLN(D,W,V,A,T,EW); # reconstruct the graph c := `GRAPHLN/number`(G); # number the display of each graph uniquely n := nops(V); m := add( nops(A[i]), i=1..n ); if D = undirected then m := m/2 end if; if n > 1 and D=undirected then output := nprintf("Graph %d: an undirected %s graph with %d vertices and %a edge(s)",c, W, n, m) elif n > 1 and D=directed then output := nprintf("Graph %d: a directed %s graph with %d vertices and %a arc(s)", c, W, n, m) elif n = 1 then output := nprintf("Graph %d: a graph with 1 vertex and no edges", c) else output := nprintf("Graph %d: a graph with no vertex", c); fi; if GUI=0 then setattribute(output,'GRAPHLN'=G); fi; # attach the actual graph G to the output name output; end: `GRAPHLN/number` := proc(G) global `GRAPHLN/counter`; option remember; if not assigned(`GRAPHLN/counter`) then `GRAPHLN/counter` := 0; fi; `GRAPHLN/counter` := `GRAPHLN/counter`+1; end: ################################################################################# ##PACKAGE(help) GraphTheory ##AUTHOR M. Monagan ##DATE June 2006 ## ##CALLINGSEQ ##- GraphTheory['command'](arguments) ##- 'command'(arguments) ## ##DESCRIPTION ## ##- The `GraphTheory` package is a collection of routines for creating graphs, ## drawing graphs, manipulating graphs and testing graphs for properties. ## By graphs we mean sets of vertices (nodes) connected by edges. The ## package supports both directed and undirected graphs but not multigraphs. ## The edges in the graphs may be weighted or unweighted. ## ##- The main command for creating undirected graphs is the "Graph" command. ## The main command for creating directed graphs is the "Digraph" command. ## ##- To draw a graph use the "DrawGraph" command. The output is a Maple plot. ## ##- To test if a Maple object ~G~ is a graph use the test: ~type(G,GRAPHLN)~. ## ##- The "ImportGraph" and "ExportGraph" commands are for reading a graph from, ## and writing a graph to, a file in one of the supported data formats. ## ##- The following commands are essential for working with large graphs: ## "HasEdge", "HasArc", "AddEdge", "AddArc", "DeleteEdge", "DeleteArc". ## ##- The "SpecialGraphs" package contains a library of pre-defined graphs and ## the "RandomGraphs" package has routines for randomly generating graphs. ## ##- The "GraphTheory examples" worksheet has a guided tour of the package. ## ##SECTION The Internal Data Structure used for Representing a Graph. ## ##- The data structure for representing a graph is a Maple function of the form ## ## ~GRAPHLN( D, W, V::list, A::Array, T::table, M::{0,Matrix} )~ where ## ##-(lead=indent) 'D' = undirected implies the graph is undirected ##-(lead=indent) 'D' = directed implies the graph is directed ##-(lead=indent) 'W' = unweighted implies the graph is unweighted and 'M' is the integer 0 ##-(lead=indent) 'W' = weighted implies the graph is weighted and 'M' is of type Matrix ##-(lead=indent) 'V' is a list of integers, symbols or strings (the vertex labels). ##-(lead=indent) 'A' is an Array of sets of integers (the edges of the graph) ##-(lead=indent) 'T' has information about the graph, each vertex and each edge (see below) ##-(lead=indent) 'M' is either 0 or a Matrix of integer or floating point edge weights ## ##- The following commands give the user direct access to these fields. ## ##-(lead=indent) ~IsDirected(G)~ returns `true` if 'D'=`directed` and `false` if 'D'=`undirected`. ##-(lead=indent) ~IsWeighted(G)~ returns `true` if 'W'=`weighted` and `false` if 'W'=`unweighted`. ##-(lead=indent) ~Vertices(G)~ returns 'V' ##-(lead=indent) ~WeightMatrix(G)~ returns 'M' if 'G' is weighted and an error otherwise. ## ##- The edges in the graph are implicitly defined by 'A'. If _u=V[i]_ and ## _v=V[j]_ are two vertices in the graph, the edge _{u,v}_ (or arc _[u,v]_) is in the ## graph if and only if the integer ~j~ is in the set of integers _A[i]_. The ## "Edges", "Neighbors", "Arrivals", "Departures", and "AdjacencyMatrix" commands all ## return this edge information in different formats. ## ##- The user may attach arbitrary information to the vertices of the graph, ## the edges of the graph, or the graph as a whole. This is done using ## attributes and the information is stored in the table 'T'. ## See the "GraphAttributes" help page, as well as the ## "GetVertexPosition" and "SetVertexPosition" commands. ## ##SECTION List of GraphTheory Package Commands ## ##- The following is a list of the commands in the main GraphTheory package. ##-(lead=indent) "AcyclicPolynomial" ##-(lead=indent) "AddArc" ##-(lead=indent) "AddEdge" ##-(lead=indent) "AddVertex" ##-(lead=indent) "AdjacencyMatrix" ##-(lead=indent) "AllPairsDistance" ##-(lead=indent) "Arrivals" ##-(lead=indent) "ArticulationPoints" ##-(lead=indent) "BiconnectedComponents" ##-(lead=indent) "BipartiteMatching" ##-(lead=indent) "Blocks" ##-(lead=indent) "CartesianProduct" ##-(lead=indent) "CharacteristicPolynomial" ##-(lead=indent) "ChromaticIndex" ##-(lead=indent) "ChromaticNumber" ##-(lead=indent) "ChromaticPolynomial" ##-(lead=indent) "CircularChromaticIndex" ##-(lead=indent) "CircularChromaticNumber" ##-(lead=indent) "CircularEdgeChromaticNumber" ##-(lead=indent) "CliqueNumber" ##-(lead=indent) "CompleteGraph" ##-(lead=indent) "ConnectedComponents" ##-(lead=indent) "Contract" ##-(lead=indent) "CopyGraph" ##-(lead=indent) "CycleBasis" ##-(lead=indent) "CycleGraph" ##-(lead=indent) "Degree" ##-(lead=indent) "DegreeSequence" ##-(lead=indent) "DeleteArc" ##-(lead=indent) "DeleteEdge" ##-(lead=indent) "DeleteVertex" ##-(lead=indent) "Departures" ##-(lead=indent) "Diameter" ##-(lead=indent) "Digraph" ##-(lead=indent) "DijkstrasAlgorithm" ##-(lead=indent) "DiscardEdgeAttribute" ##-(lead=indent) "DiscardGraphAttribute" ##-(lead=indent) "DiscardVertexAttribute" ##-(lead=indent) "DisjointUnion" ##-(lead=indent) "Distance" ##-(lead=indent) "DrawGraph" ##-(lead=indent) "DrawNetwork" ##-(lead=indent) "EdgeChromaticNumber" ##-(lead=indent) "EdgeConnectivity" ##-(lead=indent) "Edges" ##-(lead=indent) "ExportGraph" ##-(lead=indent) "FlowPolynomial" ##-(lead=indent) "FundamentalCycle" ##-(lead=indent) "GetEdgeAttribute" ##-(lead=indent) "GetGraphAttribute" ##-(lead=indent) "GetVertexAttribute" ##-(lead=indent) "GetVertexPositions" ##-(lead=indent) "GetEdgeWeight" ##-(lead=indent) "Girth" ##-(lead=indent) "Graph" ##-(lead=indent) "GraphComplement" ##-(lead=indent) "GraphEqual" ##-(lead=indent) "GraphInfo" ##-(lead=indent) "GraphJoin" ##-(lead=indent) "GraphPolynomial" ##-(lead=indent) "GraphPower" ##-(lead=indent) "GraphRank" ##-(lead=indent) "GraphSpectrum" ##-(lead=indent) "GraphUnion" ##-(lead=indent) "GreedyColor" ##-(lead=indent) "HasArc" ##-(lead=indent) "HasEdge" ##-(lead=indent) "HighlightEdges" ##-(lead=indent) "HighlightSubgraph" ##-(lead=indent) "HighlightTrail" ##-(lead=indent) "HighlightVertex" ##-(lead=indent) "ImportGraph" ##-(lead=indent) "IncidenceMatrix" ##-(lead=indent) "IncidentEdges" ##-(lead=indent) "InDegree" ##-(lead=indent) "IndependenceNumber" ##-(lead=indent) "InducedSubgraph" ##-(lead=indent) "Internal" ##-(lead=indent) "IsAcyclic" ##-(lead=indent) "IsBiconnected" ##-(lead=indent) "IsBipartite" ##-(lead=indent) "IsClique" ##-(lead=indent) "IsConnected" ##-(lead=indent) "IsCutSet" ##-(lead=indent) "IsDirected" ##-(lead=indent) "IsEdgeColorable" ##-(lead=indent) "IsEulerian" ##-(lead=indent) "IsForest" ##-(lead=indent) "IsGraphicSequence" ##-(lead=indent) "IsHamiltonian" ##-(lead=indent) "IsIntegerGraph" ##-(lead=indent) "IsNetwork" ##-(lead=indent) "IsPlanar" ##-(lead=indent) "IsRegular" ##-(lead=indent) "IsStronglyConnected" ##-(lead=indent) "IsTournament" ##-(lead=indent) "IsTree" ##-(lead=indent) "IsTwoEdgeConnected" ##-(lead=indent) "IsVertexColorable" ##-(lead=indent) "IsWeighted" ##-(lead=indent) "KruskalsAlgorithm" ##-(lead=indent) "LineGraph" ##-(lead=indent) "ListEdgeAttributes" ##-(lead=indent) "ListGraphAttributes" ##-(lead=indent) "ListVertexAttributes" ##-(lead=indent) "MakeDirected" ##-(lead=indent) "MakeWeighted" ##-(lead=indent) "MaxFlow" ##-(lead=indent) "MaximumClique" ##-(lead=indent) "MaximumDegree" ##-(lead=indent) "MaximumIndependentSet" ##-(lead=indent) "MinimumDegree" ##-(lead=indent) "MinimalSpanningTree" ##-(lead=indent) "Mycielski" ##-(lead=indent) "Neighborhood" ##-(lead=indent) "Neighbors" ##-(lead=indent) "NumberOfEdges" ##-(lead=indent) "NumberOfSpanningTrees" ##-(lead=indent) "NumberOfVertices" ##-(lead=indent) "OutDegree" ##-(lead=indent) "PathGraph" ##-(lead=indent) "PermuteVertices" ##-(lead=indent) "PrimsAlgorithm" ##-(lead=indent) "RankPolynomial" ##-(lead=indent) "RelabelVertices" ##-(lead=indent) "SeidelSpectrum" ##-(lead=indent) "SeidelSwitch" ##-(lead=indent) "SequenceGraph" ##-(lead=indent) "SetEdgeAttribute" ##-(lead=indent) "SetGraphAttribute" ##-(lead=indent) "SetVertexAttribute" ##-(lead=indent) "SetVertexPositions" ##-(lead=indent) "SetEdgeWeight" ##-(lead=indent) "ShortestPath" ##-(lead=indent) "SpanningPolynomial" ##-(lead=indent) "SpanningTree" ##-(lead=indent) "StronglyConnectedComponents" ##-(lead=indent) "Subdivide" ##-(lead=indent) "Subgraph" ##-(lead=indent) "TensorProduct" ##-(lead=indent) "TopologicSort" ##-(lead=indent) "TravelingSalesman" ##-(lead=indent) "TreeHeight" ##-(lead=indent) "TuttePolynomial" ##-(lead=indent) "TwoEdgeConnectedComponents" ##-(lead=indent) "VertexConnectivity" ##-(lead=indent) "Vertices" ##-(lead=indent) "WeightMatrix" ##-(lead=indent) "UnderlyingGraph" ## ##SECTION Accessing the GraphTheory Package Commands ## ##- Each command in the `GraphTheory` package can be accessed by using either ## the "long form" or the "short form" of the command name in the command ## calling sequence. For example, if ~G~ is a graph you may use either ## ~GraphTheory[IsPlanar](G)~ or ~with(GraphTheory);~ then ~IsPlanar(G)~. ## ##- Because the underlying implementation of the `GraphTheory` package is a ## module, it is possible to use the form ~GraphTheory:-command~ to access a ## command from the package. For more information, see "Module Members". ## ##NOTES ## ##EXAMPLES ## ##> with(GraphTheory): ## ##- An undirected graph on 5 vertices labelled 1 to 5. ## ##> G := Graph({{1,2},{2,3},{3,1},{4,5}}); ##> DrawGraph(G); ## ##- A directed graph on 4 vertices a, b, c, and d. ## ##> H := Digraph([a,b,c,d], {[a,b],[b,c],[c,d],[d,a]}); ##> DrawGraph(H); ## ##- A weighted directed graph (a network) on 4 vertices 1, 2, 3, and 4. ## ##> N := Digraph({[[1,2],3],[[1,3],3],[[2,4],4],[[3,4],4]}); ##> WeightMatrix(N); ## ##- A example of a special graph, a dodecahedron, on 20 vertices. ## ##> with(SpecialGraphs): ##> G := DodecahedronGraph(); ##> DrawGraph(G); ## ##SEEALSO ## ##- "GraphTheory examples" ##- "RandomGraphs" ##- "SpecialsGraphs" ## ##XREFMAP ##- "GraphTheory examples" : Help:examples[GraphTheory] ##- "SpecialGraphs" : Help:GraphTheory[SpecialGraphs] ##- "RandomGraphs" : Help:GraphTheory[RandomGraphs] ##- "GraphAttributes" : Help:GraphTheory[GraphAttributes] ##- "AcyclicPolynomial" : Help:GraphTheory[AcyclicPolynomial] ##- "AddArc" : Help:GraphTheory[AddArc] ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "AddVertex" : Help:GraphTheory[AddVertex] ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "AllPairsDistance" : Help:GraphTheory[AllPairsDistance] ##- "Arrivals" : Help:GraphTheory[Arrivals] ##- "ArticulationPoints" : Help:GraphTheory[ArticulationPoints] ##- "BiconnectedComponents" : Help:GraphTheory[BiconnectedComponents] ##- "BipartiteMatching" : Help:GraphTheory[BipartiteMatching] ##- "Blocks" : Help:GraphTheory[Blocks] ##- "CartesianProduct" : Help:GraphTheory[CartesianProduct] ##- "CharacteristicPolynomial" : Help:GraphTheory[CharacteristicPolynomial] ##- "ChromaticIndex" : Help:GraphTheory[ChromaticIndex] ##- "ChromaticNumber" : Help:GraphTheory[ChromaticNumber] ##- "ChromaticPolynomial" : Help:GraphTheory[ChromaticPolynomial] ##- "CircularChromaticIndex" : Help:GraphTheory[CircularChromaticIndex] ##- "CircularChromaticNumber" : Help:GraphTheory[CircularChromaticNumber] ##- "CircularEdgeChromaticNumber" : Help:GraphTheory[CircularEdgeChromaticNumber] ##- "CliqueNumber" : Help:GraphTheory[CliqueNumber] ##- "CompleteGraph" : Help:GraphTheory[CompleteGraph] ##- "ConnectedComponents" : Help:GraphTheory[ConnectedComponents] ##- "Contract" : Help:GraphTheory[Contract] ##- "CopyGraph" : Help:GraphTheory[CopyGraph] ##- "CycleBasis" : Help:GraphTheory[CycleBasis] ##- "CycleGraph" : Help:GraphTheory[CycleGraph] ##- "Degree" : Help:GraphTheory[Degree] ##- "DegreeSequence" : Help:GraphTheory[DegreeSequence] ##- "DeleteArc" : Help:GraphTheory[DeleteArc] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "DeleteVertex" : Help:GraphTheory[DeleteVertex] ##- "Departures" : Help:GraphTheory[Departures] ##- "Diameter" : Help:GraphTheory[Diameter] ##- "Digraph" : Help:GraphTheory[Digraph] ##- "DijkstrasAlgorithm" : Help:GraphTheory[DijkstrasAlgorithm] ##- "DiscardEdgeAttribute" : Help:GraphTheory[DiscardEdgeAttribute] ##- "DiscardGraphAttribute" : Help:GraphTheory[DiscardGraphAttribute] ##- "DiscardVertexAttribute" : Help:GraphTheory[DiscardVertexAttribute] ##- "DisjointUnion" : Help:GraphTheory[DisjointUnion] ##- "Distance" : Help:GraphTheory[Distance] ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "DrawNetwork" : Help:GraphTheory[DrawNetwork] ##- "EdgeChromaticNumber" : Help:GraphTheory[EdgeChromaticNumber] ##- "EdgeConnectivity" : Help:GraphTheory[EdgeConnectivity] ##- "Edges" : Help:GraphTheory[Edges] ##- "ExportGraph" : Help:GraphTheory[ExportGraph] ##- "FlowPolynomial" : Help:GraphTheory[FlowPolynomial] ##- "FundamentalCycle" : Help:GraphTheory[FundamentalCycle] ##- "GetEdgeAttribute" : Help:GraphTheory[GetEdgeAttribute] ##- "GetGraphAttribute" : Help:GraphTheory[GetGraphAttribute] ##- "GetVertexAttribute" : Help:GraphTheory[GetVertexAttribute] ##- "GetVertexPositions" : Help:GraphTheory[GetVertexPositions] ##- "GetEdgeWeight" : Help:GraphTheory[GetEdgeWeight] ##- "Girth" : Help:GraphTheory[Girth] ##- "Graph" : Help:GraphTheory[Graph] ##- "GraphComplement" : Help:GraphTheory[GraphComplement] ##- "GraphEqual" : Help:GraphTheory[GraphEqual] ##- "GraphInfo" : Help:GraphTheory[GraphInfo] ##- "GraphJoin" : Help:GraphTheory[GraphJoin] ##- "GraphPolynomial" : Help:GraphTheory[GraphPolynomial] ##- "GraphPower" : Help:GraphTheory[GraphPower] ##- "GraphRank" : Help:GraphTheory[GraphRank] ##- "GraphSpectrum" : Help:GraphTheory[GraphSpectrum] ##- "GraphUnion" : Help:GraphTheory[GraphUnion] ##- "GreedyColor" : Help:GraphTheory[GreedyColor] ##- "HasArc" : Help:GraphTheory[HasArc] ##- "HasEdge" : Help:GraphTheory[HasEdge] ##- "HighlightEdges" : Help:GraphTheory[HighlightEdges] ##- "HighlightSubgraph" : Help:GraphTheory[HighlightSubgraph] ##- "HighlightTrail" : Help:GraphTheory[HighlightTrail] ##- "HighlightVertex" : Help:GraphTheory[HighlightVertex] ##- "ImportGraph" : Help:GraphTheory[ImportGraph] ##- "IncidenceMatrix" : Help:GraphTheory[IncidenceMatrix] ##- "IncidentEdges" : Help:GraphTheory[IncidentEdges] ##- "InDegree" : Help:GraphTheory[InDegree] ##- "IndependenceNumber" : Help:GraphTheory[IndependenceNumber] ##- "InducedSubgraph" : Help:GraphTheory[InducedSubgraph] ##- "Internal" : Help:GraphTheory[Internal] ##- "IsAcyclic" : Help:GraphTheory[IsAcyclic] ##- "IsBiconnected" : Help:GraphTheory[IsBiconnected] ##- "IsBipartite" : Help:GraphTheory[IsBipartite] ##- "IsClique" : Help:GraphTheory[IsClique] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "IsCutSet" : Help:GraphTheory[IsCutSet] ##- "IsDirected" : Help:GraphTheory[IsDirected] ##- "IsEdgeColorable" : Help:GraphTheory[IsEdgeColorable] ##- "IsEulerian" : Help:GraphTheory[IsEulerian] ##- "IsForest" : Help:GraphTheory[IsForest] ##- "IsGraphicSequence" : Help:GraphTheory[IsGraphicSequence] ##- "IsHamiltonian" : Help:GraphTheory[IsHamiltonian] ##- "IsIntegerGraph" : Help:GraphTheory[IsIntegerGraph] ##- "IsNetwork" : Help:GraphTheory[IsNetwork] ##- "IsPlanar" : Help:GraphTheory[IsPlanar] ##- "IsRegular" : Help:GraphTheory[IsRegular] ##- "IsStronglyConnected" : Help:GraphTheory[IsStronglyConnected] ##- "IsTournament" : Help:GraphTheory[IsTournament] ##- "IsTree" : Help:GraphTheory[IsTree] ##- "IsTwoEdgeConnected" : Help:GraphTheory[IsTwoEdgeConnected] ##- "IsVertexColorable" : Help:GraphTheory[IsVertexColorable] ##- "IsWeighted" : Help:GraphTheory[IsWeighted] ##- "KruskalsAlgorithm" : Help:GraphTheory[KruskalsAlgorithm] ##- "LineGraph" : Help:GraphTheory[LineGraph] ##- "ListEdgeAttributes" : Help:GraphTheory[ListEdgeAttributes] ##- "ListGraphAttributes" : Help:GraphTheory[ListGraphAttributes] ##- "ListVertexAttributes" : Help:GraphTheory[ListVertexAttributes] ##- "MakeDirected" : Help:GraphTheory[MakeDirected] ##- "MakeWeighted" : Help:GraphTheory[MakeWeighted] ##- "MaxFlow" : Help:GraphTheory[MaxFlow] ##- "MaximumClique" : Help:GraphTheory[MaximumClique] ##- "MaximumDegree" : Help:GraphTheory[MaximumDegree] ##- "MaximumIndependentSet" : Help:GraphTheory[MaximumIndependentSet] ##- "MinimumDegree" : Help:GraphTheory[MinimumDegree] ##- "MinimalSpanningTree" : Help:GraphTheory[MinimalSpanningTree] ##- "Mycielski" : Help:GraphTheory[Mycielski] ##- "Neighborhood" : Help:GraphTheory[Neighborhood] ##- "Neighbors" : Help:GraphTheory[Neighbors] ##- "NumberOfEdges" : Help:GraphTheory[NumberOfEdges] ##- "NumberOfSpanningTrees" : Help:GraphTheory[NumberOfSpanningTrees] ##- "NumberOfVertices" : Help:GraphTheory[NumberOfVertices] ##- "OutDegree" : Help:GraphTheory[OutDegree] ##- "PathGraph" : Help:GraphTheory[PathGraph] ##- "PermuteVertices" : Help:GraphTheory[PermuteVertices] ##- "PrimsAlgorithm" : Help:GraphTheory[PrimsAlgorithm] ##- "RankPolynomial" : Help:GraphTheory[RankPolynomial] ##- "RelabelVertices" : Help:GraphTheory[RelabelVertices] ##- "SeidelSpectrum" : Help:GraphTheory[SeidelSpectrum] ##- "SeidelSwitch" : Help:GraphTheory[SeidelSwitch] ##- "SequenceGraph" : Help:GraphTheory[SequenceGraph] ##- "SetEdgeAttribute" : Help:GraphTheory[SetEdgeAttribute] ##- "SetGraphAttribute" : Help:GraphTheory[SetGraphAttribute] ##- "SetVertexAttribute" : Help:GraphTheory[SetVertexAttribute] ##- "SetVertexPositions" : Help:GraphTheory[SetVertexPositions] ##- "SetEdgeWeight" : Help:GraphTheory[SetEdgeWeight] ##- "ShortestPath" : Help:GraphTheory[ShortestPath] ##- "SpanningPolynomial" : Help:GraphTheory[SpanningPolynomial] ##- "SpanningTree" : Help:GraphTheory[SpanningTree] ##- "StronglyConnectedComponents" : Help:GraphTheory[StronglyConnectedComponents] ##- "Subdivide" : Help:GraphTheory[Subdivide] ##- "Subgraph" : Help:GraphTheory[Subgraph] ##- "TensorProduct" : Help:GraphTheory[TensorProduct] ##- "TopologicSort" : Help:GraphTheory[TopologicSort] ##- "TravelingSalesman" : Help:GraphTheory[TravelingSalesman] ##- "TreeHeight" : Help:GraphTheory[TreeHeight] ##- "TuttePolynomial" : Help:GraphTheory[TuttePolynomial] ##- "TwoEdgeConnectedComponents" : Help:GraphTheory[TwoEdgeConnectedComponents] ##- "VertexConnectivity" : Help:GraphTheory[VertexConnectivity] ##- "Vertices" : Help:GraphTheory[Vertices] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] ##- "UnderlyingGraph" : Help:GraphTheory[UnderlyingGraph] GraphTheory := module() local BFS, BinTup, COPY_TABLE, DFS, GetDefaultVPos, GRAPH_TABLE_NAME, Network2Graph, Reduce, ReduceBound, TPDelEdge, TPContract, TPCutEdge; export _pexports, AcyclicPolynomial, AddArc, AddEdge, AddVertex, AdjacencyMatrix, AllPairsDistance, Arrivals, ArticulationPoints, BiconnectedComponents, BipartiteMatching, Blocks, CartesianProduct, CharacteristicPolynomial, ChromaticIndex, ChromaticNumber, ChromaticPolynomial, CircularChromaticIndex, CircularChromaticNumber, CircularEdgeChromaticNumber, # ClosedNeighborhood, # RP: removed CliqueNumber, CompleteGraph, ConnectedComponents, Contract, CopyGraph, CycleBasis, CycleGraph, # Deck, # RP: removed Degree, DegreeSequence, DeleteArc, DeleteEdge, DeleteVertex, Departures, Diameter, Digraph, DijkstrasAlgorithm, DiscardEdgeAttribute, DiscardGraphAttribute, DiscardVertexAttribute, DisjointUnion, Distance, DrawGraph, DrawNetwork, EdgeChromaticNumber, EdgeConnectivity, Edges, ExportGraph, FlowPolynomial, FundamentalCycle, GetEdgeAttribute, GetGraphAttribute, GetVertexAttribute, GetVertexPositions, GetEdgeWeight, Girth, Graph, GraphComplement, # GraphDifference, # RP: removed GraphEqual, GraphInfo, GraphJoin, GraphPolynomial, GraphPower, GraphRank, GraphSpectrum, # GraphSum, # RP: changed to GraphUnion. old GraphUnion -> DisjointUnion GraphUnion, GreedyColor, HasArc, HasEdge, # Head, # RP: removed HighlightEdges, HighlightSubgraph, HighlightTrail, HighlightVertex, ImportGraph, IncidenceMatrix, IncidentEdges, InDegree, IndependenceNumber, InducedSubgraph, Internal, IsAcyclic, IsBiconnected, IsBipartite, IsClique, IsConnected, IsCutSet, IsDirected, IsEdgeColorable, IsEulerian, IsForest, IsGraphicSequence, IsHamiltonian, IsIntegerGraph, IsKColorable, # RP: hidden export (use IsVertexColorable) IsKDColorable, # IsKDEdgeColorable, # RP: hidden export (use IsEdgeColorable) IsKEdgeColorable, # IsNetwork, IsPlanar, IsRegular, IsStronglyConnected, IsTournament, IsTree, IsTwoEdgeConnected, IsVertexColorable, IsWeighted, IsomorphicCopy, # Join, # RP: removed KruskalsAlgorithm, LineGraph, ListEdgeAttributes, ListGraphAttributes, ListVertexAttributes, MakeDirected, MakeWeighted, MaxFlow, MaximumClique, MaximumDegree, MaximumIndependentSet, MinimumDegree, MinimalSpanningTree, Mycielski, Neighborhood, Neighbors, NumberOfEdges, NumberOfSpanningTrees, NumberOfVertices, OptimalVertexColoring, OptimalEdgeColoring, OutDegree, PathGraph, PermuteVertices, PrimsAlgorithm, RankPolynomial, RelabelVertices, SeidelSpectrum, SeidelSwitch, SequenceGraph, SetEdgeAttribute, SetGraphAttribute, SetVertexAttribute, SetVertexPositions, SetEdgeWeight, ShortestPath, SpanningPolynomial, SpanningTree, StronglyConnectedComponents, Subdivide, Subgraph, # Tail, # RP: removed TensorProduct, TopologicSort, TravelingSalesman, TreeHeight, TuttePolynomial, TwoEdgeConnectedComponents, VertexConnectivity, Vertices, WeightMatrix, UnderlyingGraph, #--------- will be removed after draw is modified SetVPos, GetVPos, SetVColor, GetVColor, SetLPos, GetLPos, SetEdgesColor, GetEdgesColor, SetEdgesThickness, GetEdgesThickness ; #---------- option package; protect(GRAPHLN); protect(directed); protect(undirected); protect(weighted); protect(unweighted); _pexports := () -> [op({exports(GraphTheory)} minus {':-SetVPos', ':-GetVPos', ':-SetVColor', ':-GetVColor', ':-SetLPos', ':-GetLPos', ':-SetEdgesColor', ':-GetEdgesColor', ':-SetEdgesThickness', ':-GetEdgesThickness', ':-OptimalVertexColoring', ':-OptimalEdgeColoring', ':-IsKColorable', ':-IsKDColorable', # RP: merged into IsVertexColorable ':-IsKEdgeColorable', ':-IsKDEdgeColorable', # RP: merged into IsEdgeColorable ':-Internal', ':-_pexports'})]: ###################### ## LOCAL Procedures ## ###################### COPY_TABLE := proc(T) local t; t := GRAPH_TABLE_NAME(); if type(T,table) then assign(t,copy(T)); fi; t; end: if IsWorksheetInterface('Standard') then GRAPH_TABLE_NAME := proc() local c; c := 0; proc(t::table) local n; c := c+1; n := cat(`GRAPHLN/table/`,c); if nargs=1 then assign(n,t); fi; n; end; end(): else # MBM: The above exports a unique global name, but, it prevents garbage collection # MBM: of the table because it's a global name accessible to the user. The loop # MBM: > for i to 1000 do CycleGraph(1000) od; # MBM: creates 1000 cycles with tables containing vertex positions (in a circle). # MBM: They can't be garbage collected. # MBM: So I export a local unique symbol instead so the tables can be collected. # MBM: In Maple 10 this reduces bytesalloc of the above loop from 50 MB to 13 MB GRAPH_TABLE_NAME := proc() local c; c := 0; proc(t::table) local n; c := c+1; n := subs( 'TABLE'=cat(`GRAPHLN/table/`,c), proc() local TABLE; TABLE end )(); if nargs=1 then assign(n,t); fi; n; end; end(): fi: #G:graph, s:a vertex, d(u): distance of u from s in G, P(u): predecessors of u in G BFS := proc(G,s,d,P) local ENQUEUE, DEQUEUE, V, u, color, Q, v,n, A; global Qlength, tail, head; ENQUEUE := proc(Q::table,x::anything) Q[tail[Q]] := x; if tail[Q] = Qlength then tail[Q] := 1 else tail[Q] := tail[Q] + 1; end if; end: DEQUEUE := proc(Q::table) local x; x := Q[head[Q]]; if head[Q] = Qlength then head[Q] := 1 else head[Q] := head[Q] + 1; end if; x; end: n := nops(vlist(G)); A := listn(G); V := { seqint(n) }; Qlength := n; for u in V minus {s} do color[u] := WHITE; d[u] := infinity; P[u] := NIL; end do; color[s] := GRAY; d[s] := 0; P[s] := NIL; Q := table(); tail := 'tail'; head := 'head'; tail[Q] := 1; head[Q] := 1; ENQUEUE(Q,s); #while op([1,2],Q) <> [] do while tail[Q] <>head[Q] do u := DEQUEUE(Q); for v in A[u] do if color[v]=WHITE then color[v] := GRAY; d[v] := d[u] + 1; P[v] := u; ENQUEUE(Q,v); end if; end do; color[u] := BLACK; end do; return; end; ################################ BinTup := proc(n) local e; option remember; if n=0 then ( [[]] ) else # ( map( e -> ([0,op(e)],[1,op(e)]) , BinTup(n-1) ) ); # [op(map(e->[0,op(e)], BinTup(n-1))), op(map(e->[1,op(e)], BinTup(n-1)))]; # MBM: seq is faster; it avoids all the procedure calls [seq( [0,op(e)], e=BinTup(n-1) ), seq( [1,op(e)], e=BinTup(n-1) )]; end if; end; ####################### DFS := proc(G,d,f,P) local DFSVISIT,u, color, V, n, A, t; #global t; DFSVISIT := proc(u) local v; #global t; color[u] := GRAY; t := t+1; d[u] := t; for v in A[u] do if color[v]=WHITE then P[v] := u; DFSVISIT(v); end if; color[u] := BLACK; t := t+1; f[u] := t; end do; end; A := listn(G); n := nops(vlist(G)); V := { seqint(n) }; for u in V do color[u] := WHITE; P[u] := NIL; f[u] := 0; end do; t := 0; for u in V do if color[u]=WHITE then DFSVISIT(u); end if; end do; return; end; ############################################## ##PROCEDURE(doti) GreedyColor ##ALIAS GraphTheory[GreedyColor] ##CALLINGSEQ ##- GreedyColor('G', 'perm') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'perm' : (optional) list of vertex labels ## ##RETURNS ##- A proper coloring of the graph along with the number of colors used. ## ##DESCRIPTION ##- `GreedyColor` colors the vertices of the graph in the order given by perm, ## one at a time, assigning to each vertex the smallest available color. ## If the permutation 'perm' is not specified, the identity permutation is used. ## ##EXAMPLES ##> with(GraphTheory): ##> C6 := CycleGraph(6); ##> GreedyColor(C6); ##< 2, [0, 1, 0, 1, 0, 1] ##> G := PermuteVertices(C6, [1,4,2,5,3,6]); ##> GreedyColor(G); ##< 3, [0, 0, 1, 1, 2, 2] ## ##SEEALSO ##- "ChromaticNumber" ##- "IsVertexColorable" ## ##XREFMAP ##- "ChromaticNumber" : Help:GraphTheory[ChromaticNumber] ##- "IsVertexColorable" : Help:GraphTheory[IsVertexColorable] #---------ver. 23, modified by MG GreedyColor := proc(G::GRAPHLN, perm::list(VERTEXTYPE)) local n, A, V, k, i, h, ColorClass, color, p, L; V, A := vlist(G), listn(G); n := nops(V); if nargs<=1 then p := [$1..n]; else L := GraphInfo:-LabelToInteger(G); if {op(perm)} <> {op(V)} then error "Second argument must be a permutation of the vertices of the graph." else p := map(v->L[v], perm); fi; fi; k := 0; for i to n do h := 0; while h < k and A[p[i]] intersect ColorClass[h] <> {} do h := h+1 end do; if h=k then k:=k+1; ColorClass[h] := {}; end if; ColorClass[h] := ColorClass[h] union {p[i]}; color[p[i]] := h end do; k, convert(color,list); end; ############################ Reduce := proc(Mat::Matrix) local val, i, m, mini, j, M; M := copy(Mat); m := op([1,1], M); val := 0; for i to m do mini := min(seq(M[i,j],j=1..m)); for j to m do M[i,j] := M[i,j] - mini end do; val := val + mini; end do; for j to m do mini := min(seq(M[i,j],i=1..m)); for i to m do M[i,j] := M[i,j] - mini end do; val := val + mini; end do; val end; ############################ ReduceBound := proc(X, m, n, M) local Mp, i, j, x, y, ans, C; #m := nops({op(X)}); if m = n then return add(M[1+X[i],1+X[i+1]],i=0..m-2) + M[1+X[m-1],1+X[0]] end if; Mp := Matrix(n-m+1,n-m+1); Mp[1,1] := infinity; C := {seq(i,i=0..n-1)} minus {seq(X[i],i=0..m-1)}; j := 1; for y in C do Mp[1,1+j] := M[1+X[m-1],1+y]; j := j+1; end do; i := 1; for x in C do Mp[i+1,1] := M[1+x,1+X[0]]; i := i+1; end do; i := 2; for x in C do j := 2; for y in C do Mp[i,j] := M[x+1,y+1]; j := j+1; end do; i := i+1; end do; ans := Reduce(Mp); for i to m-1 do ans := ans + M[1+X[i-1],1+X[i]] end do; ans end; ############################################################## #---Jeff--local--start------------------------ TPDelEdge := proc(E,ed) option inline; `if`(E[1][2]=1, E minus {ed}, E minus {E[1]} union { [ed[1],E[1][2]-1] }); end proc: TPContract := proc(E,ed,n) local i,j,k,q,t,e,EW, MList,M,ENew; EW := Matrix(n,n); for e in E do i := e[1][1]; j := `if`(nops(e[1])=1, e[1][1], e[1][2]); EW[i,j] := e[2]; EW[j,i] := e[2]; end do; i,j := ed[1][1], ed[1][2]; t := EW[i,j] - 1; EW[i,j] := t; EW[j,i] := t; MList := [ seq( convert(LinearAlgebra:-Row(EW,k),list), k=1..i-1), convert(LinearAlgebra:-Row(EW,i) + LinearAlgebra:-Row(EW,j),list), seq( convert(LinearAlgebra:-Row(EW,k),list), k=i+1..j-1), seq( convert(LinearAlgebra:-Row(EW,k),list), k=j+1..n) ]; M := Matrix(n-1,n,MList); M[i,i] := M[i,i] + EW[j,j]; M := LinearAlgebra:-DeleteColumn(M,j); for k to n-1 do if M[i,k] > 0 then M[k,i] := M[i,k] end if; end do; ENew := {}; for k to n-1 do for q from k to n-1 do if M[k,q]>0 then ENew := ENew union { [ {k,q}, M[k,q] ] } end if; end do; end do; return ENew end: TPCutEdge := proc(E,ed,n) local i,j,k,q,t,e,seen,recent,Tset,EW; EW := Matrix(n,n); for e in E do i := e[1][1]; j := `if`(nops(e[1])=1, e[1][1], e[1][2]); EW[i,j] := e[2]; EW[j,i] := e[2]; end do; i,j := ed[1][1], ed[1][2]; if EW[i,j] > 1 then return false end if; EW[i,j] := 0; EW[j,i] := 0; seen := {i}: recent := {i}: while true do for q in seen do Tset := {seq(t,t=1..n)} minus seen: for k in Tset do if EW[q,k]>0 then recent := `union`(recent,{k}); if k=j then return false end if; end if; end do; end do; t:=seen; seen := `union`(seen,recent); if seen=t then return true end if; recent:={}; end do; end: #---Jeff--local--end------- ################################################################################ Network2Graph := proc(N::procedure) local T,E,e,h,t,V,v,D,W,w,G; T := [op(3,eval(N))]; if not member('GRAPH',T) then error "input procedure must be a networks package graph" fi; V := networks['vertices'](N); E := networks['edges'](N); V := [op(V)]; for v in V do if not type(v,{integer,symbol,string}) then error "unable to convert %1: vertex labels must be integers, symbols or strings", v; fi; od; T := table(); D := undirected; W := unweighted; for e in E do w := networks['eweight'](e,N); if w <> 1 then W := weighted fi; h := networks['head'](e,N); t := networks['tail'](e,N); if h<>NULL and t<>NULL then if assigned(T[t,h]) then error "sorry, unable to convert multigraphs" fi; D := directed; T[e] := [[t,h],w]; T[t,h] := true; else t,h := op(networks['ends'](e,N)); if assigned(T[t,h]) or assigned(T[h,t]) then error "sorry, unable to convert multigraphs" fi; T[e] := [{t,h},w]; T[t,h] := true; fi; od; if W=unweighted then # strip off default edge weights for e in E do T[e] := T[e][1]; od; fi; E := {seq( T[e], e=E )}; # set of edges G := GraphTheory:-Graph(D,W,V,E); end: ################################################################################ ######################### # Sub-Module (Internal) # ######################### Internal := module() export Contract, DelEdg, DeleteEdge, DelVerArr; Contract := proc() local G, e, D, W, V, A, T, EW, k, E, n, i, j, S, s, Vnew, B, M; G, e := args[1..2]; D, W, V, A, T, EW := getops(G); n := nops(V); i, j := e[1,1], e[1,2]; S := A[j]; Vnew := subsop(i={e[1,1],e[1,2]}, j=NULL, V); B := copy(A); B[i] := (B[i] union B[j]) minus {i,j}; for k to n do if j in A[k] and k<>i then B[k] := subs(j=i, B[k]) end if;end do; B := Array([ seq( `if`( k=j, NULL, B[k]), k=1..n ) ]); B := subs(seq(k=k-1,k=j+1..n),B); M := copy(EW); for s in S do if s<>i then M[i,s] := M[i,s]+M[j,s]; M[s,i] := M[s,i]+M[s,j]; end if; end do; M[i,i] := M[i,i]+M[j,j]+M[i,j]-1; M := LinearAlgebra:-DeleteRow(M,j); M := LinearAlgebra:-DeleteColumn(M,j); GRAPHLN(D, weighted, Vnew, B, COPY_TABLE(T), M ); end; ############################################# DelEdg := proc (A, e) local i, j; i, j := e[1], e[2]; A[i] := A[i] minus {j}; A[j] := A[j] minus {i}; return A; end; ############################################# DeleteEdge := proc() local G, e, i, j, w, D, W, V, A, T, EW, M, B; G, e := args[1..2]; D, W, V, A, T, EW := getops(G); M := copy(EW); B := A; if nops(e[1]) = 2 then i, j, w := e[1,1], e[1,2], e[2]; if M[i,j] - w > 0 then M[i,j] := M[i,j] - w; M[j,i] := M[j,i] - w; else B := copy(A); B[i] := B[i] minus { j }; B[j] := B[j] minus { i }; M[i,j] := 0; M[j,i] := 0; end if; else i, w := e[1,1], e[2]; if M[i,i] - w >= 0 then #????? MG M[i,i] := M[i,i] - w; end if; end if; GRAPHLN(D, W, V, B, COPY_TABLE(T), M); end; ########################################### DelVerArr := proc (V, A, x) local n, m, k, Vn, An; n := nops(V); m := nops(x); Vn := [ seq( `if`( v in x, NULL, v), v=V ) ]; An := Array([ seq( `if`( i in x, NULL, A[i] minus x), i=1..n ) ]); for k in x do An := subs( seq( i=i-1, i=k+1..n ), An );end do; return Vn, An; end; ############################################# end module; #Internal ############################################# ############################ ############################ ## Sub-Module (GraphInfo) ## ############################ ############################ # RP: added option package GraphInfo := module() option package; export DelVerArr, Edges, LabelToInteger, StandardGraph, SetAttrib, GetAttrib, DiscardAttrib, ApplyPermutation, SetVPos, GetVPos, SetDefaultDrawStyle, GetDefaultDrawStyle, SetVColor, GetVColor, SetLPos, GetLPos, SetEdgesColor, GetEdgesColor, SetEdgesThickness, GetEdgesThickness; DelVerArr := proc (V, A, x) local n, m, k, Vn, An; n := nops(V); m := nops(x); Vn := [ seq( `if`( v in x, NULL, v), v=V ) ]; An := Array([ seq( `if`( i in x, NULL, A[i] minus x), i=1..n ) ]); for k in x do An := subs( seq( i=i-1, i=k+1..n ), An );end do; return Vn, An; end; ############################################# Edges := proc(G) local n, ln, wt; n := nops(vlist(G)); ln := listn(G); if nargs > 1 then if args[2]='weights' and getwt(G)=weighted then wt := eweight(G); if getdir(G)=directed then return {seq(seq([[i,j], wt[i,j]], j=ln[i]), i=1..n)}; else return {seq(seq([{i,j}, wt[i,j]], j=ln[i]), i=1..n)}; fi; else error "usage: Edges(G, 'weights')"; fi; else if getdir(G)=directed then return {seq(seq([i,j], j=ln[i]), i=1..n)}; else return {seq(seq({i,j}, j=ln[i]), i=1..n)}; fi; fi; end; ############################################# LabelToInteger := proc(G) option remember; local n, k, V, L; V := vlist(G); n := nops(V); L := table(); for k to n do L[V[k]] := k; end do; eval(L); end; ############################################## ##PROCEDURE(doti) ApplyPermutation ##ALIAS GraphTheory[GraphInfo][ApplyPermutation] ##CALLINGSEQ ##- ApplyPermutation('G', 'sigma') ## ##PARAMETERS ##- 'G' : graph ##- 'sigma' : list of integers ## ##DESCRIPTION ##- `ApplyPermutation` returns a graph which is isomorphic to the original graph ## and its vertices are a permutation of the vertices of the original graph. ## ##EXAMPLES ##> with(GraphTheory): ##> with(GraphInfo): ##> G := RandomGraphs:-RandomGraph(20,.7): ##> sigma := sort([$1..20], proc(i,j) evalb(Degree(G,i) > Degree(G,j)) end): ##> H := ApplyPermutation(G,sigma): ##> seq(Degree(H,v), v=Vertices(H)); #---------ver. 23, modified by MG ApplyPermutation := proc(G::GRAPHLN, P::list) local D, W, V, A, T, EW, n, sigma, L; D, W, V, A, T, EW := getops(G); n := nops(V); if not (nops(P) = n and {op(P)} = {seq(i,i=1..n)}) then error"2nd argument expected to be a permutation of numbers 1 to %1 but received %2",n,P; end if; sigma := [ seq( P[i] = i, i=1..n )]; L := [ seq( subs(sigma,A[P[i]]), i=1..n )]; A := Array(L); V := [seq( V[P[i]], i=1..n )]; subsop(3=V,4=A,G); end; ############################################## ##PROCEDURE(doti) StandardGraph ##ALIAS GraphTheory[GraphInfo][StandardGraph] ##CALLINGSEQ ##- StandardGraph('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `StandardGraph` returns a copy of the graph 'G' ## with the vertices relabeled as integers 1, 2, 3, ... . ## ##EXAMPLES ##> with(GraphTheory): ##> with(GraphInfo): ##> L := GraphComplement(LineGraph(CompleteGraph(5))); ##> P := StandardGraph(L); ##> Vertices(L); ### ["2-3", "1-3", "1-2", "1-4", "2-5", "1-5", "3-4", "4-5", "2-4", "3-5"] ##> Vertices(P); ##< [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] ## ##TEST ## Try(100, {op(Vertices(L))}, {"2-3", "1-3", "1-2", "1-4", "2-5", "1-5", "3-4", "4-5", "2-4", "3-5"}); #---------ver. 23, modified by MG StandardGraph := proc(G::GRAPHLN) RelabelVertices(CopyGraph(G),[$1..NumberOfVertices(G)]); end proc; ############################################## ############################################## # objlist must be one of: # list of vertex indices # list of ordered pairs of vertex indices (for arcs) # list of sets of vertex indices (for edges) # # attlist must be a list of equations and lists of equations SetAttrib := proc(G::GRAPHLN, objlist::list, attlist::list) local a, j, obj, old, new, gi; if nops(objlist) <> nops(attlist) then error "number of attributes does not match number of objects" fi; gi := ginfo(G); for j to nops(objlist) do if attlist[j]<>[] then obj := op(objlist[j]); new := `if`(type(attlist[j], equation), [attlist[j]], attlist[j]); old := `if`(type(gi[obj], list), gi[obj], []); if not type(gi, table) then assign(gi, table()) fi; gi[obj] := [seq(`if`(subs(new,lhs(a))=lhs(a), a, NULL), a=old), op(new)]; fi od; NULL end proc; #-------------------------------------------- # objlist must be one of: # list of vertex indices # list of ordered pairs of vertex indices (for arcs) # list of sets of vertex indices (for edges) # # taglist must be a list of tags and lists of tags GetAttrib := proc(G::GRAPHLN, objlist, taglist) local a, j, obj, tag, att, res, gi; gi := ginfo(G); res := Array(1..nops(objlist)); if nargs=2 then for j to nops(objlist) do obj := op(objlist[j]); res[j] := `if`(type(gi[obj], list), gi[obj], []); od; else for j to nops(objlist) do tag := `if`(type(taglist[j], list), taglist[j], [taglist[j]]); obj := op(objlist[j]); att := `if`(type(gi[obj], list), gi[obj], []); res[j] := seq(`if`(subs(att,a)=a, FAIL, subs(att,a)), a=tag); if type(taglist[j], list) then res[j] := [res[j]]; fi; od; fi; [seq(res[j], j=1..nops(objlist))]; end proc; #-------------------------------------------- # objlist must be one of: # list of vertex indices # list of ordered pairs of vertex indices (for arcs) # list of sets of vertex indices (for edges) # # taglist must be a list of tags and lists of tags # # if taglist is not provided then all attribs of the objects are discarded # if objlist is not provided then all attribs of all objects are discarded # # e.g. GraphInfo:-DiscardAttrib(G, [$1..nops(vlist(G))], ["draw-pos-default"$nops(vlist(G))]); # DiscardAttrib := proc(G::GRAPHLN, objlist, taglist) local T, idx, obj, tag, tagl, att, j; T := ginfo(G); if not type(T, table) then return fi; if nargs=1 then for obj in indices(T) do idx := op(obj); T[idx] := evaln(T[idx]); od; elif nargs=2 then for obj in objlist do idx := op(obj); T[idx] := evaln(T[idx]); od; else for j to nops(objlist) do idx := op(objlist[j]); att := T[idx]; if type(att, list) then tagl := `if`(type(taglist[j], list), taglist[j], [taglist[j]]); att := map( x-> `if`(member(lhs(x),tagl), NULL, x), att); T[idx] := `if`(att=[], evaln(T[idx]), att); fi; od; fi; NULL; end proc; ############################################## ############################################## SetVPos := proc(G::GRAPHLN, style::string, pos::{list,Array}, Vidx::list) local xy, n; # MBM: I'm allowing the vertex positions pos to be a list OR Array # MBM: If A is an Array, seq( x, x=A ) works fine so the code works # MBM: Same adjustment to SetVColor below if member(style, GT_DRAW_ATTRIBS) then if nargs=4 then SetAttrib(G, Vidx, [seq(style=xy, xy=pos)]); else n := nops(vlist(G)); SetAttrib(G, [$1..n], [seq(style=xy, xy=pos)]); fi; if GetDefaultDrawStyle(G) = FAIL then SetDefaultDrawStyle(G, style); fi; else error"invalid style %1",style; fi; NULL; end proc; #--------------------------------------------- GetVPos := proc(G::GRAPHLN, style::string) local n, tag, vp, box, scale; vp := []; tag := style; # subs(GT_DRAW_STYLES_EQUIV, style); n := nops(vlist(G)); vp := GetAttrib(G, [$1..n], [tag$n]); return `if`(member(FAIL, vp), [], vp); end proc; #--------------------------------------------- SetDefaultDrawStyle := proc(G::GRAPHLN, sty) local prev, gi; gi := ginfo(G); if not type(gi, table) then assign(gi, table()) fi; prev := `if`(member(["draw-default-style"], [indices(gi)]), gi["draw-default-style"], NULL); gi["draw-default-style"] := sty; prev; end proc; #--------------------------------------------- GetDefaultDrawStyle := proc(G::GRAPHLN) `if`(type(ginfo(G), table) and member(["draw-default-style"], [indices(ginfo(G))]), ginfo(G)["draw-default-style"], FAIL); end proc; #--------------------------------------------- SetVColor := proc(G::GRAPHLN, colors::{list,Array}) local gi,c,n; gi := ginfo(G); if not type(gi, table) then assign(gi, table()) fi; n := nops(vlist(G)); SetAttrib(G, [$1..n], [seq("draw-vertex-color"=c, c=colors)]); NULL; end proc; #--------------------------------------------- GetVColor := proc(G::GRAPHLN) local n, c; n := nops(vlist(G)); c := GetAttrib(G, [$1..n], ["draw-vertex-color"$n]); #map( x->`if`(x=FAIL, COLOR(RGB,.8,1,0), x), c); map( x->`if`(x=FAIL, COLOR(RGB,1,1,.2), x), c); end proc; #--------------------------------------------- SetLPos := proc(G::GRAPHLN, style::string, pos::list) SetVPos(args); end proc; #--------------------------------------------- GetLPos := proc(G::GRAPHLN, style::string) GetVPos(args); end proc; #--------------------------------------------- SetEdgesColor := proc(G::GRAPHLN, M::Matrix) local E; E := [op(Edges(G))]; SetAttrib(G, E, map( e -> "draw-edge-color"=M[op(e)] , E)); NULL; end proc; #--------------------------------------------- GetEdgesColor := proc(G::GRAPHLN) local E, c, j, att; E := [op(Edges(G))]; att := GetAttrib(G, E, ["draw-edge-color"$nops(E)]); c := Matrix(nops(vlist(G)), shape=symmetric); for j to nops(E) do c[op(E[j])] := `if`(att[j]=FAIL, COLOR(RGB,0,0,1), att[j]); od; c; end proc; #--------------------------------------------- SetEdgesThickness := proc(G::GRAPHLN, M::Matrix) local E; E := [op(Edges(G))]; SetAttrib(G, E, map( e -> "draw-edge-thickness"=M[op(e)] , E)); NULL; end proc; #--------------------------------------------- GetEdgesThickness := proc(G::GRAPHLN) local E, c, j, att; E := [op(Edges(G))]; att := GetAttrib(G, E, ["draw-edge-thickness"$nops(E)]); c := Matrix(nops(vlist(G)), shape=symmetric); for j to nops(E) do c[op(E[j])] := `if`(att[j]=FAIL, 2, att[j]); od; c; end proc; ############################################# end module; #GraphInfo ############################################# ############################################# ############################################# ##### MAIN EXPORTS########################## ############################################# ############################################# ##PROCEDURE(doti) AddArc ##ALIAS GraphTheory[AddArc] ##CALLINGSEQ ##- AddArc('G', 'E') ##- AddArc('G', 'E', 'ip') ## ##PARAMETERS ##- 'G' : directed graph ##- 'E' : arc or set (or list) of arcs ##- 'ip' : equation of the form `inplace`=`true` or `false` (optional) ## ##DESCRIPTION ##- `AddArc` adds arc(s) to a directed graph. By default, the original ## digraph will be changed to a digraph containg the specified set of arc(s). ## By setting `inplace`=`false` the original digraph remains unchanged and ## a new digraph containg the specified set of arc(s) will be created. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Digraph([a, b, c, d, e], {[a, b], [b, c], [c, d], [d, e]}): ##> AddArc(G,[a,c],inplace=false); ##<(verification="GraphEqual") Digraph([a, b, c, d, e], {[a, b], [b, c], [c, d], [d, e], [a, c]}) ##> G; ##<(verification="GraphEqual") Digraph([a, b, c, d, e], {[a, b], [b, c], [c, d], [d, e]}) ##> AddArc(G, {[a,c],[b,d]}, inplace=false); ##<(verification="GraphEqual") Digraph([a, b, c, d, e], {[a, b], [b, c], [c, d], [d, e], [a, c], [b, d]}) ##> AddArc(G, {[a,c],[b,d]}); ##<(verification="GraphEqual") Digraph([a, b, c, d, e], {[a, b], [b, c], [c, d], [d, e], [a, c], [b, d]}) ##> G; ##<(verification="GraphEqual") Digraph([a, b, c, d, e], {[a, b], [b, c], [c, d], [d, e], [a, c], [b, d]}) ## ##SEEALSO ##- "AddEdge" ##- "DeleteArc" ##- "HasArc" ##- "Digraph" ## ##XREFMAP ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "DeleteArc" : Help:GraphTheory[DeleteArc] ##- "HasArc" : Help:GraphTheory[HasArc] ##- "Digraph" : Help:GraphTheory[Digraph] #---------ver. 23, modified by MG AddArc := proc(G::GRAPHLN, Ed::{EDGETYPE,set(EDGETYPE)}, inp::INPLACETYPE) local E, ip, e, i, j, L, D, W, V, A, T, EW, B, EWb, VEd; ip := true; #indicating that the output overwrites the input graph if nargs = 3 then if type(inp, equation) then ip := op(2,inp) else ip := true end if; end if; D, W, V, A, T, EW := getops(G); if D=undirected then error "to add edges to a graph use `AddEdge'."; fi; E := `if`(type(Ed, set(EDGETYPE)), Ed, {Ed}); if W=weighted then E := map(e->`if`(type(e, list(VERTEXTYPE)), [e, 1], e), E); fi; L := GraphInfo:-LabelToInteger(G); B := `if`(ip, A, copy(A)); if W=unweighted then for e in E do if not type(e, list(VERTEXTYPE)) or nops(e) <> 2 then error "invalid arc %1",e; end if; i,j := L[e[1]],L[e[2]]; if not type([i,j], [integer,integer]) then error "invalid arc %1", e; fi; end do; for e in E do i,j := L[e[1]],L[e[2]]; B[i] := B[i] union { j }; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EW)); elif W=weighted and type(E,set(list)) then EWb := `if`(ip,EW,copy(EW)); for e in E do if not type(e, [list(VERTEXTYPE), numeric]) or nops(e[1]) <> 2 then error "invalid arc %1", e; end if; i, j := L[e[1,1]], L[e[1,2]]; if not type([i,j], [integer,integer]) then error "invalid edge %1", e; fi; end do; for e in E do i, j := L[e[1,1]], L[e[1,2]]; B[i] := B[i] union { j }; EWb[i,j] := e[2]; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EWb)); end if; end; ########################################### ##PROCEDURE(doti) AddEdge ##ALIAS GraphTheory[AddEdge] ##CALLINGSEQ ##- AddEdge('G', 'E') ##- AddEdge('G', 'E', 'ip') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'E' : edge or set of edges ##- 'ip' : equation of the form `inplace`=`true` or `false` (optional) ## ##DESCRIPTION ##- `AddEdge` will add edge(s) to an undirected graph. By default, the original ## graph will be changed to a graph containg the specified set of edge(s). ## By setting `inplace`=`false` the original graph remains unchanged and a new ## graph containg the specified set of edge(s) will be created. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(5): ##> AddEdge(G, {1,3}, inplace=false); ##<(verification="GraphEqual") Graph([$1..5], {{2, 3}, {1, 3}, {1, 2}, {1, 5}, {3, 4}, {4, 5}}) ##> G; ##<(verification="GraphEqual") CycleGraph(5) ##> AddEdge(G, {{1,3},{2,4}}, inplace=false); ##<(verification="GraphEqual") Graph([$1..5], {{2, 3}, {1, 3}, {1, 2}, {1, 5}, {3, 4}, {4, 5}, {2, 4}}) ##> AddEdge(G, {{1,3},{2,4}}); ##<(verification="GraphEqual") Graph([$1..5], {{2, 3}, {1, 3}, {1, 2}, {1, 5}, {3, 4}, {4, 5}, {2, 4}}) ##> G; ##<(verification="GraphEqual") Graph([$1..5], {{2, 3}, {1, 3}, {1, 2}, {1, 5}, {3, 4}, {4, 5}, {2, 4}}) ## ##SEEALSO ##- "AddArc" ##- "DeleteEdge" ##- "HasEdge" ##- "Graph" ## ##XREFMAP ##- "AddArc" : Help:GraphTheory[AddArc] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "HasEdge" : Help:GraphTheory[HasEdge] ##- "Graph" : Help:GraphTheory[Graph] #---------ver. 23, modified by MG AddEdge := proc(G::GRAPHLN, Ed::{EDGETYPE, set(EDGETYPE)}, inp::INPLACETYPE) local E, ip, e, i, j, w, L, D, W, V, A, T, EW, B, EWb, VEd; ip := true; #indicating that the output overwrites the input graph if nargs = 3 then if type(inp, equation) then ip := op(2,inp) else ip := true end if; end if; D, W, V, A, T, EW := getops(G); if D=directed then error "to add arcs to a digraph use `AddArc'."; fi; E := `if`(type(Ed, set(EDGETYPE)), Ed, {Ed}); if W=weighted then E := map(e->`if`(type(e, list), e, [e, 1]), E); fi; L := GraphInfo:-LabelToInteger(G); B := `if`(ip, A, copy(A)); if W=unweighted then for e in E do if not type(e, set(VERTEXTYPE)) or nops(e) <> 2 then error "invalid edge %1",e; end if; i,j := L[e[1]],L[e[2]]; if not type([i,j], [integer,integer]) then error "invalid edge %1", e; fi; end do; for e in E do i,j := L[e[1]],L[e[2]]; B[i] := B[i] union { j }; B[j] := B[j] union { i }; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EW)); elif W=weighted and type(E,set(list)) then EWb := `if`(ip,EW,copy(EW)); for e in E do if not type(e, [set(VERTEXTYPE), numeric]) or nops(e[1]) <> 2 then error "invalid edge %1", e; end if; i, j := L[e[1,1]], L[e[1,2]]; if not type([i,j], [integer,integer]) then error "invalid edge %1", e; fi; end do; for e in E do i, j := L[e[1,1]], L[e[1,2]]; B[i] := B[i] union { j }; B[j] := B[j] union { i }; EWb[i,j], EW[j,i] := e[2]$2; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EWb)); end if; end; ########################################### ##PROCEDURE(doti) AddVertex ##ALIAS GraphTheory[AddVertex] ##CALLINGSEQ ##- AddVertex('G', 'V') ## ##PARAMETERS ##- 'G' : graph ##- 'V' : vertex or list of vertices ## ##DESCRIPTION ##- `AddVertex` will add a vertex or vertices to a graph. The original graph ## will be changed to a graph containing the specified set of vertices. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(5): ##> AddVertex(G, ["a", "b"]); ##<(verification="GraphEqual") Graph([$1..5, "a", "b"], {{2, 3}, {1, 2}, {1, 5}, {3, 4}, {4, 5}}) ##> AddVertex(G, 4); ##<(verification="testerror") AddVertex, "Some of the vertices to be added are already present in the graph." ## ##SEEALSO ##- "AddArc" ##- "AddEdge" ##- "DeleteVertex" ##- "Graph" ##- "CycleGraph" ## ##XREFMAP ##- "AddArc" : Help:GraphTheory[AddArc] ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "DeleteVertex" : Help:GraphTheory[DeleteVertex] ##- "Graph" : Help:GraphTheory[Graph] ##- "CycleGraph" : Help:GraphTheory[CycleGraph] #---------ver. 23, modified by MG AddVertex := proc (G::GRAPHLN, aVS::{VERTEXTYPE,list(VERTEXTYPE)}) local i, n, m, B, M, D, W, V, A, T, EW, VS, x, box, mid, newG, vp, newvp, att, E; VS := `if`( type(aVS, VERTEXTYPE), [aVS], [op(aVS)] ); if nops(VS) <> nops({op(VS)}) then error "A vertex can not be added to a graph more than once." fi; D, W, V, A, T, EW := getops(G); n := nops(V); m := nops(VS); if {op(VS)} intersect {op(V)} <> {} then error "Some of the vertices to be added are already present in the graph."; end if; #newV := [op(V),op(VS)]; B := Array(1..n+m,A); for i from n+1 to n+m do B[i] :={} end do; if W=unweighted then M:=0 else M := Matrix(n+m,n+m,EW); end if; newG := GRAPHLN(D, W, [op(V), op(VS)], B, GRAPH_TABLE_NAME() , M); #---attribs E := op(GraphInfo:-Edges(newG)); att := map(x->map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), x), GraphInfo:-GetAttrib(G, [$1..n, E])); GraphInfo:-SetAttrib(newG, [$1..n, E], att); #---drawing vp := GraphInfo:-GetVPos(G, VP_FIXED); if nops(vp)<>0 then box := min(seq(vp[aux][1], aux=1..n)), min(seq(vp[aux][2], aux=1..n)), max(seq(vp[aux][1], aux=1..n)), max(seq(vp[aux][2], aux=1..n)); mid := sum(vp[aux], aux=1..n) / n; x := box[3] + .3 * (box[3]-box[1]); newvp := Array(1..n+m, vp); if m=1 then newvp[n+1] := [x, (box[2]+box[4])/2]; else for i to m do newvp[n+i] := [x, box[4]+(i-1)*(box[2]-box[4])/(m-1)]; od; fi; GraphInfo:-SetVPos(newG, VP_FIXED, [seq(newvp[i], i=1..n+m)]); fi; newG; end; ########################################### ##PROCEDURE(doti) HasArc ##TITLE HasArc ##TITLE HasEdge ##ALIAS GraphTheory[HasArc], GraphTheory[HasEdge] ##CALLINGSEQ ##- HasArc('G', 'e') ##- HasArc('G', 'a') ##- HasEdge('G', 'e') ##- HasEdge('G', 'a') ## ##PARAMETERS ##- 'G' : graph ##- 'e' : edge - a set of two vertices in 'G' ##- 'a' : arc (directed edge) - a list of two vertices in 'G' ## ##DESCRIPTION ##- If 'e' = {u,v} then `HasEdge`('G','e') returns true if the undirected graph 'G' ## contains the (undirected) edge {u,v}, and false otherwise. ## ##- If 'a' = [u,v], a directed edge, `HasEdge`('G','a') returns true if the undirected ## graph 'G' has the undirected edge {u,v} in it. ## ##- If 'a' = [u,v], `HasArc`('G','a') returns true if the directed graph 'G' has ## the directed edge from vertex 'u' to 'v' in it, and false otherwise. ## ##- If _e = {u,v}, `HasArc`('G','a') outputs true if the directed graph 'G' has ## both edges [u,v] and [v,u] in it, and false otherwise. ## ##- Because the data structure for a graph is an array of sets of ## neighbors, the test for edge membership uses binary search and ## hence the cost is O(log k) where k is the number of neighbors. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2},{2,3},{3,4},{4,1}}); ##> HasEdge(G,{1,2}); ##< true ##> HasEdge(G,[2,1]); ##< true ##> HasEdge(G,{1,3}); ##< false ##> N := Graph({[1,2],[2,3],[3,4],[4,1]}); ##> HasArc(N,[1,2]); ##< true ##> HasArc(N,[2,1]); ##< false ##> HasEdge(G,[1,3]); ##< false ## ##SEEALSO ##- "AddArc" ##- "AddEdge" ##- "DeleteArc" ##- "DeleteEdge" ##- "HighlightEdges" ##- "Graph" ## ##XREFMAP ##- "AddArc" : Help:GraphTheory[AddArc] ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "DeleteArc" : Help:GraphTheory[DeleteArc] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "HighlightEdges" : Help:GraphTheory[HighlightEdges] ##- "Graph" : Help:GraphTheory[Graph] HasArc := proc(G::GRAPHLN, e::{ARCTYPE,UNDTYPE}) local D, W, V, A, T, M, L, i, j; D, W, V, A, T, M := getops(G); if D=undirected then error "Graph is undirected: please use HasEdge(...)."; fi; L := GraphInfo:-LabelToInteger(G); if nops(e) <> 2 then error "invalid edge %1", e fi; i,j := L[e[1]],L[e[2]]; if not type([i,j], [integer,integer]) then error "invalid arc %1", e; fi; if type(e,set) then member(i,A[j]) and member(j,A[i]) else member(j,A[i]) fi; end: HasEdge := proc(G::GRAPHLN, e::{UNDTYPE,ARCTYPE}) local D, W, V, A, T, M, L, i, j; D, W, V, A, T, M := getops(G); if D=directed then error "Graph is directed: please use HasArc(...)."; fi; L := GraphInfo:-LabelToInteger(G); if nops(e) <> 2 then error "invalid edge %1", e fi; i,j := L[e[1]],L[e[2]]; if not type([i,j], [integer,integer]) then error "invalid edge %1", e; fi; member(j,A[i]); end: ########################################### ##PROCEDURE(doti) Contract ##ALIAS GraphTheory[Contract] ##CALLINGSEQ ##- Contract('G', 'e', 'mul') ## ##PARAMETERS ##- 'G' : graph ##- 'e' : edge of the graph ##- 'mul' : equation of the form `multi`=`true` or `false` (optional) ## ##DESCRIPTION ##- `Contract` will contract the specified edge of a graph. ## By default, all the loops and mutiple edges are removed. ## By setting `multi`=`true` the loops and multiple edges will be preserved ## and the output is a weighted graph. ## ##- To contract multiple edges in a graph, use the "foldl" command. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CompleteGraph(4): ##> Contract(G, {1,3}); ##<(verification="GraphEqual") Graph([1, 2, 4], {{1, 2}, {1, 4}, {2, 4}}) ##> Contract(G, {1,3}, multi=true); ##<(verification="GraphEqual") Graph([1, 2, 4], {[{1, 2}, 2], [{1, 4}, 2], [{2, 4}, 1]}) ##> P := SpecialGraphs:-PetersenGraph(); ##> DrawGraph(P); ## ##- Contract the five edges connecting the inner star to the outer pentagon to show K5. ## ##> G := foldl(Contract, P, {1,6}, {2,9}, {3,7}, {4,10}, {5,8}); ##> NumberOfVertices(G); ##< 5 ##> IsClique(G); ##< true ## ##SEEALSO ##- "DeleteEdge" ##- "DeleteVertex" ##- "foldl" ## ##XREFMAP ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "DeleteVertex" : Help:GraphTheory[DeleteVertex] #---------ver. 23, modified by MG Contract := proc(G::GRAPHLN, e::EDGETYPE, mp::{identical(multi), identical(multi)=truefalse}) local p, D, W, V, A, T, EW, L, k, E, n, i, j, S, s, Vnew, B, M, newG, vp, newvp, att, Eorig, Enew; if not (e in Edges(G)) then error "2nd argument expected to be an edge of the graph";end if; p := false; #indicating that the output is a simple graph if nargs = 3 then if type(mp, equation) then p := op(2,mp) else p := true end if; end if; D, W, V, A, T, EW := getops(G); n := nops(V); L := GraphInfo:-LabelToInteger(G); if W=unweighted then E := e else E := e[1] end if; if L[E[1]] < L[E[2]] then i,j := L[E[1]],L[E[2]]; if E[2] < E[1] then V := subsop(i=E[2], V); fi; else i,j := L[E[2]],L[E[1]]; if E[1] < E[2] then V := subsop(i=E[1], V); fi; fi; S := A[j]; #Vnew := subsop(i={E[1],E[2]}, j=NULL, V); Vnew := subsop(j=NULL, V); B := copy(A); B[i] := (B[i] union B[j]) minus {i,j}; for k to n do if j in A[k] and k<>i then B[k] := subs(j=i, B[k]) end if;end do; B := Array([ seq( `if`( k=j, NULL, B[k]), k=1..n ) ]); B := subs(seq(k=k-1,k=j+1..n),B); M := 0; if p or (W=weighted) then M := `if`(W=unweighted, copy(AdjacencyMatrix(G)), copy(EW)); for s in S do if s<>i then M[i,s] := M[i,s]+M[j,s]; if D=directed or W=weighted then M[s,i] := M[s,i]+M[s,j];end if; end if; end do; if p then M[i,i] := `if`(D=directed, M[i,i]+M[j,j]+M[i,j]+M[j,i]-1, M[i,i]+M[j,j]+M[i,j]-1); end if; M := LinearAlgebra:-DeleteRow(M,j); M := LinearAlgebra:-DeleteColumn(M,j); end if; newG := `if`(p, GRAPHLN(D, weighted, Vnew, B, GRAPH_TABLE_NAME(), M), GRAPHLN(D, W, Vnew, B, GRAPH_TABLE_NAME(), M)); #---attribs Eorig := op(GraphInfo:-Edges(G) minus {{i,j}}); Enew := op( map( e -> map(x->`if`(x>j, x-1, `if`(x=j,i,x)), e), [Eorig] ) ); att := map(x->map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), x), GraphInfo:-GetAttrib(G, [op(subsop(j=NULL, [$1..n])), Eorig])); GraphInfo:-SetAttrib(newG, [$1..n-1, Enew], att); #---drawing vp := GraphInfo:-GetVPos(G, VP_FIXED); if nops(vp)<>0 then newvp := [seq(vp[aux], aux=1..i-1), evalf((vp[i]+vp[j])/2), seq(vp[aux], aux=i+1..j-1), seq(vp[aux], aux=j+1..n)]; GraphInfo:-SetVPos(newG, VP_FIXED, newvp); fi; return newG; end; ############################################## ##PROCEDURE(doti) CompleteGraph ##ALIAS GraphTheory[CompleteGraph] ##CALLINGSEQ ##- CompleteGraph('n') ##- CompleteGraph('V') ##- CompleteGraph('n', 'm') ##- CompleteGraph('n1', 'n2',..., 'nk') ## ##PARAMETERS ##- 'n', 'm' : positive integers ##- 'n1',...,'nk' : positive integers ##- 'V' : list of integers, strings or symbols (vertex labels) ## ##DESCRIPTION ##- `CompleteGraph`('n') returns the complete graph on 'n' vertices. ## `CompleteGraph`('V') does the same thing except the vertices are labelled using the entries of 'V'. ## ##- `CompleteGraph`('n', 'm') returns the complete bipartite graph with ## bipartitions of size 'n' and 'm'. ## ##- `CompleteGraph`('n1',...,'nk') returns the complete multipartite graph ## with partitions of size 'n1',..., 'nk'. ## ##EXAMPLES ##> with(GraphTheory): ##> K4 := CompleteGraph(4); ### Graph 1: an undirected unweighted graph with 4 vertices and 6 edge(s) ##> Edges(K4); ##< {{2, 3}, {1, 2}, {1, 3}, {1, 4}, {2, 4}, {3, 4}} ##> DrawGraph(K4); ##> K23 := CompleteGraph(2,3); ##> Edges(K23); ##< {{2, 3}, {1, 3}, {1, 4}, {2, 4}, {1, 5}, {2, 5}} ##> DrawGraph(K23,style=bipartite); ## ##SEEALSO ##- "DrawGraph" ##- "Edges" ##- "IsBipartite" ##- "Graph" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "IsBipartite" : Help:GraphTheory[IsBipartite] ##- "Graph" : Help:GraphTheory[Graph] #---------ver. 23, modified by MG CompleteGraph := proc(V::{nonnegint, list(VERTEXTYPE)}) local i, j, k, G, n, ARGS, a, b; if nargs=1 then G := GraphComplement(Graph(V)); n := `if`(type(V,integer), V, nops(V)); if n=0 then elif n = 1 then GraphInfo:-SetVPos(G, VP_FIXED, [[0,0]]); elif n = 2 then GraphInfo:-SetVPos(G, VP_FIXED, [[0,0],[1,0]]); elif n=4 then GraphInfo:-SetVPos(G, VP_FIXED, [[0,0], op(GraphInfo:-GetVPos(CycleGraph(3), VP_FIXED))]); else GraphInfo:-SetVPos(G, VP_FIXED, GraphInfo:-GetVPos(CycleGraph(n), VP_FIXED)); fi; else for k to nargs do if not(type(args[k], nonnegint)) then error"the arguments expected to be of type nonnegint, but received %1",args[k]; end if; end do; ARGS := [seq(`if`(args[j]=0, NULL, args[j]), j=1..nargs)]; if max(op(ARGS))=1 then G := CompleteGraph(nops(ARGS)); else G := GraphInfo:-StandardGraph( GraphComplement( DisjointUnion ( seq( CompleteGraph(k), k=ARGS ) ) ) ); if nops(ARGS)=2 then a,b := ARGS[1], ARGS[2]; if a=1 then if b>=3 then GraphInfo:-SetVPos(G, VP_FIXED, [[0,0], op(GraphInfo:-GetVPos(CycleGraph(b), VP_FIXED))]); elif b=1 then GraphInfo:-SetVPos(G, VP_FIXED, [[0,0], [1,0]]); else GraphInfo:-SetVPos(G, VP_FIXED, [[0,0], [-1,0], [1,0]]); fi; elif b=1 then if a>=3 then GraphInfo:-SetVPos(G, VP_FIXED, [op(GraphInfo:-GetVPos(CycleGraph(a), VP_FIXED)), [0,0]]); elif a=1 then GraphInfo:-SetVPos(G, VP_FIXED, [[1,0], [0,0]]); else GraphInfo:-SetVPos(G, VP_FIXED, [[-1,0], [1,0], [0,0]]); fi; elif a=2 then GraphInfo:-SetVPos(G, VP_FIXED, [[-1,0], [1,0], seq([0,1-2*i/(b-1)], i=0..b-1)]); elif b=2 then GraphInfo:-SetVPos(G, VP_FIXED, [seq([0,1-2*i/(a-1)], i=0..a-1), [-1,0], [1,0]]); fi; fi; fi; end if: G; end; ############################################## ##PROCEDURE(doti) CycleGraph ##TITLE CycleGraph ##TITLE PathGraph ##ALIAS GraphTheory[CycleGraph], GraphTheory[PathGraph] ##CALLINGSEQ ##- CycleGraph('n') ##- CycleGraph('V') ##- PathGraph('n') ##- PathGraph('V') ## ##PARAMETERS ##- 'n' : positive integer ##- 'V' : list of vertices ## ##DESCRIPTION ##- `CycleGraph`('n') outputs a graph which is a cycle on 'n' vertices ## labelled 1, 2, ..., 'n'. ## ##- `PathGraph`('n') outputs a graph which is a path on 'n' vertices, ## labelled 1, 2, ..., 'n'. ## ##- In both cases one my may input the labels for the vertices ## as a list of integers, strings or symbols. ## ##EXAMPLES ##> with(GraphTheory): ##> C := CycleGraph(4); ##> Edges(C); ##< {{1,2}, {2, 3}, {3,4}, {1, 4}} ##> DrawGraph(C); ##> P := PathGraph([a,b,c,d]); ##> Edges(P); ##< {{a, b}, {b, c}, {c, d}} ##> DrawGraph(P); ## ##SEEALSO ##- "DrawGraph" ##- "Edges" ##- "Graph" ##- "PathGraph" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "Graph" : Help:GraphTheory[Graph] ##- "PathGraph" : Help:GraphTheory[PathGraph] #---------ver. 23, modified by MG CycleGraph := proc(N::{posint,list(VERTEXTYPE)}) local i, n, G; n := `if`(type(N, integer), N, nops(N)); if n < 3 then error "1st argument is expected to be an integer > 2 or a list of size > 2"; fi; G := Graph('Trail'($1..n,1)); if type(N, list) then G := RelabelVertices(G, N); fi; if irem(n,2)=1 then GraphInfo:-SetVPos(G, VP_FIXED, evalf[8]( [seq([evalhf(cos(Pi*(.5-2*(i-1)/n))), evalhf(sin(Pi*(.5-2*(i-1)/n)))], i=1..n)] ) ); else GraphInfo:-SetVPos(G, VP_FIXED, evalf[8]( [seq([evalhf(cos(Pi*(.5-1/n-2*(i-1)/n))), evalhf(sin(Pi*(.5-1/n-2*(i-1)/n)))], i=1..n)] ) ); fi; G; end; PathGraph := proc(N::{posint,list(VERTEXTYPE)}) local i, n, G; if type(N,integer) then n := N else n := nops(N) fi; if type(N,list) and nops({op(N)}) <> n then error "repeated vertices are not allowed." fi; if n<2 then return Graph(N) fi; G := Graph( undirected, unweighted, [$1..n], Array([{2},seq({i-1,i+1},i=2..n-1),{n-1}]) ); if type(N,list) then G := RelabelVertices(G,N); fi; GraphInfo:-SetVPos(G, VP_FIXED, [seq([i/(n-1),0], i=0..n-1)]); G; end; ############################################# ##PROCEDURE(doti) DeleteArc ##ALIAS GraphTheory[DeleteArc] ##CALLINGSEQ ##- DeleteArc('G', 'E', 'ip') ## ##PARAMETERS ##- 'G' : directed graph ##- 'E' : arc or set of arcs ##- 'ip' : equation of the form `inplace`=`true` or `false` (optional) ## ##DESCRIPTION ##- `DeleteArc` will delete arc(s) from a directed graph. By default, the original ## digraph will be changed to a digraph missing the specified set of arc(s). ## By setting `inplace`=`false` the original digraph remains unchanged and ## a new digraph missing the specified set of arc(s) will be created. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Digraph([a, b, c, d], {[a, b], [b, c], [c, d], [d, a]}); ##> H := DeleteArc(G,[d,a],inplace=false); ##> Edges(G); ##< {[a, b], [b, c], [c, d], [d, a]} ##> Edges(H); ##< {[a, b], [b, c], [c, d]} ##> DeleteArc(G, {[a,b],[c,d]}); ##> Edges(G); ##< {[b, c], [d, a]} ## ##SEEALSO ##- "AddArc" ##- "DeleteEdge" ##- "Edges" ##- "HasArc" ##- "Digraph" ## ##XREFMAP ##- "AddArc" : Help:GraphTheory[AddArc] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "Edges" : Help:GraphTheory[Edges] ##- "HasArc" : Help:GraphTheory[HasArc] ##- "Digraph" : Help:GraphTheory[Digraph] #---------ver. 23, modified by MG DeleteArc := proc(G::GRAPHLN, Ed::{list, set(list)}, inp::INPLACETYPE) local E, ip, e, i, j, w, L, D, W, V, A, T, EW, B, EWb; E := `if`(type(Ed, EDGETYPE), {Ed}, Ed); ip := true; #indicating that the output overwrites the input graph if nargs = 3 then if type(inp, equation) then ip := op(2,inp) else ip := true end if; end if; D, W, V, A, T, EW := getops(G); if D=undirected then error "to delete edges of a graph use `DeleteEdge'."; end if; if W=weighted then E := map(e->`if`(type(e, list(VERTEXTYPE)), [e,1], e), E); fi; L := GraphInfo:-LabelToInteger(G); B := `if`(ip, A, copy(A)); if W=unweighted then for e in E do if not type(e, list(VERTEXTYPE)) or nops(e)<>2 then error "invalid arc %1", e; fi; i, j := L[e[1]], L[e[2]]; if not type([i,j], [integer$2]) then error "invalid arc %1", e; fi; if not member(j, A[i]) then WARNING("%1 is not an arc of the digraph. Nothing to do!",e); fi; od; for e in E do i, j := L[e[1]], L[e[2]]; B[i] := B[i] minus { j }; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EW)); elif W=weighted then EWb := `if`(ip, EW, copy(EW)); for e in E do if not type(e, [list(VERTEXTYPE), numeric]) or nops(e[1])<>2 then error "invalid arc %1", e; fi; i, j := L[e[1,1]], L[e[1,2]]; if not type([i,j], [numeric$2]) then error "invalid arc %1", e; fi; if not member(j, A[i]) then WARNING("%1 is not an arc of the digraph. Nothing to do!",e); fi; od; for e in E do i, j := L[e[1,1]], L[e[1,2]]; w := e[2]; if member(j, A[i]) then if EWb[i,j] - w <> 0 then EWb[i,j] := EWb[i,j] - w; else B[i] := B[i] minus { j }; EWb[i,j] := 0; end if; fi; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EWb)); end if; end; ########################################### ##PROCEDURE(doti) DeleteEdge ##ALIAS GraphTheory[DeleteEdge] ##CALLINGSEQ ##- DeleteEdge('G', 'E', 'ip') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'E' : edge or set of edges ##- 'ip' : equation of the form `inplace`=`true` or `false` (optional) ## ##DESCRIPTION ##- `DeleteEdge` will delete edge(s) from an undirected graph. By default, the original ## graph will be changed to a graph missing the specified set of edge(s). ## By setting `inplace`=`false` the original graph remains unchanged and a new ## graph missing the specified set of edge(s) will be created. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(4); ##> H := DeleteEdge(G, {1,2}, inplace=false); ##> Edges(G); ##< {{2, 3}, {3, 4}, {1, 2}, {1, 4}} ##> Edges(H); ##< {{2, 3}, {3, 4}, {1, 4}} ##> DeleteEdge(G, {{1,2}, {3,4}}); ##> Edges(G); ##< {{2, 3}, {1, 4}} ## ##SEEALSO ##- "AddEdge" ##- "CycleGraph" ##- "DeleteArc" ##- "Edges" ##- "HasEdge" ##- "Graph" ## ##XREFMAP ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "CycleGraph" : Help:GraphTheory[CycleGraph] ##- "DeleteArc" : Help:GraphTheory[DeleteArc] ##- "Edges" : Help:GraphTheory[Edges] ##- "HasEdge" : Help:GraphTheory[HasEdge] ##- "Graph" : Help:GraphTheory[Graph] #---------ver. 23, modified by MG DeleteEdge := proc(G::GRAPHLN, Ed::{EDGETYPE, set(EDGETYPE)}, inp::INPLACETYPE) local E, ip, e, i, j, w, L, D, W, V, A, T, EW, B, EWb; E := `if`(type(Ed, EDGETYPE), {Ed}, Ed); ip := true; #indicating that the output overwrites the input graph if nargs = 3 then if type(inp, equation) then ip := op(2,inp) else ip := true end if; end if; D, W, V, A, T, EW := getops(G); if D=directed then error "to delete arcs of a digraph use `DeleteArc'."; end if; if W=weighted then E := map(e->`if`(type(e, set(VERTEXTYPE)), [e,1], e), E); fi; L := GraphInfo:-LabelToInteger(G); B := `if`(ip, A, copy(A)); if W=unweighted then for e in E do if not type(e, set(VERTEXTYPE)) or nops(e)<>2 then error "invalid edge %1", e; fi; i, j := L[e[1]], L[e[2]]; if not type([i,j], [integer$2]) then error "invalid edge %1", e; fi; if not member(j, A[i]) then WARNING("%1 is not an edge of the graph. Nothing to do!",e); fi; od; for e in E do i, j := L[e[1]], L[e[2]]; B[i] := B[i] minus { j }; B[j] := B[j] minus { i }; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EW)); elif W=weighted then EWb := `if`(ip, EW, copy(EW)); for e in E do if not type(e, [set(VERTEXTYPE), numeric]) or nops(e[1])<>2 then error "invalid edge %1", e; fi; i, j := L[e[1,1]], L[e[1,2]]; if not type([i,j], [numeric$2]) then error "invalid edge %1", e; fi; if not member(j, A[i]) then WARNING("%1 is not an edge of the graph. Nothing to do!",e); fi; od; for e in E do i, j := L[e[1,1]], L[e[1,2]]; w := e[2]; if member(j, A[i]) then if EWb[i,j] - w <> 0 then EWb[i,j] := EWb[i,j] - w; EWb[j,i] := EWb[j,i] - w; else B[i] := B[i] minus { j }; B[j] := B[j] minus { i }; EWb[i,j] := 0; EWb[j,i] := 0; end if; fi; end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EWb)); end if; end; ########################################### ##PROCEDURE(doti) DeleteVertex ##ALIAS GraphTheory[DeleteVertex] ##CALLINGSEQ ##- DeleteVertex('G', 'V') ## ##PARAMETERS ##- 'G' : graph ##- 'V' : vertex or a list or set of vertices ## ##DESCRIPTION ##- `DeleteVertex` returns a copy of the graph 'G' with the specified ## vertex or list of vertices deleted. The graph 'G' is not changed. ## The resulting graph is the subgraph of 'G' induced by the remaining vertices. ## Any edges adjacent to 'V' are removed. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(5): ##> H := DeleteVertex(G, [1,4]); ##<(verification="GraphEqual") Graph([2,3,5], {{2, 3}}) ##> Edges(H); ##< {{2, 3}} ##> J := InducedSubgraph(G, {2,3,5}); ##> Edges(J); ##< {{2, 3}} ##> DeleteVertex(G, 6); ##<(verification="testerror") DeleteVertex, "2nd argument expected to be a vertex or a list of vertices of the graph." ## ##SEEALSO ##- "CycleGraph" ##- "Edges" ##- "Graph" ##- "InducedSubgraph" ## ##XREFMAP ##- "CycleGraph" : Help:GraphTheory[CycleGraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "Graph" : Help:GraphTheory[Graph] ##- "InducedSubgraph" : Help:GraphTheory[InducedSubgraph] #---------ver. 23, modified by MG DeleteVertex := proc (G::GRAPHLN, VSet::{VERTEXTYPE,list(VERTEXTYPE)}) local V, S; S := `if`(type(VSet, VERTEXTYPE), {VSet}, {op(VSet)}); V := vlist(G); if not (S subset {op(V)}) then error "2nd argument expected to be a vertex or a list of vertices of the graph." else InducedSubgraph(G, [seq(`if`(member(v,S), NULL, v), v=V)]); fi; end proc: ########################################### ##PROCEDURE(doti) Digraph ##ALIAS GraphTheory[Digraph] ##CALLINGSEQ ##- Digraph('V', 'E', 'A', 'W') ## ##PARAMETERS ##- 'V' : list of vertices or number of vertices ##- 'E' : set or list of arcs ##- 'A' : adjacency matrix (edge weights) ##- 'W' : one of `weighted` or `unweighted`, or an equation `weighted`=`true` or `false` (optional) ## ##DESCRIPTION ##- `Digraph` will create a digraph with given parameters. ## The input parameters could appear in any order, however they should be compatible. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Digraph({[1,2],[2,3],[3,4],[4,1]}); ##> DrawGraph(G); ##> DrawGraph(G,style=circle); ##> IsDirected(G); ##< true ##> IsStronglyConnected(G); ##< true ##> V := [a,b,c,d]: ##> E := {[[a,b],1.0],[[a,c],2.3],[[b,d],3.1], [[c,d],4]}: ##> G := Digraph(V, E); ##> DrawGraph(G); ##> IsStronglyConnected(G); ##< false ##> IsNetwork(G); ##< {a}, {d} ##> DrawNetwork(G); ##> Edges(G); ##< {[a,b], [a,c], [b,d], [c,d]} ##> WeightMatrix(G); ##<(verification="LinearAlgebra:-Equal") Matrix([[0, 1.0, 2.3, 0], [0, 0, 0, 3.1], [0, 0, 0, 4], [0, 0, 0, 0]]) ## ##SEEALSO ##- "Edges" ##- "DrawGraph" ##- "DrawNetwork" ##- "Graph" ##- "Vertices" ##- "RandomGraphs[RandomDigraph]" ## ##XREFMAP ##- "Edges" : Help:GraphTheory[Edges] ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "DrawNetwork" : Help:GraphTheory[DrawNetwork] ##- "Graph" : Help:GraphTheory[Graph] ##- "Vertices" : Help:GraphTheory[Vertices] #---------ver. 23, modified by MG Digraph := proc() local j, D; D := true; for j to nargs do if type(args[j], symbol) and args[j]=undirected then D := false elif type(args[j], equation) and op(1,args[j])=directed and type(op(2,args[j]), boolean) and not op(2,args[j]) then D := false; end if; end do; if D then Graph(directed, args) else error "To define an undirected graph, use Graph(...)" fi; end proc: ########################################### ##PROCEDURE(doti) Graph ##ALIAS GraphTheory[Graph] ##CALLINGSEQ ##- Graph('V') ##- Graph('n') ##- Graph('V', 'E') ##- Graph('T') ##- Graph('A') ##- Graph('V', 'E', 'A') ##- Graph('D', 'W', 'V', 'E', 'A') ##- Graph('N') ## ##PARAMETERS ##- 'V' : (optional) list of vertices (integers, symbols, or strings) ##- 'n' : (optional) positive integer specifying the vertices 1,2,...,'n' ##- 'E' : (optional) set of edges ##- 'T' : (optional) function or the form `Trail`(a,b,c,,...) or `Trail`([a,b,c,...]) ##- 'A' : (optional) adjacency matrix (of edge weights) ##- 'N' : (optional) procedure (a networks graph) ##- 'D' : (optional) symbol, one of directed or undirected ##- 'W' : (optional) symbol, one of weighted or unweighted ## ##RETURNS ##- The Graph command creates a graph from the given parameters. ## ##DESCRIPTION(spec) ##- The type of each input determines what it is. Because of this the ## inputs can appear in any order. ## ##- A symbol can be one of directed, undirected, weighted, or unweighted. ## This specifies the type of the graph. If not specified, a default ## is chosen depending on the type of the other inputs. ## ##- An integer 'n' specifies the number of vertices and implicitly the ## vertex labels 1 through 'n'. ## ##- A list specifies the vertices. ## Each vertex must be an integer, symbol or string. ## ##- A set specifies the set of edges. ## An undirected edge between vertices ~i~ and ~j~ is input as a set of two ## vertices _{i,j}_. A directed edge from vertex ~a~ to vertex ~b~ is input ## as a list _[a,b]_. A weighted edge is input as either _[e,w]_ where ~e~ is ## an edge (directed or undirected) and ~w~, the edge weight, is a number ## (integer or decimal). ## ##- A function of the form ~Trail(a,b,c,...)~ or ~Trail([a,b,c,...])~ specifies ## a trail of edges from ~a~ to ~b~ to ~c~ .... By default the edges are ## undirected. If the symbol directed is specified as an option then they ## are directed. More than one trail may be specified. This is often ## the easiest way to enter a graph interactively. ## ##- A matrix means the adjacency matrix. A symmetric matrix is interpreted ## as an undirected graph unless the edge direction is stated otherwise. ## Likewise, a matrix of 0's and 1's is interpreted as an unweighted ## graph unless specified otherwise. ## ##- A procedure means a networks graph. This option allows conversion ## from a networks graph representation to the GraphTheory representation. ## Note, the GraphTheory package does not support multigraphs. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph(5); ### G := Graph 1: An undirected unweighted graph with 5 vertices and 0 edge(s) ##> Vertices(G); ##< [1, 2, 3, 4, 5] ##> Edges(G); ##< {} ##> G := Graph({{a,b},{b,c},{c,a}}); # an undirected cycle ### G := Graph 2: An undirected unweighted graph with 3 vertices and 3 edge(s) ##> Vertices(G); ##< [a, b, c] ##> Edges(G); ##< {{a,b}, {b,c}, {a,c}} ##> DrawGraph(G); ## ##> G := Graph({[1,2],[2,3],[3,1]}); # a directed cycle ### G := Graph 3: a directed unweighted graph with 3 vertices and 3 arc(s) ##> Edges(G); ##< {[1, 2], [2, 3], [3, 1]} ##> V := [a,b,c,d]: ##> E := {[[a,b],2],[[b,c],2.3],[[c,a],3/2]}: ##> G := Graph(V,E); ### G := Graph 4: a directed weighted graph with 4 vertices and 3 arc(s) ##> WeightMatrix(G); ##<(verification="LinearAlgebra:-Equal") Matrix([[0, 2, 0, 0], [0, 0, 2.3, 0], [3/2, 0, 0, 0], [0, 0, 0, 0]]) ##> G := Graph( Trail(1,2,3,4,1,3) ); ### G := Graph 5: an undirected unweighted graph with 4 vertices and 5 edge(s) ##> Edges(G); ##< {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {3, 4}} ##> G := Graph( directed, Trail(1,2,3,1), Trail(4,5,6,4) ); ### G := Graph 6: a directed unweighted graph with 6 vertices and 6 arc(s) ##> Edges(G); ##< {[1, 2], [3, 1], [5, 6], [6, 4], [4, 5], [2, 3]} ## ##> A1 := Matrix([[0, 1, 1, 0], [1, 0, 0, 1], [1, 0, 0, 0], [0, 1, 0, 0]]): ##> G := Graph(A1); ### G := An undirected and unweighted graph with 4 vertices and 3 edge(s) ##> Edges(G); ##< {{1,2}, {1,3}, {2,4}} ##> G := Graph(directed, A1, weighted); ### G := A directed and weighted graph with 4 vertices and 6 arc(s) ##> Edges(G,weights); ##< {[[1,2], 1], [[1,3], 1], [[2,1], 1], [[2,4], 1], [[3,1], 1], [[4,2], 1]} ##> A2 := Matrix([[0,1.0,2.3,0], [4,0,0,3.1], [0,0,0,0], [0,0,0,0]]): ##> G := Graph(A2); ### G := A directed and weighted graph with 4 vertices and 4 arc(s) ##> Edges(G,weights); ##< {[[1,2], 1.0], [[1,3], 2.3], [[2,1], 4], [[2,4], 3.1]} ## ##> with(networks); ##> new(N): ##> addvertex({1,2,a,b},N); ##> addedge({1,2},N); ##> addedge([a,b],N); ##> addedge([b,a],N); ##> G := Graph(N); # convert the networks graph N to a GraphTheory graph. ### G := Graph 2: a directed unweighted graph with 4 vertices and 4 arc(s) ##> Edges(G); ##< {[b, a], [1, 2], [a, b], [2, 1]} ##> addedge([1,a],weights=2,N); ##> addedge([2,b],weights=3,N); ##> G := Graph(N); ### G := Graph 3: a directed weighted graph with 4 vertices and 5 arc(s) ##> Edges(G,weights); ##< {[[2, b], 3], [[1, a], 2], [[a, b], 1], [[1, 2], 1], [[b, a], 1]} ## ##SEEALSO ##- "Digraph" ##- "DrawGraph" ##- "Edges" ##- "RandomGraphs" ##- "SpecialGraphs" ##- "Vertices" ##- "networks" ## ##XREFMAP ##- "Digraph" : Help:GraphTheory[Digraph] ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "Vertices" : Help:GraphTheory[Vertices] ##- "RandomGraphs" : Help:GraphTheory[RandomGraphs] ##- "SpecialGraphs" : Help:GraphTheory[SpecialGraphs] #---------ver. 23, modified by Mike, MG #---------ver. 24, graph6 format code moved MBM #---------ver. 25, allow Trail([a,b,c]) MBM Graph := proc() local n, vertices, edges, trails, isdirected, isweighted, EW, i, j, e, T, vIdx, a, b, A, B, L, m, isSymmetric, edgeOK, N, inp, extract, ptr, LN, lnissymmetric, obj, EE, tmp, ARGdir, ARGwt, ARGn, ARGvlist, ARGedges, ARGmatrix, ARGlistn, isundirected, EWedges; # special case: convert a network to a graph if nargs=1 and type(args[1],procedure) then N := args[1]; if member('GRAPH',[op(3,eval(N))]) then return Network2Graph(N); else error "input procedure must be a networks package graph"; fi; fi; ARGdir, ARGwt, ARGn, ARGvlist, ARGedges, ARGmatrix, ARGlistn := false$7; n := NULL; vertices := NULL; edges := []; trails := []; isdirected := NULL; isweighted := NULL; EW := NULL; LN := NULL; #collecting the arguments for j to nargs do if type(args[j], nonnegint) then if n = NULL then n := args[j]; ARGn := true; else error "Number of vertices may be entered only once."; fi; elif type(args[j], list(VERTEXTYPE)) then if nops(args[j]) <> nops({op(args[j])}) then error "Vertices must have distinct labels." fi; if vertices = NULL then vertices := args[j]; ARGvlist := true; else error "List of vertices may be entered only once." fi elif type(args[j], set(EDGETYPE)) then edges := [op(edges), op(args[j])]; ARGedges := true; elif type(args[j], specfunc(VERTEXTYPE,'Trail')) then # Trail(1,2,3) trails := [op(trails), args[j]]; ARGedges := true; elif type(args[j], 'Trail'(list(VERTEXTYPE))) then # Trail([1,2,3]) trails := [op(trails), 'Trail'(op(op(args[j])))]; ARGedges := true; elif type(args[j], set(function)) and map(x->op(0,x), args[j]) = {'Trail'} then trails := [op(trails), op(args[j])]; ARGedges := true; elif type(args[j], symbol) then if args[j] = 'directed' then if isdirected = NULL then isdirected := true elif not isdirected then error"Inconsistent argument %1",args[j]; fi; ARGdir := true; elif args[j] = 'undirected' then if isdirected = NULL then isdirected := false elif isdirected then error"Inconsistent argument %1",args[j]; fi; ARGdir := true; elif args[j] = 'weighted' then if isweighted = NULL then isweighted := true elif not isweighted then error"Inconsistent argument %1",args[j]; fi; ARGwt := true; elif args[j] = 'unweighted' then if isweighted = NULL then isweighted := false elif isweighted then error"Inconsistent argument %1",args[j]; fi; ARGwt := true; fi elif type(args[j], equation) and op(1, args[j]) in {'directed', 'weighted'} and type(op(2, args[j]), boolean) then if op(1, args[j]) = 'directed' then if isdirected = NULL then isdirected := op(2, args[j]) elif op(2, args[j]) xor isdirected then error"Inconsistent argument %1",args[j]; fi; ARGdir := true; else if isweighted = NULL then isweighted := op(2, args[j]) elif op(2, args[j]) xor isweighted then error"Inconsistent argument %1",args[j]; fi; ARGwt := true; fi elif type(args[j], 'Array') then if LN = NULL then LN := args[j]; ARGlistn := true; else error "list of neighbors can be entered only once." fi; if not type(LN,'Array'(set(integer))) then error "list of neighbors must be an array of sets of integers." fi; elif type(args[j], list(list)) and nops(args[j])>0 then if LN = NULL then LN := Array(map(convert,args[j],set)); ARGlistn := true; else error "list of neighbors can be entered only once." fi; elif type(args[j], list(set)) and nops(args[j])>0 then if LN = NULL then LN := Array(args[j]); ARGlistn := true; else error "list of neighbors can be entered only once." fi; elif type(args[j], 'Matrix'(square)) then if EW = NULL then EW := args[j]; ARGmatrix := true; else error "You may enter the adjacency/weights matrix only once."; fi else error "Invalid argument: %1", args[j]; fi od; #checking the arguments if ARGedges and ARGmatrix and not ARGvlist then error "you need to specify the list of vertices in order to assign weights to the edges."; fi; #vertices: if not ARGvlist then if ARGn then vertices := [$1..n]; elif ARGedges then vertices := convert(`union`(op(map(e->`if`(type(e[1], VERTEXTYPE), {op(e)}, {op(e[1])}), edges)), op(map(convert, trails, set))), list); elif ARGlistn then vertices := [$op(2, LN)]; elif ARGmatrix then vertices := [$1..op([1,1],EW)]; else vertices := []; fi; fi; if not ARGn then n := nops(vertices); fi; if nops(vertices) <> n then error "List of vertices has an invalid size." fi; #list of neighbours if ARGlistn then if ARGedges then error "Edges or Trails can not be specified when list of neighbors is provided."; fi; for i to n do for j in LN[i] do if j<1 or j>n then error "invalid vertex %1 in list of neighbors.", j; fi; od; od; lnissymmetric := true; for i to n while lnissymmetric do for j in LN[i] do if not member(i,LN[j]) then lnissymmetric := false; fi; od od; if isdirected = NULL then isdirected := not lnissymmetric; elif not (isdirected or lnissymmetric) then error"list of neighbors is not symmetric."; fi; fi; #edges/arcs vIdx := table(); for j to n do vIdx[vertices[j]] := j; od; if ARGedges then for e in edges do edgeOK := true; if nops({op(e)}) <> 2 then edgeOK := false; elif not type({op(e)}, set(VERTEXTYPE)) then if not type({op(e[1])}, set(VERTEXTYPE)) or nops({op(e[1])}) <> 2 then edgeOK := false; elif not type(e[2], {numeric,symbol}) then edgeOK := false; fi; fi; if not edgeOK then error "Invalid edge/arc: %1", e; fi; if isdirected = NULL and type(e, list) and type(e[1], {VERTEXTYPE,list}) then isdirected := true; fi; if type(e[1], {set,list}) then if ARGmatrix then error "weighted edges are not allowed when a weight matrix is given."; fi; if isweighted = NULL then isweighted := true; fi; if not isweighted then error "edge/arc %1 is inconsistent with other arguments.",e; fi; fi; od; fi; #matrix if ARGmatrix then if op([1,1], EW) <> n or op([1,1], EW) <> nops(vertices) then error "adjacency/weights matrix is inconsistent with vertices." fi; #EWentries := {seq(seq(EW[ii,jj], jj=1..n), ii=1..n)}; if map(rhs, op(2, EW)) <> {1} then # not subset {0,1} if isweighted = NULL then isweighted := true; else if not isweighted then error "adjacency matrix of an unweighted graph must have 0,1 entries only."; fi; end if; else if isweighted = NULL then isweighted := false; end if; end if; isSymmetric := true; if op([3,4,2],EW) <> [symmetric] then i := 1; while isSymmetric and i <= n do for j from i+1 to n do if EW[i,j] <> EW[j,i] then isSymmetric := false; end if; end do; i := i+1; end do; end if; if isSymmetric then if isdirected = NULL then isdirected := false; fi; else if isdirected = NULL then isdirected := true; else if isdirected = false then error "The adjacency matrix of an undirected graph must be symmetric"; fi; fi; end if; else if isdirected = NULL then isdirected := false; fi; if isweighted = NULL then isweighted := false; fi; fi; #constructing the neighborhood lists if ARGlistn then A := LN; else A := Array(1..n); # MBM: B := Array(1..n); is too small, e.g., Trail(1,2,3,2,1,2,3,2,1); # MBM: To save space I'm reusing the vIdx table below. # MBM: This should be here so Graph(4,weighted); works! # MBM: It creates a graph on 4 vertices with no edges. if isweighted and not ARGmatrix then EW := Matrix(n,n,storage=sparse, shape=`if`(isdirected, [], symmetric)); fi; if ARGedges then for e in edges do if type(e[1], VERTEXTYPE) then a, b := vIdx[e[1]], vIdx[e[2]]; if not type([a,b], [integer, integer]) then error "Invalid edge/arc: %1",e; fi; A[a] := [A[a], b]; if isweighted and not ARGmatrix then EW[a,b] := 1; fi; if type(e, set) or (type(e, list) and not isdirected) then A[b] := [A[b], a]; if isweighted and not ARGmatrix then EW[b,a] := 1; fi; fi; else a, b := vIdx[e[1][1]], vIdx[e[1][2]]; if not type([a,b], [integer, integer]) then error "Invalid edge/arc: %1",e; fi; A[a] := [A[a], b]; EW[a,b] := e[2]; if type(e, set) or (type(e, list) and not isdirected) then A[b] := [A[b], a]; EW[b,a] := e[2]; fi; fi; od; for T in trails do L := [seq( vIdx[a], a=T )]; if not type(L, list(integer)) then error "Invalid trail: %1",T; fi; for i from 2 to nops(L) do a, b := L[i-1], L[i]; A[a] := [A[a], b]; if isweighted and not ARGmatrix then EW[a,b] := 1; fi; if not isdirected then A[b] := [A[b], a]; if isweighted and not ARGmatrix then EW[b,a] := 1; fi; fi; od od; B := eval(vIdx); # MBM: use the vIdx table to save space for i to n do L,m := A[i],0; while L <> 0 do m := m+1; B[m] := L[2]; L := L[1] od; A[i] := {seq( B[j],j=1..m )}; od; elif EW <> NULL then # for i to n do # A[i] := {seq( `if`(EW[i,jj] <> 0 and jj <> i, jj, NULL), jj=1..n )}; # end do; isundirected := not isdirected; EWedges := `if`(isundirected, map(x->{lhs(x)}, op(2, EW)), map(x->[lhs(x)], op(2, EW)) ); for e in EWedges do a,b := op(e); A[a] := [A[a], b]; if isundirected then A[b] := [A[b], a]; fi; od; B := eval(vIdx); # MBM: use the vIdx table to save space for i to n do L,m := A[i],0; while L <> 0 do m := m+1; B[m] := L[2]; L := L[1] od; A[i] := {seq( B[j],j=1..m )}; od; fi; A := subs(0={}, A); fi; #print(n, vertices, edges, trails); if isdirected=NULL then isdirected := false; fi; if isweighted=NULL then isweighted := false; fi; if ARGedges and ARGmatrix then EE := `if`(isdirected, map(x->[lhs(x)], op(2,W)), map(x->{lhs(x)}, op(2,W))); # printf("\n\n%a\n\n", A); if not EE subset Edges(Graph(A)) then error "weight matrix is not consistent with edges." fi; fi; GRAPHLN(`if`(isdirected, directed, undirected), `if`(isweighted, weighted, unweighted), vertices, A, GRAPH_TABLE_NAME(), `if`(isweighted, EW, 0)); end proc: ########################################### ##PROCEDURE(doti) Subdivide ##ALIAS GraphTheory[Subdivide] ##CALLINGSEQ ##- Subdivide('G', 'E', 'r') ## ##PARAMETERS ##- 'G' : graph ##- 'E' : edge or arc or set (or list) of edges or arcs of the graph ##- 'r' : positive integer ## ##DESCRIPTION ##- `Subdivide` will subdivide the specified edge(s) or arc(s) of a (di)graph, by ## putting 'r' new vertices on each specified edge or arc. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CompleteGraph(2, 3); ##> Edges(G); ##< {{2, 3}, {1, 3}, {1, 4}, {1, 5}, {2, 4}, {2, 5}} ##> SG := Subdivide(G, {{1,5}, {2,4}}); ##> Edges(SG); ### {{2, 3}, {1, 3}, {1, 4}, {2, 5}, {1, 7}, {2, 6}, {4, 6}, {5, 7}} ##> DG := Digraph([a,b,c],{[a,b],[a,c]}); ##> Edges(DG); ##< {[a, b], [a, c]} ##> SDG := Subdivide(DG, [a,b], 2); ##> Edges(SDG); ##< {[1, 2], [a, c], [a, 1], [2, b]} ## ##SEEALSO ##- "Digraph" ##- "Edges" ##- "Graph" ## ##XREFMAP ##- "Digraph" : Help:GraphTheory[Digraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "Graph" : Help:GraphTheory[Graph] #---------ver. 23, modified by MG Subdivide := proc (G::GRAPHLN, Edg::{EDGETYPE, set(EDGETYPE), list(EDGETYPE)}, NumSubs::posint ) local i,j, n, m, L, M, k, B, E, Vnew, D, W, V, A, T, EW, st, newG, vp, newvp, v, nSubs, t, EG, att, e, vrtx, Eseq; D, W, V, A, T, EW := getops(G); n := nops(V); E := `if`( type(Edg,EDGETYPE), [Edg], [op(Edg)]); EG := Edges(G); if W=weighted then EG := EG union map(e->e[1], EG); fi; for e in E do if not member(e, EG) then error "expecting edge(s) or arc(s) of the (di)graph but received %1",e; fi od; E := map(x->`if`(type(x[1],VERTEXTYPE), x, x[1]), E); nSubs := `if`(nargs=3, NumSubs, 1); L := GraphInfo:-LabelToInteger(G); m := nops(E); st:=1; for v in V do if type(v,integer) then if v >= st then st:=v+1 end if: end if: end do: Vnew := [op(V),seq(st+aux, aux=0..nSubs*m-1)]; B := Array(1..n+m*nSubs,A); if W=unweighted and D=undirected then M := 0; for k to m do i, j := L[E[k][1]], L[E[k][2]]; vrtx := Array(0..nSubs+1, [i, $n+(k-1)*nSubs+1..n+k*nSubs,j]); B[i] := (B[i] minus {j}) union {vrtx[1]}; B[j] := (B[j] minus {i}) union {vrtx[nSubs]}; for t to nSubs do B[vrtx[t]] := {vrtx[t-1], vrtx[t+1]}; od; end do; elif W=unweighted and D=directed then M := 0; for k to m do i, j := L[E[k][1]], L[E[k][2]]; vrtx := Array(0..nSubs+1, [i, $n+(k-1)*nSubs+1..n+k*nSubs,j]); B[i] := (B[i] minus {j}) union {vrtx[1]}; for t to nSubs do B[vrtx[t]] := {vrtx[t+1]}; od; end do; elif W=weighted and D=undirected then M := Matrix(n+m*nSubs,EW,shape=symmetric); for k to m do i, j := L[E[k][1]], L[E[k][2]]; vrtx := Array(0..nSubs+1, [i, $n+(k-1)*nSubs+1..n+k*nSubs,j]); B[i] := (B[i] minus {j}) union {vrtx[1]}; B[j] := (B[j] minus {i}) union {vrtx[nSubs]}; M[i,j] := 0; M[i,vrtx[1]] := EW[i,j]; for t to nSubs do B[vrtx[t]] := {vrtx[t-1], vrtx[t+1]}; M[vrtx[t],vrtx[t-1]] := EW[i,j]; M[vrtx[t],vrtx[t+1]] := EW[i,j]; od; end do; else M := Matrix(n+m*nSubs,n+m*nSubs,EW); for k to m do i, j := L[E[k][1]], L[E[k][2]]; vrtx := Array(0..nSubs+1, [i, $n+(k-1)*nSubs+1..n+k*nSubs,j]); B[i] := (B[i] minus {j}) union {vrtx[1]}; M[i,j] := 0; M[i,vrtx[1]] := EW[i,j]; for t to nSubs do B[vrtx[t]] := {vrtx[t+1]}; M[vrtx[t],vrtx[t+1]] := EW[i,j]; od; end do; end if; newG := GRAPHLN(D, W, Vnew, B, GRAPH_TABLE_NAME(), M); #---attribs Eseq := op( GraphInfo:-Edges(G) intersect GraphInfo:-Edges(newG) ); att := map(x->map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), x), GraphInfo:-GetAttrib(G, [$1..n, Eseq])); GraphInfo:-SetAttrib(newG, [$1..n, Eseq], att); #---Drawing vp := GraphInfo:-GetVPos(G, VP_FIXED); if nops(vp)<>0 then newvp := Array(1..n+m*nSubs, vp); for i from 0 to m-1 do for t to nSubs do newvp[n+i*nSubs+t] := evalf(((nSubs+1-t)*vp[L[E[i+1][1]]] + t*vp[L[E[i+1][2]]])/(nSubs+1)); od od; GraphInfo:-SetVPos(newG, VP_FIXED, [seq(newvp[i], i=1..n+m*nSubs)]); fi; return newG; end proc: ########################################### ##PROCEDURE(doti) SeidelSwitch ##ALIAS GraphTheory[SeidelSwitch] ##CALLINGSEQ ##- SeidelSwitch('G', 'S', 'ip') ## ##PARAMETERS ##- 'G' : undirected and unweighted graph ##- 'S' : list of vertices of the graph ##- 'ip' : equation of the form `inplace`=`true` or `false` (optional) ## ##DESCRIPTION ##- `SeidelSwitch` will transform the input graph to a new graph in such a way that ## for each specified vertex, its neighbours become its non-neighbours and vice versa. ## By default, the original graph is changed and the switching happens in place. ## By setting `inplace`=`false` the original graph remains unchanged. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(5): ##> DrawGraph(G); ##> Neighbors(G, 1); ##< [2, 5] ##> H := SeidelSwitch(G, [1,2], inplace=false); ##> Neighbors(H, 1); ##< [2, 3, 4] ## ##- Vertices 1 and 2 remain neighbors of each other ## ##> DrawGraph(H); ##> Edges(H); ##< {{4, 5}, {3, 4}, {2, 4}, {1, 3}, {1, 2}, {1, 4}, {2, 5}} ##> SeidelSwitch(G, [1,2]); ##> Edges(G); ##< {{4, 5}, {3, 4}, {2, 4}, {1, 3}, {1, 2}, {1, 4}, {2, 5}} ## ##SEEALSO ##- "Neighbors" ## ##XREFMAP ##- "Neighbors" : Help:GraphTheory[Neighbors] #---------ver. 23, modified by MG SeidelSwitch := proc(G::GRAPHLN, VS::list(VERTEXTYPE)) local S, ip, i, n, N, k, L, D, W, V, A, T, EW, B; if not( {op(VS)} subset {op(vlist(G))} ) then error "2nd argument expected to be a set of vertices of the graph" end if; ip := true; #indicating that the output overwrites the input graph if nargs = 3 then ip := args[3]; if not (type(ip,equation) or op(1,ip) = inplace) then error "3rd argument (optional) expected to be of the form inplace=true/false"; end if; ip := op(2,ip); end if; D, W, V, A, T, EW := getops(G); n := nops(V); if D=directed then error"expected the 1st argument to be an undirected graph, but received a directed graph"; end if; if W=weighted then error"expected the 1st argument to be an unweighted graph, but received a weighted graph"; end if; L := GraphInfo:-LabelToInteger(G); S := map( v -> L[v], convert(VS, set)); B := `if`(ip, A, copy(A)); N := {seqint(n)}; for i in S do B[i] := N minus ( (B[i] union S) minus (B[i] intersect S) ) end do; for k in N minus S do B[k] := (B[k] union S) minus (B[k] intersect S) end do; `if`(ip, G, GRAPHLN(D, W, V, B, COPY_TABLE(T), EW)); end; ############################### ##################################################################################### ##################################################################################### ##### EXPORTS###################################################################### ##################################################################################### ##################################################################################### ##PROCEDURE(doti) AdjacencyMatrix ##ALIAS GraphTheory[AdjacencyMatrix] ##CALLINGSEQ ##- AdjacencyMatrix('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `AdjacencyMatrix` returns the adjacency matrix of a graph 'G' ## whose rows and columns are indexed by the vertices. ## The entry _(i,j)_ of this matrix is 1 if there is an edge ## from vertex ~i~ to vertex ~j~ and 0 otherwise. ## ##- The default output is an n by n Maple Matrix with the following properties: ## If 'G' is directed or undirected: ~datatype=anything~ and ~order=C_order~ ## If 'G' is undirected: ~shape=symmetric~, ~storage=triangular[upper]~, ## If 'G' is directed: ~storage=rectangular~, ~shape=[]~ ## If 'G' is sparse, i.e., ~|E| << |V|^2~ then ~storage=sparse~ will be used. ## ## The default choice ~datatype=anything~ means that you can assign the ## entries of the matrix to be any value. ## For a more compact output you may use ~datatype=integer[1]~ ## which means one byte will be used per matrix entry. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph( [1,2,3,4], Trail(1,2,3,4,1) ); ##> AdjacencyMatrix(G); ##<(verification="LinearAlgebra:-Equal") Matrix(4,4,{(1,2)=1, (2,3)=1, (3,4)=1, (1,4)=1}, shape=[symmetric], datatype=anything, storage=triangular[upper], order=C_order) ### [0 1 0 1] ### [1 0 1 0] ### [0 1 0 1] ### [1 0 1 0] ### ##> Neighbors(G); ##< [[2, 4], [1, 3], [2, 4], [1, 3]] ##> H := Digraph( [1,2,3,4], Trail(1,2,3,4,1) ); ##> AdjacencyMatrix(H); ##<(verification="LinearAlgebra:-Equal") Matrix(4,4,{(1,2)=1, (2,3)=1, (3,4)=1, (4,1)=1}, datatype=anything, storage=rectangular, order=C_order) ### [0 1 0 0] ### [0 0 1 0] ### [0 0 0 1] ### [1 0 0 0] ### ##> Departures(H); ##< [[2], [3], [4], [1]] ## ##SEEALSO ##- "Degree" ##- "Departures" ##- "Neighbors" ## ##XREFMAP ##- "Degree" : Help:GraphTheory[Degree] ##- "Departures" : Help:GraphTheory[Departures] ##- "Neighbors" : Help:GraphTheory[Neighbors] #---------ver. 23, modified by MG #---------ver. 24, modified by MBM AdjacencyMatrix := proc( G::GRAPHLN ) local A, N, i, j, n, m, sh, st, cf, dt; m := add( nops(n), n=listn(G) ); n := nops( vlist(G) ); if getdir(G)=undirected then sh := symmetric; else sh := NULL; fi; # A dense symmetric matrix requires n*(n+1)/2 + ~10 words of storage. # A sparse symmetric matrix (uses a Maple table) requires 2*m + ~2000 words of storage. if 2*m+2000 < n*(n+1)/2 + 10 then st := 'storage=sparse' elif getdir(G)=undirected then st := 'storage=triangular[upper]' else st := 'storage=rectangular' fi; dt := NULL; cf := order=C_order; for i from 2 to nargs do # allow user overrides if type(args[i],identical(storage)=anything) then st := args[i]; elif args[i]=(shape=[]) then sh := NULL; elif args[i]=(shape=symmetric) then sh := symmetric; elif type(args[i],identical(datatype)=anything) then dt := args[i]; elif type(args[i],identical(order)=anything) then cf := args[i]; else error "unrecognized option: %1", args[i]; fi; od; # MBM: Matrix(n,n,shape=symmetric,...); has too much overhead so use rtable. A := rtable( sh, 1..n, 1..n, st, dt, cf, 'subtype=Matrix' ); N := listn(G); for i to n do for j in N[i] do A[i,j] := 1 od od; A; end; ############################################ ##PROCEDURE(doti) AllPairsDistance ##ALIAS GraphTheory[AllPairsDistance] ##CALLINGSEQ ##- AllPairsDistance('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `AllPairsDistance` returns a square matrix ~A~ where _A[i,j]_ is the ## distance from vertex ~i~ to vertex ~j~ in the graph 'G', that is, the length ## of the shortest path from vetex ~i~ to vertex ~j~. If 'G' is not a weighted ## graph then edges have weight 1. And if there is no path then the ## distance is infinite and _A[i,j] = infinity_. ## ##- This procedure is an implementation of Floyd-Warshall's allpairs ## shortest path algorithm. The complexity is _O(n^3)_ where ~n~ is the ## number of vertices of 'G'. ## ##- To compute distances or shortest paths from a single vertex to every other vertex, ## use "DijkstrasAlgorithm" because it is more efficient. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph( [1,2,3,4,5], {{1,2},{1,3},{1,4},{1,5},{2,3},{3,4},{4,5},{5,2}} ); ### G is a pyramid ##> AllPairsDistance(G); ##<(verification="LinearAlgebra:-Equal") Matrix([[0,1,1,1,1],[1,0,1,2,1],[1,1,0,1,2],[1,2,1,0,1],[1,1,2,1,0]]) # # [0 1 1 1 1] # [1 0 1 2 1] # [1 1 0 1 2] # [1 2 1 0 1] # [1 1 2 1 0] # ##> Diameter(G); ##< 2 ##> H := Graph(directed, {seq([1,i],i=2..5)}, Trail(2,3,4,5,2)); # a pyramid ##> AllPairsDistance(H); ##<(verification="LinearAlgebra:-Equal") Matrix([[0,1,1,1,1],[infinity,0,1,2,3],[infinity,3,0,1,2],[infinity,2,3,0,1],[infinity,1,2,3,0]]) # # [ 0 1 1 1 1] # [infinity 0 1 2 3] # [infinity 3 0 1 2] # [infinity 2 3 0 1] # [infinity 1 2 3 0] # # ##> DrawGraph(H); ## ##SEEALSO ##- "Diameter" ##- "Distance" ##- "DijkstrasAlgorithm" ## ##XREFMAP ##- "Diameter" : Help:GraphTheory[Diameter] ##- "Distance" : Help:GraphTheory[Distance] ##- "DijkstrasAlgorithm" : Help:GraphTheory[DijkstrasAlgorithm] #---------ver. 23, modified by MG #---------ver. 24, modified by MBM AllPairsDistance := proc(G::GRAPHLN) local n, i, j, k, t, D,sh,A,E; n := nops(vlist(G)); A := listn(G); # D := copy(AdjacencyMatrix(G)); sh := `if`( getdir(G)=directed, [], symmetric ); E := eweight(G); if getwt(G)=weighted then D := Matrix(n,n,datatype=anything,shape=sh,storage=rectangular,fill=infinity) elif getdir(G)=directed then D := AdjacencyMatrix(G,datatype=anything,storage=rectangular) else D := AdjacencyMatrix(G,datatype=anything,storage=triangular[upper]); fi; if getdir(G)=directed then if getwt(G)<>weighted then for i to n do for j to n do if D[i,j] = 0 and i<>j then D[i,j]:=infinity; end if; end do; end do; else for i to n do D[i,i] := 0; for j in A[i] do D[i,j] := E[i,j] od od fi; for k to n do for i to n do for j to n do t := D[i,k]+D[k,j]; if tweighted then for i to n do for j from i+1 to n do if D[i,j] = 0 then D[i,j] := infinity; end if; end do; end do; else for i to n do D[i,i] := 0; for j in A[i] do if E[i,j]<0 then error "negative cycle detected" fi; D[i,j] := E[i,j] od od fi; for k to n do for i to n do for j from i to n do # SCL: going from i to n is necessary when negative weights # MBM: D[i,j] := min(D[i,j], D[i,k]+D[k,j]); is much slower # MBM: It goes external to treat an infinity t := D[i,k]+D[k,j]; if t with(GraphTheory): ##> G := Digraph( Trail(1,2,3,4,5,6,4,7,8,2) ); ##> DrawGraph(G); ##> Neighbors(G, 4); ##< [3, 5, 6, 7] ##> Arrivals(G, 4); ##< [3, 6] ##> Departures(G, 4); ##< [5, 7] ##> Neighbors(G); ##< [[2], [1, 3, 8], [2, 4], [3, 5, 6, 7], [4, 6], [4, 5], [4, 8], [2, 7]] ##> Arrivals(G); ##< [[], [1, 8], [2], [3, 6], [4], [5], [4], [7]] ##> Departures(G); ##< [[2], [3], [4], [5, 7], [6], [4], [8], [2]] ## ##SEEALSO ##- "AdjacencyMatrix" ##- "Degree" ##- "InDegree" ##- "OutDegree" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "Degree" : Help:GraphTheory[Degree] ##- "InDegree" : Help:GraphTheory[InDegree] ##- "OutDegree" : Help:GraphTheory[OutDegree] #---------ver. 23, modified by MG #---------ver. 24, recoded by MBM Arrivals := proc (G::GRAPHLN, v::VERTEXTYPE) local V, A, L, n, j; V, A := vlist(G), listn(G); n := nops(V); if nargs=1 then [ seq( map(k->V[k],[seq(`if`(member(j,A[i]), i, NULL),i=1..n)] ) ,j=1..n ) ] elif nargs=2 then L := GraphInfo:-LabelToInteger(G); j := L[v]; map(k->V[k],[seq(`if`(member(j,A[i]), i, NULL),i=1..n)] ) else error "two arguments required, but received %1",nargs; end if; end; ############################################ ##PROCEDURE(doti) IsTwoEdgeConnected ##TITLE IsTwoEdgeConnected ##TITLE TwoEdgeConnectedComponents ##ALIAS GraphTheory[IsTwoEdgeConnected], GraphTheory[TwoEdgeConnectedComponents] ##CALLINGSEQ ##- IsTwoEdgeConnected('G') ##- TwoEdgeConnectedComponents('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- A connected graph 'G' is 2-edge connected if removal of any edge from 'G' ## does not disconnect 'G'. The `IsTwoEdgeConnected` command returns `true` ## if 'G' is 2-edge connected and `false` otherwise. ## ##- `TwoEdgeConnectedComponents` returns the 2-edge connected components of ## a graph 'G'. The output is a list of lists of vertices of 'G', each ## being the list of vertices of a component. ## ##EXAMPLES ##> with(GraphTheory): ##> IsTwoEdgeConnected(CycleGraph(4)); ##< true ##> IsTwoEdgeConnected(PathGraph(4)); ##< false ##> G := Graph({{a,b},{b,c},{a,c},{d,e},{e,f},{d,f},{c,d},{a,h},{a,i},{h,i}}): ##> IsTwoEdgeConnected(G); ##< false ##> DrawGraph(G); ##> TwoEdgeConnectedComponents(G); ### [[b], [c], [e, d, f], [i, a, h]] ## ##TEST ## Try(100, {op(map(convert, TwoEdgeConnectedComponents(G), set))}, {{b}, {c}, {e, d, f}, {i, a, h}}); ## ##SEEALSO ##- "CycleGraph" ##- "IsConnected" ##- "IsBiconnected" ##- "BiconnectedComponents" ## ##XREFMAP ##- "CycleGraph" : Help:GraphTheory[CycleGraph] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "IsBiconnected" : Help:GraphTheory[IsBiconnected] ##- "BiconnectedComponents" : Help:GraphTheory[BiconnectedComponents] #---------ver. 23, modified by MG TwoEdgeConnectedComponents := proc(G::GRAPHLN) local BiCC, V, A, L, W, GW, AW, HW, CW, aw, i, j, a, C, intC, T, n, MARK, B; BiCC := {}; V, A := vlist(G), listn(G); n := nops(V); L := GraphInfo:-LabelToInteger(G); T := table(sparse): #T(S) = +1 if S is bicc, 0 otherwise MARK := Array(1..n,fill=false); for W in ConnectedComponents(G) do GW := InducedSubgraph(G, W); AW := ArticulationPoints(GW); a := map( v -> L[v], AW); HW := DeleteVertex(GW, AW); CW := ConnectedComponents(HW); for C in CW do #if nops(C)=1 then T[C] := 1; if nops(C) > 1 then intC := {seq(L[i], i=C)}; B := `union`( seq(A[i], i=intC)); T[B] := 1; for i in B do MARK[i] := true od; fi; end do; end do; # Pick up singleton BCs for i to n do if not MARK[i] then T[{i}] := 1 fi; od; BiCC := map(S->map(x->V[x], S), map(x->[op(op(x))], [indices(T)])); sort(BiCC); end; ############################################ ##PROCEDURE(doti) IsBiconnected ##TITLE IsBiconnected ##TITLE BiconnectedComponents ##TITLE Blocks ##ALIAS GraphTheory[IsBiconnected], GraphTheory[BiconnectedComponents], GraphTheory[Blocks] ##CALLINGSEQ ##- IsBiconnected('G') ##- BiconnectedComponents('G') ##- Blocks('G') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ## ##DESCRIPTION ##- A connected graph 'G' is bi-connected or 2-connected if removal of any ## vertex from 'G' does not disconnect 'G'. Bi-connected graphs are also called blocks. ## ##- `IsBiconnected` will return `true` if the input graph is a 2-connected graph. ## It will return `false` otherwise. ## ##- `Blocks` and `BiconnectedComponents` return a list the vertices of all ## blocks of the graph, namely maximal 2-connected subgraphs of 'G'. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph(Trail(1,2,3,4,2), Trail(4,5,6,7,5)); ##> DrawGraph(G); ##> IsBiconnected(G); ##< false ##> Blocks(G); ### [[1, 2], [4, 5], [2, 3, 4], [5, 6, 7]] ##> ArticulationPoints(G); ##< [2, 4, 5] ##> seq( IsBiconnected( InducedSubgraph(G,B) ), B=Blocks(G) ); ##< true, true, true, true ## ##TEST ## Try(100, {op(Blocks(G))}, {[1, 2], [4, 5], [2, 3, 4], [5, 6, 7]}); ## ##SEEALSO ##- "ArticulationPoints" ##- "IsConnected" ##- "IsTwoEdgeConnected" ## ##XREFMAP ##- "ArticulationPoints" : Help:GraphTheory[ArticulationPoints] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "IsTwoEdgeConnected" : Help:GraphTheory[IsTwoEdgeConnected] #---------ver. 23, modified by MG Blocks := proc(G::GRAPHLN) local BiCC, V, A, L, W, GW, AW, HW, CW, aw, i, j, a, C, intC, T, n, B; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; BiCC := {}; V, A := vlist(G), listn(G); n := nops(V); L := GraphInfo:-LabelToInteger(G); T := table(sparse): #T(S) = +1 if S is bicc, 0 otherwise for W in ConnectedComponents(G) do GW := InducedSubgraph(G, W); AW := ArticulationPoints(GW); a := map( v -> L[v], AW); HW := DeleteVertex(GW, AW); CW := ConnectedComponents(HW); for C in CW do intC := map(x->L[x], C); B := { seq(op(A[i]), i=intC), op(intC) }; T[[op(B)]] := 1; end do; end do; BiCC := map(S->map(x->V[x], S), map(x->op(x), [indices(T)])); BiCC := [op(BiCC), op( map(x->[op(x)], Edges(G) minus `union`(seq(Edges(InducedSubgraph(G, SS)), SS=BiCC))) )]; return sort(BiCC, proc(x,y) nops(x) with(GraphTheory): ##> P := Graph( {{1,2},{2,3}} ); # a path ##> CharacteristicPolynomial(P,x); ##< x^3-2*x ##> A := AdjacencyMatrix(P); ##> LinearAlgebra[CharacteristicPolynomial](A,x); ##< x^3-2*x ##> G := SpecialGraphs:-ShrikhandeGraph(): ##> Diameter(G); # lowerbound for number of distinct eigenvalues of G ##< 2 ##> f := CharacteristicPolynomial(G,x); ##< x^16-48*x^14-64*x^13+768*x^12+1536*x^11-5888*x^10-15360*x^9+23040*x^8+81920*x^7-36864*x^6-245760*x^5-32768*x^4+393216*x^3+196608*x^2-262144*x-196608 ##> eigvals := {solve(f)}; ##< {6, 2, 2, 2, 2, 2, 2, -2, -2, -2, -2, -2, -2, -2, -2, -2} ##> nops(eigvals); ##< 3 ## ##SEEALSO ##- "AdjacencyMatrix" ##- "GraphSpectrum" ##- "LinearAlgebra[CharacteristicPolynomial]" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "GraphSpectrum" : Help:GraphTheory[GraphSpectrum] #---------ver. 23, modified by MG CharacteristicPolynomial := proc(G::GRAPHLN, x::name) if nargs =2 then LinearAlgebra:-CharacteristicPolynomial(AdjacencyMatrix(G),x); else error"expecting 2 arguments" end if; end; # RP : help page merged with MaximumClique CliqueNumber := proc(G::GRAPHLN) global OptSize, OptClique, C, W, m; local V, A, n; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; OptSize := 0: if IsConnected(G) then nops(MaximumClique(G)) else m := 0; for W in ConnectedComponents(G) do m := max(m, CliqueNumber(InducedSubgraph(G,W)) ) end do; m; end if; end; # RP: removed # ############################################# # #PROCEDURE(doti) Join # #ALIAS GraphTheory[Join] # #CALLINGSEQ # #- Join('G', 'S1', 'S2') # # # #PARAMETERS # #- 'G' : graph or digraph # #- 'S1', 'S2' : disjoint lists of vertices of the graph # # # #DESCRIPTION # #- `Join` returns a (di)graph which is obtained from the original (di)graph by connecting # # all the vertices in 'S1' to all vertices in 'S2'. If the input is a digraph all of the new arcs # # will be oriented from 'S1' to 'S2'. # # # #EXAMPLES # #> with(GraphTheory): # #> G := Graph(5); # #> H := Join(G, [1,2], [3,4,5]); # #> Neighbors(H); # #< [[3, 4, 5], [3, 4, 5], [1, 2], [1, 2], [1, 2]]; # #> IsBipartite(H); # #> G := Digraph(5); # #> H := Join(G, [1,2], [3,4,5]); # #> Edges(H); # #< {[2, 4], [2, 3], [2, 5], [1, 4], [1, 5], [1, 3]}; # #> DrawGraph(H); #---------ver. 23, modified by MG # # RP: this command was removed # Join := proc(G::GRAPHLN, S1::list(VERTEXTYPE), S2::list(VERTEXTYPE)) # local D, W, V, A, T, EW, B, M, L, n, v,w; # D, W, V, A, T, EW := getops(G); # n := nops(V); # L := GraphInfo:-LabelToInteger(G); # if not({op(S1)} subset {op(V)} and {op(S2)} subset {op(V)}) then # error"2nd and 3rd argument must be a subset of vertices of the graph"; # end if; # if {op(S1)} intersect {op(S2)} <> {} then # error"2nd and 3rd argument must be disjoint subset of vertices of the graph"; # end if; # B := copy(A); # for v in S1 do B[L[v]] := A[L[v]] union map(k->L[k],{op(S2)}) end do; # if D=undirected then # for v in S2 do B[L[v]] := A[L[v]] union map(k->L[k],{op(S1)}) end do; # end if; # if W=unweighted then M := 0 # else M := copy(EW); # for v in S1 do # for w in S2 do # M[L[v],L[w]] := M[L[v],L[w]] + 1; # end do; # end do; # end if; # GRAPHLN( D, W, V, B, GRAPH_TABLE_NAME(), M ); # end; ############################################## ##PROCEDURE(doti) IsConnected ##TITLE IsConnected ##TITLE ConnectedComponents ##ALIAS GraphTheory[ConnectedComponents], GraphTheory[IsConnected] ##CALLINGSEQ ##- IsConnected('G') ##- ConnectedComponents('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- A graph 'G' is connected if for each pair of vertices ~u~ and ~v~ in 'G' ## there exists a path from ~u~ to ~v~ in 'G' (if 'G' is undirected), or in ## the underlying graph of 'G' (if 'G' is directed). ## ##- `IsConnected` returns `true` if the input graph is a connected graph or `false` otherwise. ## If 'G' is a directed graph then the directions of edges are ignored. ## Use the "IsStronglyConnected" command to test whether each pair of vertices ## is connected by a directed path. ## ##- `ConnectedComponents` returns the components of the graph as a list of lists ## of vertices. Each sublist is a list of vertices for a connected component. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(4); ##> IsConnected(G); ##< true ##> H := GraphComplement(G); ##> IsConnected(H); ##< false ##> ConnectedComponents(H); ##< [[1, 3], [2, 4]] ##> DrawGraph(H); ##> G := Graph( [1,2,3,4,5,6], {{1,2},{2,3},{4,5}} ); ##> IsConnected(G); ##< false ##> ConnectedComponents(G); ##< [[1, 2, 3], [4, 5], [6]] ##> G := SpecialGraphs:-OctahedronGraph(); ##> ConnectedComponents(G); ##< [[1, 3, 2, 4, 5, 6]] ##> H := GraphComplement(G); ##> IsConnected(H); ##< false ##> ConnectedComponents(H); ##< [[1, 2], [3, 4], [5, 6]] ##> DrawGraph(G); ##> DrawGraph(H); ## ##SEEALSO ##- "ArticulationPoints" ##- "GraphRank" ##- "IsBiconnected" ##- "IsTwoEdgeConnected" ##- "IsStronglyConnected" ##- "StronglyConnectedComponents" ##- "UnderlyingGraph" ## ##XREFMAP ##- "ArticulationPoints" : Help:GraphTheory[ArticulationPoints] ##- "GraphRank" : Help:GraphTheory[GraphRank] ##- "IsBiconnected" : Help:GraphTheory[IsBiconnected] ##- "IsTwoEdgeConnected" : Help:GraphTheory[IsTwoEdgeConnected] ##- "IsStronglyConnected" : Help:GraphTheory[IsStronglyConnected] ##- "StronglyConnectedComponents" : Help:GraphTheory[StronglyConnectedComponents] ##- "UnderlyingGraph" : Help:GraphTheory[UnderlyingGraph] #---------ver. 23, modified by MG ConnectedComponents := proc(G::GRAPHLN, r::VERTEXTYPE) local A, n, DFS, m, M, V, C, i, v, c, VL; # if getdir(G) = 'directed' then error "...." fi; # MBM: For directed graphs, the IsPlanar command needs this just to look at the structure # if getdir(G)='directed' or getwt(G)='weighted' then # error"1st argument is expected to be a simple graph. Use `underlyingGraph`"; # fi; VL := vlist(G); n,A := nops(VL), listn(UnderlyingGraph(G)); if nargs>1 then if not member(r,vlist(G),'v') then error "invalid root vertex %1", r; end if; end if; DFS := proc(u) local v; M[u] := 1; m := m+1; V[m] := u; for v in A[u] do if M[v]=0 then DFS(v) end if; end do; end; M := Array(1..n); # mark array V := Array(1..n); # record vertices in order of traversal for each component if nargs>1 then m := 0; DFS(v); return map( S -> map( k-> VL[k], S), [seq(V[i], i=1..m)]); end if; c,C := 0,table(); # for recording the connected components found for v from 1 to n do if M[v]=0 then m := 0; # count of the number of vertices in this connected component DFS(v); c := c+1; C[c] := [seq(V[i], i=1..m)]; end if; end do; map( S -> map( k-> VL[k], S), [seq(C[i], i=1..c)]); end: ############################################## ##PROCEDURE(doti) CopyGraph ##ALIAS GraphTheory[CopyGraph] ##CALLINGSEQ ##- CopyGraph('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `CopyGraph`('G') creates a copy of the graph 'G'. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(5); ##> H := CopyGraph(G); ##> AddEdge(H, {{1,3},{1,4}}); ##> Edges(G); ##> Edges(H); ##> [SetVertexAttribute(H, 2, tag="vertex")]; ##> GetVertexAttribute(H, 2, tag); ##< "vertex" ##> GetVertexAttribute(G, 2, tag); ##< FAIL ## ##SEEALSO ##- "AddEdge" ##- "Edges" ##- "Graph" ##- "GraphAttributes" ## ##XREFMAP ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "Edges" : Help:GraphTheory[Edge] ##- "Graph" : Help:GraphTheory[Graph] ##- "GraphAttributes" : Help:GraphTheory[GraphAttributes] #---------ver. 23, modified by MG #---------ver. 24, modified by MBM CopyGraph := proc(G::GRAPHLN) local D,W, V, A, T, EW; D, W, V, A, T, EW := getops(G); GRAPHLN(D, W, V, copy(A), COPY_TABLE(T), copy(EW)) end; ############################################## ##PROCEDURE(doti) CycleBasis ##ALIAS GraphTheory[CycleBasis], CyclomaticNumber ##CALLINGSEQ ##- CycleBasis('G') ## ##PARAMETERS ## 'G' : graph ## ##DESCRIPTION ##- `CycleBasis` returns a list of cycles in the graph, with each cycle ## represented as a list of vertices. These cycles form a basis for the ## cycle space of 'G', so that every other cycle in 'G' can be obtained ## from the cycle basis using only symmetric differences. ## ##- The number of elements in the cycle basis (i.e., the dimension of the ## cycle space) is called the cyclomatic number of 'G'. ## ##- The algorithm starts from a spanning tree of 'G' and computes fundamental ## cycles for each graph obtained by adding one of the remaining edges of 'G' ## to the spanning tree. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-OctahedronGraph(): ##> DrawGraph(G); ##> C := CycleBasis(G); ### [[1, 3, 2, 5], [1, 3, 6], [1, 4, 5], [1, 3, 5], [1, 3, 2, 6], [1, 4, 6], [1, 3, 2, 4]] ##> nops(C); # cyclomatic number ##< 7 ## ##TEST ## Try(100, {op(C)}, {[1, 3, 2, 5], [1, 3, 6], [1, 4, 5], [1, 3, 5], [1, 3, 2, 6], [1, 4, 6], [1, 3, 2, 4]}); ## ##SEEALSO ##- "FundamentalCycle" ##- "IsAcyclic" ##- "SpanningTree" ## ##XREFMAP ##- "FundamentalCycle" : Help:GraphTheory[FundamentalCycle] ##- "IsAcyclic" : Help:GraphTheory[IsAcyclic] ##- "SpanningTree" : Help:GraphTheory[SpanningTree] #---------ver. 23, modified by MG CycleBasis := proc(G::GRAPHLN) local T, EC, base, e, P, ell, a, j, dir, PP; if IsDirected(G) then error "input graph must be undirected"; fi; T := SpanningTree(G); EC := Edges(G) minus Edges(T); base := NULL; for e in EC do P := ShortestPath(T,e[1],e[2]); #AddEdge(P,{e}); ell := nops(P); a := 1; for j to ell do if P[j] < P[a] then a := j fi od; dir := `if`(P[(a mod ell)+1] < P[(a-2 mod ell)+1], 1, -1); PP := [seq(P[(a+i*dir-1 mod ell)+1], i=0..ell-1)]; PP := [op(PP)]; base := base , PP; end do; [base]; end; # RP: removed # ############################################# # #PROCEDURE(doti) Deck # #ALIAS GraphTheory[Deck] # #CALLINGSEQ # #- Deck('G') # # # #PARAMETERS # # 'G' : graph # # # #DESCRIPTION # #- `Deck` returns a list of ~n~ graphs where each graph is obtained by deleting one vertex of # # the n vertices of the graph. # # # #EXAMPLES # #> with(GraphTheory): # #> A := Matrix([[0,1,1,0], # #> [1,0,1,0], # #> [1,1,0,1], # #> [0,0,1,0]]): # #> G := Graph(A): # #> map(Vertices, Deck(G)); # #< [[2, 3, 4], [1, 3, 4], [1, 2, 4], [1, 2, 3]] # #> map(Edges, Deck(G)); # #< [{{2, 3}, {3, 4}}, {{3, 4}, {1, 3}}, {{1, 2}}, {{2, 3}, {1, 3}, {1, 2}}] #---------ver. 23, modified by MG # # RP: this command was removed # Deck := proc(G::GRAPHLN) # local V, n, deck, i; # V := vlist(G); # n := nops(V); # deck := [seq(0,i=1..n)]; # for i to n do deck[i] := DeleteVertex(G, V[i]) end do; # deck # end; ############################################## ##PROCEDURE(doti) Degree ##TITLE Degree ##TITLE InDegree ##TITLE OutDegree ##ALIAS GraphTheory[Degree], GraphTheory[InDegree], GraphTheory[OutDegree] ##CALLINGSEQ ##- Degree('G', 'v') ##- InDegree('H', 'v') ##- OutDegree('H', 'v') ## ##PARAMETERS ##- 'G' : directed or undirected graph ##- 'H' : directed graph ##- 'v' : vertex ## ##DESCRIPTION ##- `Degree` returns the number of edges of the graph 'G' which are incident to 'v'. ## The directions of the edges are ignored. ## ##- `InDegree` returns the number of arcs directed into 'v'. ## ##- `OutDegree` returns the number of arcs directed out of 'v'. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Digraph( Trail(1,2,3,4,2) ); ##> DrawGraph(G); ##> Degree(G, 2); ##< 3 ##> InDegree(G, 2); ##< 2 ##> OutDegree(G, 2); ##< 1 ## ##SEEALSO ##- "DegreeSequence" ##- "DrawGraph" ##- "IsRegular" ##- "MaximumDegree" ##- "MinimumDegree" ##- "UnderlyingGraph" ## ##XREFMAP ##- "DegreeSequence" : Help:GraphTheory[DegreeSequence] ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "IsRegular" : Help:GraphTheory[IsRegular] ##- "MinimumDegree" : Help:GraphTheory[MinimumDegree] ##- "MaximumDegree" : Help:GraphTheory[MaximumDegree] ##- "UnderlyingGraph" : Help:GraphTheory[UnderlyingGraph] #---------ver. 23, modified by MG Degree := proc(G::GRAPHLN,v::VERTEXTYPE) local A, L; if not v in vlist(G) then error "expected a vertex of the graph, but received %1", v;end if; A := listn(G); L := GraphInfo:-LabelToInteger(G); if getdir(G) = 'directed' then nops(A[L[v]]) + InDegree(G, v) else nops(A[L[v]]) end if; end; ############################################## ##PROCEDURE(doti) DegreeSequence ##ALIAS GraphTheory[DegreeSequence] ##CALLINGSEQ ##- DegreeSequence('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `DegreeSequence` returns a list of the degrees of the vertices of 'G'. ## For directed graphs, the directions of the edges are ignored. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph( Trail(1,2,3,4,2) ); ##> DegreeSequence(G); ##< [1, 3, 2, 2] ##> H := Graph( Trail(1,2,3,4,2), directed ); ##> DegreeSequence(H); ##< [1, 3, 2, 2] ##> DrawGraph(G); ## ##SEEALSO ##- "Degree" ##- "MinimumDegree" ##- "IsRegular" ## ##XREFMAP ##- "Degree" : Help:GraphTheory[Degree] ##- "MinimumDegree" : Help:GraphTheory[MinimumDegree] ##- "MaximumDegree" : Help:GraphTheory[MaximumDegree] ##- "IsRegular" : Help:GraphTheory[IsRegular] #---------ver. 23, modified by MG DegreeSequence := proc(G::GRAPHLN) local A, L, n; n := nops(vlist(G)); if getdir(G) = undirected then A := listn(G); [seq ( nops(A[i]), i=1..n )]; else A := AdjacencyMatrix(G); [seq(`+`(seq(A[i,j], j=1..n), seq(A[j,i], j=1..n)), i=1..n)]; fi; end; # RP: help page merged with Arrivals Departures := proc (G::GRAPHLN, v::VERTEXTYPE) local V, A, L, n; V, A := vlist(G), listn(G); if nargs=1 then n := nops(vlist(G)); [ seq( convert(map(k->V[k],A[i]), list) ,i=1..n ) ] elif nargs=2 then L := GraphInfo:-LabelToInteger(G); convert(map(k->V[k], A[L[v]]) , list); else error "1 or 2 arguments required, but received %1",nargs; end if; end; ############################################ ##PROCEDURE(doti) Diameter ##ALIAS GraphTheory[Diameter] ##CALLINGSEQ ##- Diameter('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `Diameter` returns the maximum distance among all pairs of vertices in the graph 'G'. ## If 'G' is disconnected then the output is infinity. ## ##- For weighted graphs the edge weights are used to denote the distance accrued ## while traveling along each edge. For unweighted graphs the length of each ## edge is assumed to be 1. ## ##- The strategy is to use the Floyd-Warshall all-pairs shortest path algorithm. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(): ##> Diameter(P); ##< 2 ##> C := CycleGraph(19): ##> Diameter(C); ##< 9 ##> G := Graph({[{1,2}, .2], [{2,3}, .3], [{3,4}, .4], [{4,1}, 1.1]}); ##> DrawGraph(G); ##> Diameter(G); ##< 0.9 ## ##- The distance between vertices 1 and 4 is maximal ## ##> DijkstrasAlgorithm(G, 1, 4); ##< [[1, 2, 3, 4], 0.9] ## ##SEEALSO ##- "AllPairsDistance" ##- "DijkstrasAlgorithm" ##- "Distance" ##- "ShortestPath" ## ##XREFMAP ##- "AllPairsDistance" : Help:GraphTheory[AllPairsDistance] ##- "DijkstrasAlgorithm" : Help:GraphTheory[DijkstrasAlgorithm] ##- "Distance" : Help:GraphTheory[Distance] ##- "ShortestPath" : Help:GraphTheory[ShortestPath] #---------ver. 23, modified by MG Diameter := proc(G::GRAPHLN) local n, i, j, D; n := NumberOfVertices(G); if not IsConnected(G) then return infinity; end if; D := AllPairsDistance(G); max(seq(seq(D[i,j],j=1..n),i=1..n)) end; ############################################## ##PROCEDURE(doti) Distance ##ALIAS GraphTheory[Distance] ##CALLINGSEQ ##- Distance('G', 's', 't') ## ##PARAMETERS ##- 'G' : graph ##- 's', 't' : vertices of the graph ## ##DESCRIPTION ##- `Distance` returns the number of edges in the shortest path from 's' to 't'. ## If no such a path exists, the output is infinity. The strategy is to use a ## breadth-first search (BFS). ## ##- For weighted graphs, the weights of edges are ignored. ## Use the "AllPairsDistance" or "DijkstrasAlgorithm" commands to ## compute weighted distances between vertices. ## ##- To find a path from 's' to 't' with minimum distance use the "ShortestPath" command. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(): ##> Distance(P, 1, 4); ##< 2 ##> ShortestPath(P, 1, 4); ##< [1, 5, 4] ##> DP := Graph( map(x->sort(convert(x,list)), Edges(P)) ); ##> Distance(DP, 1, 4); ##< 3 ##> ShortestPath(DP, 1, 4); ##< [1, 2, 3, 4] ## ##SEEALSO ##- "AllPairsDistance" ##- "Diameter" ##- "DijkstrasAlgorithm" ##- "ShortestPath" ## ##XREFMAP ##- "AllPairsDistance" : Help:GraphTheory[AllPairsDistance] ##- "Diameter" : Help:GraphTheory[Diameter] ##- "DijkstrasAlgorithm" : Help:GraphTheory[DijkstrasAlgorithm] ##- "ShortestPath" : Help:GraphTheory[ShortestPath] #---------ver. 23, modified by MG Distance := proc(G::GRAPHLN,s::VERTEXTYPE,t::VERTEXTYPE) local ENQUEUE, DEQUEUE, A, color, Q, d, P, L, i, j, k, l; global Qlength, tail, head; if not (s in vlist(G)) then error "expected a vertex of the graph, but received %1", s;end if; if not (t in vlist(G)) then error "expected a vertex of the graph, but received %1", t;end if; ENQUEUE := proc(Q::table,x::anything) Q[tail[Q]] := x; if tail[Q] = Qlength then tail[Q] := 1 else tail[Q] := tail[Q] + 1; end if; end: DEQUEUE := proc(Q::table) local x; x := Q[head[Q]]; if head[Q] = Qlength then head[Q] := 1 else head[Q] := head[Q] + 1; end if; x; end: A := listn(G); L := GraphInfo:-LabelToInteger(G); i := L[s]; j := L[t]; Qlength := nops(vlist(G)); for k to Qlength do if k<>i then color[k] := WHITE; d[k] := infinity; P[k] := NIL; end if; end do; color[i] := GRAY; d[i] := 0; P[i] := NIL; Q := table(); tail := 'tail'; head := 'head'; tail[Q] := 1; head[Q] := 1; ENQUEUE(Q,i); #while op([1,2],Q) <> [] do while tail[Q] <>head[Q] and color[j]=WHITE do k := DEQUEUE(Q); for l in A[k] do if color[l]=WHITE then color[l] := GRAY; d[l] := d[k] + 1; P[l] := k; ENQUEUE(Q,l); end if; end do; color[k] := BLACK; end do; d[j]; end; ############################################## ##PROCEDURE(doti) EdgeConnectivity ##TITLE EdgeConnectivity ##TITLE VertexConnectivity ##ALIAS GraphTheory[EdgeConnectivity], GraphTheory[VertexConnectivity] ##CALLINGSEQ ##- EdgeConnectivity('G') ##- VertexConnectivity('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `EdgeConnectivity` returns the edge connectivity of a graph, that is ## the minimum number of edges whose removal disconnects the graph. ## A set of such edges is called an edge-cut. You can use the "IsCutSet" ## command to test whether a set of edges is an edge-cut. ## ##- `VertexConnectivity` returns the vertex connectivity of a graph, that is ## the minimum number of vertices whose removal disconnects the graph. ## ##- By an elementary theorem of graph theory, the vertex connectivity of a graph ## is less than or equal to the edge connectivity, which is less than or equal ## to the minimum degree. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2},{1,3},{2,3},{1,4},{3,4},{4,5},{5,6},{4,6}}); ##> DrawGraph(G); ##> EdgeConnectivity(G); ##< 2 ##> VertexConnectivity(G); # vertex 4 ##< 1 ##> MinimumDegree(G); ##< 2 ##> with(SpecialGraphs): ##> P := PetersenGraph(); ##> VertexConnectivity(P); ##< 3 ##> EdgeConnectivity(P); ##< 3 ##> MinimumDegree(P); ##< 3 ## ##SEEALSO ##- "ArticulationPoints" ##- "DeleteEdge" ##- "DeleteVertex" ##- "IsConnected" ##- "IsCutSet" ##- "MinimumDegree" ## ##XREFMAP ##- "ArticulationPoints" : Help:GraphTheory[ArticulationPoints] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "DeleteVertex" : Help:GraphTheory[DeleteVertex] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "IsCutSet" : Help:GraphTheory[IsCutSet] ##- "MinimumDegree" : Help:GraphTheory[MinimumDegree] #---------ver. 23, modified by MG EdgeConnectivity := proc(G::GRAPHLN) local N, V, n, u, ec, i, F, L, A, Ar, a, ar, j; # RP: take underlying graph (like VertexConnectivity) # if getdir(G)='directed' or getwt(G)='weighted' then # error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; # fi; if getdir(G) = 'directed' then return VertexConnectivity(UnderlyingGraph(G)) end if; if getwt(G) = 'weighted' then return VertexConnectivity(GRAPHLN(undirected, unweighted, V, A, eval(T), 0)) end if; if not(IsConnected(G)) then return 0; end if; L, A := GraphInfo:-LabelToInteger(G), listn(G); Ar := ArticulationPoints(G); a := map( v -> L[v], Ar); ar := nops(Ar); for i to ar do for j from i+1 to ar do if member(a[i], A[a[j]]) then return 1 end if; end do; end do; N := MakeDirected(MakeWeighted(G)); V := vlist(G); n := nops(V); u := V[1]; ec := NumberOfEdges(G); for i from 2 to n do F := [MaxFlow(N, u, V[i])][1]; if F < ec then ec := F; end if; end do; ec end; ############################################# ##PROCEDURE(doti) FundamentalCycle ##ALIAS GraphTheory[FundamentalCycle] ##CALLINGSEQ ##- FundamentalCycle('G') ## ##PARAMETERS ##- 'G' : unicyclic graph ## ##DESCRIPTION ##- `FundamentalCycle` takes as input a graph 'G' with a unique cycle ## and outputs the unique cycle as a graph. If 'G' has more than one ## cycle an error is returned. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph( Trail(1,2,3,4,5,2,6) ); ##> C := FundamentalCycle(G); ##> Edges(C); ##< {{2, 3}, {3, 4}, {2, 5}, {4, 5}} ##> DeleteEdge(G, {2,3}); # deleting any edge from the cycle makes the graph a tree ##> IsTree(G); ##< true ## ##SEEALSO ##- "CycleBasis" ##- "DeleteEdge" ##- "IsTree" ## ##XREFMAP ##- "CycleBasis" : Help:GraphTheory[CycleBasis] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "IsTree" : Help:GraphTheory[IsTree] #---------ver. 23, modified by MG FundamentalCycle := proc(G::GRAPHLN) local A, H, V, N, zero, one, deg, x, y, i, j; deg := proc(i, A, N) select(proc(j) evalb(nops(A[j]) = i) end proc, N ); end proc; #vertices of degree i if getdir(G) = 'directed' then error"expected an undirected graph - use FundamentalCycle(Underlying(G))"; end if; V, A := vlist(G), copy(listn(G)); if nops(V) <> NumberOfEdges(G) then error "graph has more than one cycle"; fi; N := {seqint(nops(V))}; #H := G; zero := deg(0,A,N); if zero <> { } then V, A, N := Internal:-DelVerArr(N,A,zero), {seqint(nops(V))}; end if; one := deg(1,A,N); while one <> { } do for i in one do for j in A[i] do A := Internal:-DelEdg(A, {i,j}); end do; end do; V, A := Internal:-DelVerArr(N,A,one); N:= {seqint(nops(V))}; zero := deg(0,A,N); if zero <> { } then V, A := Internal:-DelVerArr(N,A,zero); N := {seqint(nops(V))}; end if; one := deg(1,A,N); end do; GRAPHLN(undirected, unweighted, V, A, GRAPH_TABLE_NAME(), 0 ); end; ############################################# ##PROCEDURE(doti) Girth ##ALIAS GraphTheory[Girth] ##CALLINGSEQ ##- Girth('G') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ## ##DESCRIPTION ##- `Girth` returns the length of the shortest cycle in a simple graph. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> G := HypercubeGraph(3); # the cube ##> Girth(G); ##< 4 ##> P := PetersenGraph(); ##> Girth(P); ##< 5 ## ##SEEALSO ##- "CycleBasis" ## ##XREFMAP ##- "CycleBasis" : Help:GraphTheory[CycleBasis] #---------ver. 23, modified by MG Girth := proc(G::GRAPHLN) local ENQUEUE, DEQUEUE, V, u, color, Q, v,n, A, Qlength, tail, head, s, d, P, girth; ENQUEUE := proc(Q::table,x::anything) Q[tail] := x; if tail = Qlength then tail := 1 else tail := tail + 1; end if; end: DEQUEUE := proc(Q::table) local x; x := Q[head]; if head = Qlength then head := 1 else head := head + 1; end if; x; end: n := nops(vlist(G)); if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; end if; if NumberOfEdges(G) > (n^2)/4 then return 3; end if; A := listn(G); V := { seqint(n) }; girth := infinity; Qlength := n; for s to n do color := Array(1..n); #WHITE = 0, GRAY=1, BLACK=2 d := Array(1..n, n+1); P := Array(1..n); color[s] := 1; d[s] := 0; Q := table(); tail := 1; head := 1; ENQUEUE(Q,s); while tail <> head do u := DEQUEUE(Q); for v in A[u] minus {P[u]} do if color[v]=0 then color[v] := 1; d[v] := d[u] + 1; P[v] := u; ENQUEUE(Q,v); elif color[v]=1 then girth := min( girth, d[u] + d[v] + 1); if girth = 3 then return 3; end if; end if; end do; color[u] := 2; end do; end do; girth; end; ############################################# ##PROCEDURE(doti) GraphComplement ##ALIAS GraphTheory[GraphComplement] ##CALLINGSEQ ##- GraphComplement('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `GraphComplement` returns the complement of a graph 'G', that is ## the graph with the same vertex set but whose edge (arc) set consists ## of the edges (arcs) not present in 'G'. ## ##EXAMPLES ##> with(GraphTheory): ##> C := CycleGraph(5); ##> G := GraphComplement(C); ##> Edges(C); ##< {{2, 3}, {3, 4}, {1, 2}, {1, 5}, {4, 5}} ##> Edges(G); ##< {{2, 4}, {3, 5}, {1, 4}, {2, 5}, {1, 3}} ##> DrawGraph(C); ##> DrawGraph(G); ## ##SEEALSO ##- "CycleGraph" ##- "Edges" ## ##XREFMAP ##- "CycleGraph" : Help:GraphTheory[CycleGraph] ##- "Edges" : Help:GraphTheory[Edges] #---------ver. 23, modified by MG GraphComplement := proc(G::GRAPHLN) local D, W, V, A, T, EW, n, i, M, B, C, vp, newG, v, att; D, W, V, A, T, EW := getops(G); #if D = directed then error "expecting an undirected graph, but received %1", G;end if; n := nops(V); B := Array(1..n); C := {$1..n}; for i to n do B[i] := C minus ({i} union A[i]); end do; if W=unweighted then M := 0 else M := Matrix(n,n,1) - LinearAlgebra:-IdentityMatrix(n) - EW end if; newG := GRAPHLN(D, W, V, B, GRAPH_TABLE_NAME(), M); #---attribs GraphInfo:-SetAttrib( newG, [$1..n], GraphInfo:-GetAttrib(G, [$1..n]) ); return newG; end; # RP: removed # ############################################# # #PROCEDURE(doti) GraphDifference # #ALIAS GraphTheory[GraphDifference] # #CALLINGSEQ # #- GraphDifference('G', 'H') # # # #PARAMETERS # #- 'G', 'H' : graphs # # # #DESCRIPTION # #- `GraphDifference` will return the graph whose adjacency matrix # # is the difference of the adjacency matrices of the given matrices. # # # #EXAMPLES # #> with(GraphTheory): # #> K5 := CompleteGraph(5); # #> C5 := CycleGraph(5); # #> G := GraphDifference(K5,C5); # #> Edges(G); # #< {{2, 5}, {1, 3}, {2, 4}, {3, 5}, {1, 4}} # #> DrawGraph(G); #---------ver. 23, modified by MG # # # RP: this command was removed # GraphDifference := proc(G::GRAPHLN, H::GRAPHLN) # local Adj, n, i, j; # if getdir(G) <> getdir(H) then error"sum of a directed graph and an undirected graph"; end if; # if getwt(G) <> getwt(H) then error"sum of a weighted graph and an unweighted graph"; end if; # if vlist(G) <> vlist(H) then error"all graphs must have the same set of vertices"; end if; # Adj := AdjacencyMatrix(G) - AdjacencyMatrix(H); # n := nops(vlist(G)); # for i to n do for j to n do # if Adj[i,j] < 0 then error"the 2nd graph must be a subgraph of the 1st graph"; end if; # end do; end do; # Graph(Adj) # end; ############################################## # RP: delete this when the real GraphEqual command is added # GraphEqual := proc(G1::GRAPHLN, G2::GRAPHLN) # evalb(getwt(G1)=getwt(G2) and Vertices(G1)=Vertices(G2) and Edges(G1)=Edges(G2)) # end proc: ############################################## ##PROCEDURE(doti) GraphEqual ##ALIAS GraphTheory[GraphEqual] ##CALLINGSEQ ##- GraphEqual('G', 'H') ## ##PARAMETERS ##- 'G', 'H' : graphs ## ##DESCRIPTION ##- `GraphEqual`('G','H') returns `true` if the two input graphs are equal. ## Here the graphs are equal if they are ## (i) both directed or both undirected, ## (ii) both weighted or both unweighted, ## (iii) have the same vertex labels and in the same order, ## (iv) have the same edges. ## Further, if the graphs are both weighted graphs, their edge weights ## must be equal and integer edge weights are considered different from ## floating point edge weights. ## ##- Thus ~G = Graph([1,2,3],{{1,2},{2,3}})~ is considered not equal to ## ~H = Graph([1,3,2],{{1,2},{2,3}})~ even though their edge sets are the same. ## If you want to test if the graphs are equal up to a permutation of the ## vertices then you may compare if their edge sets are equal. ## ##- A general test for graph isomorphism is being developed and will be ## added to a future version of the package. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph([1,2,3],{{1,2},{2,3}}); ##> H := Graph([1,2,3],{{1,2},{1,3}}); ##> Vertices(G), Edges(G); ##> Vertices(H), Edges(H); ##> GraphEqual(G,H); ##< false ##> H := Graph(Trail(1,2,3)); ##> Vertices(H), Edges(H); ##> GraphEqual(G,H); ##< true ##> G := Graph([a,b,c],{{a,b},{b,c}}); ##> H := PermuteVertices(G,[a,c,b]); ##> Vertices(G), Edges(G); ##> Vertices(H), Edges(H); ##> GraphEqual(G,H); ##< false ## ##SEEALSO ##- "Edges" ##- "Graph" ##- "Vertices" ## ##XREFMAP ##- "Edges" : Help:GraphTheory[Edges] ##- "Graph" : Help:GraphTheory[Graph] ##- "Vertices" : Help:GraphTheory[Vertices] GraphEqual := proc(G1::GRAPHLN, G2::GRAPHLN) local W; W := IsWeighted(G1); IsDirected(G1)=IsDirected(G2) and W=IsWeighted(G2) and Vertices(G1)=Vertices(G2) and Edges(G1,`if`(W,'weights',NULL))=Edges(G2,`if`(W,'weights',NULL)) end: ############################################## ##PROCEDURE(doti) GraphJoin ##ALIAS GraphTheory[GraphJoin] ##CALLINGSEQ ##- GraphJoin('G', 'H') ## ##PARAMETERS ##- 'G', 'H' : graphs ## ##DESCRIPTION ##- ~GraphJoin(G,H)~ will return the graph which is obtained by connecting ## all the vertices of 'G' to all vertices of 'H'. The vertex labels in ## the resulting graph are strings of the form "1:u" and "2:v" where ~u~ ## is a vertex in 'G' and ~v~ is a vertex in 'H'. ## ##EXAMPLES ##> with(GraphTheory): ##> G := GraphJoin(PathGraph(2), Graph(3)); ##> Vertices(G); ##< ["1:1", "1:2", "2:1", "2:2", "2:3"] ##> Edges(G); ##< {{"1:1", "1:2"}, {"1:1", "2:1"}, {"1:1", "2:2"}, {"1:2", "2:1"}, ## {"1:2", "2:2"}, {"1:1", "2:3"}, {"1:2", "2:3"}} ## ##SEEALSO ##- "CartesianProduct" ##- "DisjointUnion" ##- "GraphUnion" ## ##XREFMAP ##- "CartesianProduct" : Help:GraphTheory[CartesianProduct] ##- "DisjointUnion" : Help:GraphTheory[DisjointUnion] ##- "GraphUnion" : Help:GraphTheory[GraphUnion] #---------ver. 23, modified by MG GraphJoin := proc(G::GRAPHLN, H::GRAPHLN) local D1, W1, V1, A1, T1, EW1, D2, W2, V2, A2, T2, EW2, N1, N2, B, M, i, j, newG, E1, E2, att1, att2, VV1, VV2; D1, W1, V1, A1, T1, EW1 := getops(G); D2, W2, V2, A2, T2, EW2 := getops(H); N1, N2 := nops(V1), nops(V2); B, M := copy(A1), copy(EW1); if D1 <> D2 then error"join of a directed graph and an undirected graph"; end if; if W1 <> W2 then error"join of a weighted graph and an unweighted graph"; end if; #the following fails if the vertex labels of the second graph are not numeric #if nops({op(V1)} intersect {op(V2)}) > 0 then # V2 := map( x -> x + N1, V2 ); #end if; A2 := map( x -> map ( y->y+N1, x ), A2 ); if {op(V1)} intersect {op(V2)} = {} then VV1, VV2 := V1, v2 else VV1, VV2 := map(x->sprintf("1:%s", convert(x, string)), V1), map(x->sprintf("2:%s", convert(x, string)), V2); fi; #T := table([ op(op(op(T1))) , op(op(op(T2))) ]); B := map( x->x union {seq(i,i=N1+1..N1+N2)}, B); B := Array(1..N1+N2, B); M := Matrix( N1+N2, N1+N2, M); for i to N2 do for j to N2 do M[i+N1,j+N1] := EW2[i,j] end do;end do; if D1=undirected then for j from N1+1 to N1+N2 do B[j] := A2[j-N1] union {seq(i,i=1..N1)} end do; for i to N1 do for j to N2 do M[i,j+N1] := 1; M[j+N1, i] := 1 end do;end do; else for j from N1+1 to N1+N2 do B[j] := A2[j-N1] end do; for i to N1 do for j to N2 do M[i,j+N1] := 1 end do;end do; end if; newG := GRAPHLN( D1, W1, [op(VV1), op(VV2)], B, GRAPH_TABLE_NAME(), `if`(W1=weighted, M,0) ); #---attribs E1 := op( GraphInfo:-Edges(G) ); E2 := op( GraphInfo:-Edges(H) ); att1 := map(x->map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), x), GraphInfo:-GetAttrib(G, [$1..N1, E1])); att2 := map(x->map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), x), GraphInfo:-GetAttrib(H, [$1..N2, E2])); E2 := op( map( e -> map( x -> x+N1, e), [E2] ) ); GraphInfo:-SetAttrib(newG, [$1..N1, E1, $N1+1..N1+N2, E2], [op(att1), op(att2)]); newG; end; ############################################## ##PROCEDURE(doti) GraphPower ##ALIAS GraphTheory[GraphPower] ##CALLINGSEQ ##- GraphPower('G', 'k') ## ##PARAMETERS ##- 'G' : unweighted graph ##- 'k' : positive integer ## ##DESCRIPTION ##- `GraphPower` returns the 'k'-th power graph of a given graph which ## may be directed or undirected. ## In the 'k'-th power graph, two vertices are connected if there exists a ## path of length at most 'k' in the original graph. ## ##- The algorithm adds powers the adjacency matrix of 'G' and removes any multiple edges. ## ##EXAMPLES ##> with(GraphTheory): ##> P := PathGraph(5); ##> Edges(P); ##< {{1, 2}, {2, 3}, {3, 4}, {4, 5}} ##> DrawGraph(P, style=circle); ##> P2 := GraphPower(P, 2); ##> Edges(P2); ##< {{1, 3}, {2, 4}, {3, 5}, {1, 2}, {2, 3}, {3, 4}, {4, 5}} ##> DrawGraph(P2); ##> P3 := GraphPower(P, 3); ##> Edges(P3); ##< {{1, 3}, {2, 4}, {3, 5}, {1, 2}, {2, 3}, {3, 4}, {4, 5}, {1, 4}, {2, 5}} ##> DrawGraph(P3); ## ##SEEALSO ##- "AdjacencyMatrix" ##- "Diameter" ##- "ShortestPath" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "Diameter" : Help:GraphTheory[Diameter] ##- "ShortestPath" : Help:GraphTheory[ShortestPath] #---------ver. 23, modified by MG #---------ver. 25, rewritten by MBM to use datatype=float[8] GraphPower := proc(G::GRAPHLN, k::posint) local A, B, C, S, i, j, n; if IsWeighted(G) then error"1st argument must be an unweighted graph."; fi; n := NumberOfVertices(G); B := AdjacencyMatrix(G); A := Matrix(n,B,datatype=float[8],storage=rectangular); C := A; S := A; to k-1 do S := S.A; C := C+S end do; if IsDirected(G) then for i to n do for j to n do if i<>j and C[i,j]>0.0 then B[i,j] := 1 fi; od od; else for i to n do for j from i+1 to n do if C[i,j]>0.0 then B[i,j] := 1 fi; od od; fi; Graph(vlist(G), B); end; ############################################## ##PROCEDURE(doti) GraphRank ##ALIAS GraphTheory[GraphRank] ##CALLINGSEQ ##- GraphRank('G') ##- GraphRank('G', 'E') ## ##PARAMETERS ##- 'G' : graph ##- 'E' : (optional) set of edges or arcs of the (di)graph ## ##DESCRIPTION ##- `GraphRank` returns rank of a graph 'G' which is the number of vertices minus ## the number of connected components of 'G'. ## If a set of edges (arcs) 'E' of the (di)graph is specified, then the rank is number of vertices ## minus the number of connected components of the spanning subgraph of 'G' with edge set 'E'. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2},{3,4},{4,5}}): ##> GraphRank(G); ##< 3 ##> GraphRank(G, {{1,2},{3,4}}); ##< 2 ## ##SEEALSO ##- "ConnectedComponents" ##- "NumberOfVertices" ## ##XREFMAP ##- "ConnectedComponents" : Help:GraphTheory[ConnectedComponents] ##- "NumberOfVertices" : Help:GraphTheory[NumberOfVertices] #---------ver. 23, modified by MG GraphRank := proc(G::GRAPHLN, E::set) local V; V := vlist(G); if nargs=2 then if not (E subset Edges(G)) then error"2nd argument expected to be a subset of edges of the graph"; end if; nops(V)-nops(ConnectedComponents(Graph(V,E))); elif nargs=1 then nops(V)-nops(ConnectedComponents(G)); else error "1 or 2 arguments expected"; end if; end; ############################################## ##PROCEDURE(doti) GraphUnion ##ALIAS GraphTheory[GraphUnion] ##CALLINGSEQ ##- GraphUnion('G1',...,'Gs') ## ##PARAMETERS ##- 'G1',...,'Gs' : graphs ## ##DESCRIPTION ##- If the set of vertices of 'G1' is the same as that of 'G2' then ## ~GraphUnion(G1,G2)~ will return a graph G with Vertices(G) = Vertices(G1) ## and Edges(G) = Edges(G1) union Edges(G2). Moreover, if 'G1' and 'G2' ## are both weighted graphs, the resulting graph 'G' will be a weighted ## graph with WeightMatrix(G) = WeightMatrix(G1) + WeightMatrix(G2). ## ##- Note, if 'G1' is (un)directed then 'G2' must also be (un)directed and ## the resulting graph is (un)directed. Likewise, if 'G1' is (un)weighted, ## then 'G2' must also be (un)weighted and the result is (un)weighted. ## Note, the vertex sets of 'G1' and 'G2' must be the same but need not ## be in the same order. See the second example below. ## ##EXAMPLES ##> with(GraphTheory): ##> G1 := Graph(directed,[1,2,3],{[1,2],[2,3]}); ##> G2 := Graph(directed,[1,2,3],{[3,1],[2,3]}); ##> G := GraphUnion(G1,G2); ##> Vertices(G); ##< [1, 2, 3] ##> Edges(G); ##< {[1, 2], [2, 3], [3, 1]} ## ##- In this example, note that the vertices of G1 and G2 are permuted differently. ## ##> G1 := Graph([a,b,c],{[{a,b},3],[{b,c},4]}); ##> G2 := Graph([a,c,b],{[{a,c},5],[{b,c},6]}); ##> G := GraphUnion(G1,G2); ##> Vertices(G); ##< [a, b, c] ##> Edges(G); ##< {{a, b}, {c, b}, {c, a}} ##> WeightMatrix(G1), WeightMatrix(G2), WeightMatrix(G); # RP: there is no good way to test this # #<(verification="LinearAlgebra:-Equal") Matrix([[0,3,0],[3,0,4],[0,4,0]]),Matrix([[0,5,0],[5,0,6],[0,6,0]]),Matrix([[0,3,5],[3,0,10],[5,10,0]]) ## ##SEEALSO ##- "CartesianProduct" ##- "DisjointUnion" ##- "GraphJoin" ## ##XREFMAP ##- "CartesianProduct" : Help:GraphTheory[CartesianProduct] ##- "DisjointUnion" : Help:GraphTheory[DisjointUnion] ##- "GraphJoin" : Help:GraphTheory[GraphJoin] #---------ver. 23, modified by MG #---------ver. 26, modified by MBM GraphUnion := proc(G1::GRAPHLN,G2::GRAPHLN) local D, W, V, E, M, G; if nargs=1 then return G1; fi; if nargs>2 then return GraphUnion(GraphUnion(G1,G2),args[3..nargs]) fi; D, W, V := getdir(G1), getwt(G1), vlist(G1); if getdir(G2) <> D then error "union of a directed graph and an undirected graph"; end if; if getwt(G2) <> W then error "union of a weighted graph and an unweighted graph"; end if; if {op(vlist(G2))} <> {op(V)} then error "graphs must have the same vertices"; end if; E := Edges(G1) union Edges(G2); G := Graph(D, V, E); if W=weighted then if vlist(G2) <> V then M := WeightMatrix(G1) + WeightMatrix(PermuteVertices(G2,V)); else M := WeightMatrix(G1) + WeightMatrix(G2); fi; G := MakeWeighted(G,M); end if; G: end; ############################################## ##PROCEDURE(doti) DisjointUnion ##ALIAS GraphTheory[DisjointUnion] ##CALLINGSEQ ##- DisjointUnion('G1',...,'Gs') ## ##PARAMETERS ##- 'G1',...,'Gs' : graphs ## ##DESCRIPTION ##- `DisjointUnion` will return the disjoint union of the input graphs. ## ##EXAMPLES ##> with(GraphTheory): ##> G := DisjointUnion(CycleGraph(3), PathGraph(3)); ##> Vertices(G); ##< ["1:1", "1:2", "1:3", "2:1", "2:2", "2:3"] ##> DegreeSequence(G); ##< [2, 2, 2, 1, 2, 1] ## ##SEEALSO ##- "CartesianProduct" ##- "GraphJoin" ##- "GraphUnion" ## ##XREFMAP ##- "CartesianProduct" : Help:GraphTheory[CartesianProduct] ##- "GraphJoin" : Help:GraphTheory[GraphJoin] ##- "GraphUnion" : Help:GraphTheory[GraphUnion] #---------ver. 23, modified by MG DisjointUnion := proc() local G, D, j, n, V, p, nj; G := NULL; D := NULL; n := nargs; for j to n do if not type(args[j], GRAPHLN) then error"all arguments are expected to be of type GRAPHLN"; else D := D, getdir(args[j]); G := G, args[j]; fi; od; if nops({D}) <> 1 then error"the arguments must be either all directed or all undirected"; fi; G := Array(1..n, [G]); V := seq(op(vlist(G[j])), j=1..n); if nops({V}) <> nops([V]) then V := [seq(op( map(x->sprintf("%0d:%s", j, convert(x, string)), vlist(G[j])) ), j=1..n)]; p := 0; for j to n do nj := nops(vlist(G[j])); G[j] := RelabelVertices(G[j], [$p+1..p+nj]); p := p+nj; od; return RelabelVertices(Graph([$1..p], `union`(seq(Edges(G[j]), j=1..n))), V); else return Graph([V], `union`(seq(Edges(G[j]), j=1..n))); fi; end; # RP: removed # ############################################# # #PROCEDURE(doti) Head # #TITLE Head # #TITLE Tail # #ALIAS GraphTheory[Head], GraphTheory[Tail] # #CALLINGSEQ # #- Head('G') # #- Tail('G') # # # #PARAMETERS # #- 'G' : directed graph # # # #DESCRIPTION # #- `Head` will return a table in which each arc of the digraph is associated # # with its head. # #- `Tail` will return a table in which each arc of the digraph is # # associated with its tail. # # # #EXAMPLES # #> with(GraphTheory): # #> G := Digraph( Trail(1,2,3,4,2) ); # #> Head(G); # #< table([[1, 2] = 2, [3, 4] = 4, [2, 3] = 3, [4, 2] = 2]); # #> Tail(G); # #< table([[1, 2] = 1, [3, 4] = 3, [2, 3] = 2, [4, 2] = 4]); #---------ver. 23, modified by MG # # RP: these commands were removed # Head := proc(G::GRAPHLN) # local V, W, E; # if getdir(G)=undirected then error "directed graph expected"; end if; # V, W := vlist(G), getwt(G); # E := GraphInfo:-Edges(G); # table([ seq( map(v->V[v], e)=V[e[2]] ,e=E ) ]) # end; # # Tail := proc(G::GRAPHLN) # local V, W, E; # if getdir(G)=undirected then error "directed graph expected"; end if; # V, W := vlist(G), getwt(G); # E := GraphInfo:-Edges(G); # table([ seq( map(v->V[v], e)=V[e[1]] ,e=E ) ]) # end; ############################################## ##PROCEDURE(doti) IncidentEdges ##ALIAS GraphTheory[IncidentEdges] ##CALLINGSEQ ##- IncidentEdges('G', 'V', 'd') ## ##PARAMETERS ##- 'G' : graph or digraph ##- 'V' : vertex or list of vertices ##- 'd' : (optional) equation of the form `direction`=`incoming` or `outgoing` ## ##DESCRIPTION ##- `IncidentEdges` returns the set of edges (arcs) which are incident to a given vertices. ## If 'G' is a directed graph the set of arcs which have a tail in the given list of vertices are returned. ## ##- `IncidentEdges`('G', 'V', `direction`=`incoming`) returns the set of arcs which have a head in the given set of vertices. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CycleGraph(7): ##> IncidentEdges(G, 1); ##< {{1, 2}, {1, 7}} ##> IncidentEdges(G, [1,5,7]); ##< {{1, 2}, {5, 6}, {4, 5}, {6, 7}, {1, 7}} ##> DG := Digraph( Trail(1,2,3,4,5,3), Trail(1,5,2,4,1) ); ##> IncidentEdges(DG, [2, 3]); ##< {[2, 3], [3, 4], [2, 4]} ##> IncidentEdges(DG, [2, 3], direction=incoming); ##< {[1, 2], [2, 3], [5, 2], [5, 3]} ## ##SEEALSO ##- "AdjacencyMatrix" ##- "Degree" ##- "IncidenceMatrix" ##- "Neighbors" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "Degree" : Help:GraphTheory[Degree] ##- "IncidenceMatrix" : Help:GraphTheory[IndicenceMatrix] ##- "Neighbors" : Help:GraphTheory[Neighbors] #---------ver. 23, modified by MG IncidentEdges := proc(G::GRAPHLN, vv::{VERTEXTYPE, list(VERTEXTYPE)}) local V, A, L, n, out, v; if not member(nargs,{2,3}) then error "expected 2 or 3 arguments";end if; V, A := vlist(G), listn(G); n := nops(V); v := `if`(type(vv, list), vv, [vv]); if not({op(v)} subset {op(V)}) then error "2nd argument expected to be a set of vertices of the graph";end if; out := true; #indicating that the departure edges are considered as incident (default) if nargs = 3 then out := args[3]; if not (type(out,equation) or op(1,out) = direction or op(2,p)=outgoing or op(2,p)=incoming) then error "3rd argument (optional) expected to be of the form direction=incoming/outgoing"; end if; out := evalb(op(2,out)=outgoing); end if; L := GraphInfo:-LabelToInteger(G); if getdir(G)='undirected' then { seq( seq({V[i],V[j]},j=A[i]) ,i=map(k->L[k],v) )} else if out then { seq( seq([V[i],V[j]],j=A[i]) ,i=map(k->L[k],v))} else { seq( seq([V[j], V[i]], j={seq(`if`(member(i,A[k]), k, NULL), k=1..n)}) ,i=map(k->L[k],v))} end if; end if; end; ############################################## ##PROCEDURE(doti) IncidenceMatrix ##ALIAS GraphTheory[IncidenceMatrix] ##CALLINGSEQ ##- IncidenceMatrix('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `IncidenceMatrix`('G') returns the incidence matrix of a graph 'G' whose rows ## are indexed by the vertices and columns by the edges of 'G'. The order of ## the edges is defined by `Edges`('G'). ## If 'G' is undirected the the entry _(i,j)_ of this _{0,1}_-matrix is 1 iff ## vertex ~i~ is incident to edge ~j~. ## If 'G' is directed the the entry _(i,j)_ of this _{0,1,-1}_-matrix is 1 iff ## vertex ~i~ is the head of arc ~j~ and -1 iff vertex ~i~ is the tail of arc ~j~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CompleteGraph(4); ##> Edges(G); ##< {{1, 3}, {2, 4}, {1, 2}, {2, 3}, {3, 4}, {1, 4}} ##> IncidenceMatrix(G); ##> DG := Digraph( Trail(1,2,3,4,5,3), Trail(1,5,2,4,1) ); ##> Edges(DG); ##< {[1, 2], [2, 3], [3, 4], [4, 1], [2, 4], [1, 5], [4, 5], [5, 2], [5, 3]} ##> IncidenceMatrix(DG); ## ##TEST ## Try(100, {op(ListTools:-Transpose(convert(IncidenceMatrix(G), listlist)))}, {op(ListTools:-Transpose([[1,0,1,0,0,1],[0,1,1,1,0,0],[1,0,0,1,1,0],[0,1,0,0,1,1]]))}); ## Try(101, {op(ListTools:-Transpose(convert(IncidenceMatrix(DG), listlist)))}, {op(ListTools:-Transpose([[1,0,0,-1,0,1,0,0,0],[-1,1,0,0,1,0,0,-1,0],[0,-1,1,0,0,0,0,0,-1],[0,0,-1,1,-1,0,1,0,0],[0,0,0,0,0,-1,-1,1,1]]))}); ## ##SEEALSO ##- "AdjacencyMatrix" ##- "Degree" ##- "IncidentEdges" ##- "Neighbors" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "Degree" : Help:GraphTheory[Degree] ##- "IncidentEdges" : Help:GraphTheory[IndicentEdges] ##- "Neighbors" : Help:GraphTheory[Neighbors] #---------ver. 23, modified by MG IncidenceMatrix := proc( G::GRAPHLN ) local m, n, IncMtx, E, V, j; E := GraphInfo:-Edges(G); m := nops(E); n := nops(vlist(G)); IncMtx := Matrix( n, m, storage=sparse ); if getdir(G)='undirected' then for j to m do IncMtx[E[j][1],j] := 1; IncMtx[E[j][2],j] := 1; end do; else for j to m do IncMtx[E[j][1],j] := 1; IncMtx[E[j][2],j] := -1; end do; end if; IncMtx end; # RP : help paged merged with MaximumIndependentSet IndependenceNumber := proc(G::GRAPHLN) CliqueNumber(GraphComplement(G)); end; ############################################## ##PROCEDURE(doti) InducedSubgraph ##ALIAS GraphTheory[InducedSubgraph] ##CALLINGSEQ ##- InducedSubgraph('G', 'S') ## ##PARAMETERS ##- 'G' : graph ##- 'S' : list of vertices ## ##DESCRIPTION ##- `InducedSubgraph` will return the subgraph induced by a specified list of vertices. ##- To construct a subgraph using a set of edges, use the "Subgraph" command. ## ##EXAMPLES ##> with(GraphTheory): ##> C6 := CycleGraph(6); ##> H := InducedSubgraph(C6,[1,2,6]); ##> Vertices(H); ##< [1, 2, 6] ##> Edges(H); ##< {{1, 2}, {1, 6}} ##> with(SpecialGraphs): ##> P := PetersenGraph(); ##> DrawGraph(P); ##> H := InducedSubgraph(P, [1,2,3,6,7,9] ); ##<(verification="GraphEqual") Graph({{1, 2}, {2, 3}, {1, 6}, {3, 7}, {2, 9}, {6, 7}}) ##> DrawGraph(H); ## ##SEEALSO ##- "DeleteVertex" ##- "Subgraph" ## ##XREFMAP ##- "Subgraph" : Help:GraphTheory[Subgraph] ##- "DeleteVertex" : Help:GraphTheory[DeleteVertex] #---------ver. 23, modified by MG #---------ver. 24, improved efficiency of copying of attributes MBM InducedSubgraph := proc (G::GRAPHLN, S::{set(VERTEXTYPE),list(VERTEXTYPE)}) local D, W, V, A, T, E, n, s, B, L, intS, R, i, M, newG, Eorig; D, W, V, A, T, E := getops(G); n := nops(V); L := GraphInfo:-LabelToInteger(G); s := nops(S); if nops({op(S)}) <> s then error "repeated vertices are not allowed."; fi; intS :=[seq(L[v],v=S)]; # {1,7,9} #intS := map(x->`if`(member(x, S), L[x], NULL), V); if not type(intS,list(integer)) then error "2nd argument must be a subset of vertices of the graph, but received %1",S; end if; R := Array(1..n,fill=NULL); # storage=sparse for i to s do R[intS[i]] := i; end do; # R[1] = 1, R[7] = 2, R[9] = 3 B := Array(1..s); for i to s do B[i] := {seq( R[v], v = A[intS[i]] )} end do; if W = unweighted then M := 0 else M := E[[op(intS)],[op(intS)]]; end if; V := [seq( V[i], i=intS )]; # assumes sets of small integers are sorted newG := GRAPHLN( D, W, V, B, GRAPH_TABLE_NAME(), M ); if not type(ginfo(G),table) then return newG; fi; #--copy the vertex and edge attributes E := GraphInfo:-Edges(newG); if D=directed then Eorig := [seq( [seq( intS[i], i=e )], e=E )]; else Eorig := [seq( {seq( intS[i], i=e )}, e=E )]; fi; GraphInfo:-SetAttrib(newG, [$1..s, op(E)], GraphInfo:-GetAttrib(G, [op(intS), op(Eorig)])); return newG; end; ############################################## ##PROCEDURE(doti) IsAcyclic ##ALIAS GraphTheory[IsAcyclic] ##CALLINGSEQ ##- IsAcyclic('G') ## ##PARAMETERS ##- 'G' : directed graph ## ##DESCRIPTION ##- `IsAcyclic` return `true` if the input has no directed cycle and `false` otherwise. ## ##EXAMPLES ##> with(GraphTheory): ##> IsAcyclic(Digraph( Trail(1,2,3,4,5) )); ##< true ##> IsAcyclic(Digraph( Trail(1,2,3,4,5,2) )); ##< false ## ##SEEALSO ##- "AcyclicPolynomial" ##- "CycleBasis" ##- "IsTree" ## ##XREFMAP ##- "AcyclicPolynomial" : Help:GraphTheory[AcyclicPolynomial] ##- "CycleBasis" : Help:GraphTheory[CycleBasis] ##- "IsTree" : Help:GraphTheory[IsTree] #---------ver. 23, modified by MG IsAcyclic := proc(G::GRAPHLN) local d, f, P, E, e, u, v, acyc; # RP: for undirected graphs, check for a forest # if getdir(G)='undirected' then error "expected a directed graph" end if; if getdir(G)='undirected' then return IsForest(G) end if; DFS( G, d, f, P); #L := GraphInfo:-LabelToInteger(G); #Vert := vlist(G); E := GraphInfo:-Edges(G); acyc := true; for e in E do u, v := e[1],e[2]; if d[v] < d[u] and f[u] < f[v] then acyc := false; break end if; #check there is no back edge end do; acyc end; # RP: help page merged into TwoEdgeConnectedComponents IsTwoEdgeConnected := proc(G::GRAPHLN) evalb( nops(TwoEdgeConnectedComponents(G)) = 1 ); end; ############################################## ##PROCEDURE(doti) IsBipartite ##ALIAS GraphTheory[IsBipartite] ##CALLINGSEQ ##- IsBipartite('G') ##- IsBipartite('G', 'P') ## ##PARAMETERS ##- 'G' : graph ##- 'P' : (optional) name ## ##DESCRIPTION ## ##- A graph 'G' is bipartite if its set of vertices can be partitioned into ## two sets, _V[1]_ and _V[2]_, such that every edge in 'G' connects a vertex ## in _V[1]_ or _V[2]_ to a vertex in the other set. ## ##- `IsBipartite` returns `true` if the graph 'G' is bipartite and `false` otherwise. ## If a variable name 'P' is specified, then this name is assigned ## a bipartition of the vertices as a list of lists. ## ##EXAMPLES ##> with(GraphTheory): ##> K32 := CompleteGraph(3,2); ##> IsBipartite(K32, 'bp'); ##< true ##> bp; ##< [[1, 2, 3], [4, 5]] ##> DrawGraph(K32, style=bipartite); # bipartite drawing ##> AdjacencyMatrix(K32); # note the structure ##> G := CycleGraph(5); ##> IsBipartite(G); ##< false ## ##SEEALSO ##- "AdjacencyMatrix" ##- "BipartiteMatching" ##- "DrawGraph" ##- "RandomGraphs[RandomBipartiteGraph]" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "BipartiteMatching" : Help:GraphTheory[BipartiteMatching] ##- "DrawGraph" : Help:GraphTheory[DrawGraph] #---------ver. 23, modified by MG IsBipartite := proc(G::GRAPHLN, bp::name) local dfs, a, i, n, A, V; dfs := proc(v) local u, w; for w in A[v] do #w := u[1]; if a[w] = 0 then a[w] := -a[v]; if not dfs(w) then return false; end if; elif a[w] = a[v] then return false; end if; end do; return true; end; V := vlist(G); n := nops(V); A := listn(G); a := Array(1..n); # a[v] is 1 if v is in the first set and -1 if in the second set. # otherwsise v has not been visited yet and a[v] is 0. for i to n do if a[i] = 0 then a[i] := 1; if not dfs(i) then if nargs=2 then bp := FAIL; end if; return false end if; end if; end do; if nargs=2 then bp := [map(k->V[k], select(proc(j) evalb(a[j]=1 ) end proc, [seq(j,j=1..n)])), map(k->V[k], select(proc(j) evalb(a[j]=-1) end proc, [seq(j,j=1..n)]))]; end if; return true end proc; ############################################## ##PROCEDURE(doti) IsClique ##ALIAS GraphTheory[IsClique] ##CALLINGSEQ ##- IsClique('G') ## ##PARAMETERS ##- 'G' : undirected graph ## ##DESCRIPTION ##- `IsClique` will return `true` if the input graph is a clique (complete graph). ## It will return `false` otherwise. ## ##- To test whether a graph contains a clique (on a particular set of vertices) ## use the "InducedSubgraph" command first. ## ##EXAMPLES ##> with(GraphTheory): ##> K3 := CompleteGraph(3); ##> IsClique(K3); ##< true ##> C4 := CycleGraph(4); ##> IsClique(C4); ##< false ##> G := AddEdge(C4, {1,3}, inplace=false); ##> IsClique(InducedSubgraph(G, [1,2,3])); ##< true ## ##SEEALSO ##- "CliqueNumber" ##- "InducedSubgraph" ##- "MaximumClique" ## ##XREFMAP ##- "CliqueNumber" : Help:GraphTheory[CliqueNumber] ##- "InducedSubgraph" : Help:GraphTheory[InducedSubgraph] ##- "MaximumClique" : Help:GraphTheory[MaximumClique] #---------ver. 23, modified by MG IsClique := proc(G::GRAPHLN) local i,ic, n, A; if getdir(G) = 'directed' then error"1st argument is expected to be an undirected graph. Use `UnderlyingGraph`"; end if; A, n := listn(G), nops(vlist(G)); ic, i := true, 1; while ic = true and i < n+1 do ic := evalb(nops(A[i])=n-1); i:=i+1; end do; ic; end; # RP : help page merged with ConnectedComponents #---------ver. 23, modified by MG #---------ver. 25, modified by MBM to use breadth first search IsConnected := proc(G::GRAPHLN) local n,A,s,m,Q,u,v,N,M; n := nops(vlist(G)); if n = 0 then return true end if; if getdir(G)=directed then return IsConnected(UnderlyingGraph(G)) fi; #ad := listn(G); # list of neighbors (an array of sets) #M := Array(1..n); # mark array #nv := 0; #dfs := proc(cv) local v; # M[cv] := 1; # nv := nv + 1; # for v in ad[cv] do if M[v]=0 then dfs(v); end if; end do; #end; #dfs(1); #if nv = n then return true else return false end if; # MBM: Maple 10 on a 64 bit machine with a stack limit of 10 megabytes, hits # MBM: the stack limit when the recursion depth goes just over 3,500 levels. # MBM: For this reason IsConnected (June 2006) uses breadth-first search. A := listn(G); # array of sets of neigbors of the graph Q := Array(1..n); Q[1] := 1; s := 1; m := 1; # the first empty position in the queue Q is index m+s M := Array(1..n); M[1] := 1; N := 1; # M is a mark array while m>0 and N with(GraphTheory): ##> G := Graph({{1,2},{1,3},{2,3},{1,4},{3,4},{4,5},{5,6},{4,6}}); ##> DrawGraph(G); ##> S := {{1,4}, {3,4}}; # a cut-set ##> IsCutSet(G, S); ##< true ##> DeleteEdge(G, S); ##> IsConnected(G); ##< false ## ##SEEALSO ##- "ConnectedComponents" ##- "DeleteEdge" ##- "EdgeConnectivity" ##- "IsConnected" ## ##XREFMAP ##- "ConnectedComponents" : Help:GraphTheory[ConnectedComponents] ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "EdgeConnectivity" : Help:GraphTheory[EdgeConnectivity] ##- "IsConnected" : Help:GraphTheory[IsConnected] #---------ver. 23, modified by MG IsCutSet := proc(G::GRAPHLN,e) evalb( GraphRank(G) > GraphRank(DeleteEdge(G,e,inplace=false)) ) end; ############################################## ##PROCEDURE(doti) IsDirected ##TITLE IsDirected ##TITLE IsWeighted ##ALIAS GraphTheory[IsDirected], GraphTheory[IsWeighted] ##CALLINGSEQ ##- IsDirected('G') ##- IsWeighted('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `IsDirected` will return `true` or `false` depending on whether the input graph is a directed or undirected graph. ##- `IsWeighted`('G') will return `true` if 'G' is a weighted graph, and `false` otherwise. ##- To make a graph directed or weighted, use the "MakeDirected" or "MakeWeighted" commands. ##- To remove directions and weights from a graph, use the "UnderlyingGraph" command. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({[1,2],[2,3],[3,1]}); ##> IsDirected(G); ##< true ##> IsWeighted(G); ##< false ##> DrawGraph(G); ##> K3 := CompleteGraph(3); ##> IsDirected(K3); ##< false ##> H := Graph({[{1,2},2],[{2,3},3]}); ##> IsWeighted(H); ##< true ##> WeightMatrix(H); ##<(verification="LinearAlgebra:-Equal") Matrix([[0,2,0],[2,0,3],[0,3,0]]) ##> K3 := CompleteGraph(3); ##> IsWeighted(K3); ##< false ##> K3 := MakeWeighted(K3); ##> IsWeighted(K3); ##< true ##> WeightMatrix(K3); ##<(verification="LinearAlgebra:-Equal") Matrix([[0,1,1],[1,0,1],[1,1,0]]) ## ##SEEALSO ##- "MakeDirected" ##- "MakeWeighted" ##- "UnderlyingGraph" ##- "WeightMatrix" ## ##XREFMAP ##- "MakeDirected" : Help:GraphTheory[MakeDirected] ##- "MakeWeighted" : Help:GraphTheory[MakeWeighted] ##- "UnderlyingGraph" : Help:GraphTheory[UnderlyingGraph] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] #---------ver. 23, modified by MG IsDirected := proc(G::GRAPHLN) evalb(getdir(G) = directed) end; ############################################## ##PROCEDURE(doti) IsEulerian ##ALIAS GraphTheory[IsEulerian], Eulerian, EulerTour, EulerianTour ##CALLINGSEQ ##- IsEulerian('G') ##- IsEulerian('G', 'T') ## ##PARAMETERS ##- 'G' : graph ##- 'T' : (optional) name ## ##DESCRIPTION ##- `IsEulerian` returns `true` if the input graph is an Eulerian graph, i.e there exists a ## closed walk in the graph that uses each edge exactly once. ## It returns `false` otherwise. ## ##- An optional second argument 'T' will be assigned an Eulerian tour of the graph if such a tour ## exists, and `FAIL` otherwise. ## ##- The algorithm used to construct the Eulerian trail is depth-first-search. ## The complexity is _O(n+m)_ where ~n=|V|~ and ~m=|E|~. ## ##EXAMPLES ##> with(GraphTheory): ##> IsEulerian(CompleteGraph(4)); ##< false ##> IsEulerian(CompleteGraph(5), 'T'); ##< true ##> T; ###<(verification="GraphEqual") Trail(1, 2, 3, 1, 4, 2, 5, 3, 4, 5, 1) ## ##SEEALSO ##- "IsHamiltonian" ##- "Trail" ## ##XREFMAP ##- "IsHamiltonian" : Help:GraphTheory[IsHamiltonian] ##- "Trail" : Help:GraphTheory[Trail] #---------ver. 23, modified by MG #---------ver. 24, rewritten by SL to use depth first search. IsEulerian := proc(G::GRAPHLN, EulerTour::name) local D,W,V,A,n,B,c,T,m,ie,g,C,u,v,dfs,i; D, W, V, A := getdir(G), getwt(G), vlist(G), listn(G); n := nops(V); if nargs>2 then error"at most two arguments are allowed." fi; C := Array(1..n, fill=1); m := add(nops(A[i]),i=1..n); ie := true; if D = 'directed' then g := Array(1..n); for i to n do for v in A[i] do g[v]:=g[v]+1 od od; for i to n while ie do if nops(A[i]) <> g[i] then ie := false fi od; else m := iquo(m,2); for i to n while ie do if irem(nops(A[i]),2)=1 then ie := false fi od; fi; c := 0; dfs := proc(u) local v; while C[u]<=nops(A[u]) do v := A[u][C[u]]; C[u] := C[u]+1; if not assigned(B[u,v]) then B[u,v] := true; if D = 'undirected' then B[v,u] := true fi; dfs(v); fi; od; c := c+1; T[c] := u; end; if ie and nargs=2 then dfs(1); ie := evalb(c=m+1) elif ie then ie := IsConnected(G) fi; if ie and nargs=2 then EulerTour := 'Trail'(seq(V[T[c-i+1]],i=1..c)) fi; if not ie and nargs=2 then EulerTour := FAIL fi; ie; end; ############################################## ##PROCEDURE(doti) IsForest ##ALIAS GraphTheory[IsForest] ##CALLINGSEQ ##- IsForest('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- The `IsForest` command returns `true` if the input graph is a forest or `false` otherwise. ## A forest is a graph whose connected components are all trees. ## ##EXAMPLES ##> with(GraphTheory): ##> F := Graph([1,2,3,4,5,6],{{1,2},{2,3},{5,6}}); ##> IsForest(F); ##< true ##> C := ConnectedComponents(F); ##> seq(IsTree(InducedSubgraph(F, i)), i=C); ##< true, true, true ##> NumberOfVertices(F) - NumberOfEdges(F) - nops(ConnectedComponents(F)); ##< 0 ## ##SEEALSO ##- "ConnectedComponents" ##- "InducedSubgraph" ##- "IsTree" ## ##XREFMAP ##- "ConnectedComponents" : Help:GraphTheory[ConnectedComponents] ##- "InducedSubgraph" : Help:GraphTheory[InducedSubgraph] ##- "IsTree" : Help:GraphTheory[IsTree] #---------ver. 23, modified by MG IsForest := proc(G::GRAPHLN) local C, c, forest, H; if getdir(G) = 'directed' then error"1st argument must be an undirected graph. Use `UnderlyingGraph`"; end if; C := ConnectedComponents(G); forest := true; for c in C while forest do H := InducedSubgraph(G,c); forest := evalb( NumberOfEdges(H) = NumberOfVertices(H) - 1 ); end do; forest end; ############################################## ##PROCEDURE(doti) IsGraphicSequence ##ALIAS GraphTheory[IsGraphicSequence] ##CALLINGSEQ ##- IsGraphicSequence('L') ## ##PARAMETERS ##- 'L' : list of integers ## ##DESCRIPTION ##- `IsGraphicSequence` will return `true` if there exists a graph with the specified ## degree sequence given as input. It returns `false` otherwise. ## The strategy is to verify some inequalities due to Erdos, Gallai (1960). ## A refinement due to Tripathi, Vijai (2003) is implemented which makes the algorithm faster. ## ##- To construct a graph with given degree sequence, use "SequenceGraph". ## ##EXAMPLES ##> with(GraphTheory): ##> L := [3, 2, 4, 2, 3, 4, 5, 7]; ##> IsGraphicSequence(L); ##< true ##> G := SequenceGraph(L); ##> sort(DegreeSequence(G)); ##< [2, 2, 3, 3, 4, 4, 5, 7] ## ##SEEALSO ##- "DegreeSequence" ##- "SequenceGraph" ## ##XREFMAP ##- "DegreeSequence" : Help:GraphTheory[DegreeSequence] ##- "SequenceGraph" : Help:GraphTheory[SequenceGraph] #---------ver. 23, modified by MG IsGraphicSequence := proc(S::list) local b, n, d, r; b := true; n := nops(S); if add(S[i],i=1..n) mod 2 = 1 then return false end if; d := sort(S,`>`); r := 1; while (r < n) and b do while (r < n) and d[r] = d[r+1] do r:= r+1 end do; if add(d[i],i=1..r) > r*(r-1) + add(min(r,d[i]),i=r+1..n) then b:=false end if; r := r+1; end do; b end; ############################################## ##PROCEDURE(doti) IsHamiltonian ##ALIAS GraphTheory[IsHamiltonian] ##CALLINGSEQ ##- IsHamiltonian('G') ##- IsHamiltonian('G', 'C') ## ##PARAMETERS ##- 'G' : unweighted graph ##- 'C' : (optional) name ## ##DESCRIPTION ##- A graph 'G' on ~n~ vertices is Hamiltonian if there exists ## a cycle in 'G' containing each of the ~n~ vertices once. ## ##- `IsHamiltonian`('G') returns `true` if the graph is Hamiltonian and `false` ## otherwise. If 'G' is Hamiltonian and a name 'C' is specified as a second ## argument, then 'C' will be assigned a list of vertices of a Hamiltonian ## cycle of the graph starting and ending with the first vertex in 'G'. ## For example, if the graph 'G' is the triangle graph created with ## ~Graph({{1,2},{1,3},{2,3}})~, the cycle is output as _[1,2,3,1]_. ## ##- The algorithm works for directed graphs and it ignores the edge ## weights of weighted graphs. ## ##- The algorithm first checks whether 'G' is disconnected or whether ## it has any articulation points. If so 'G' is not Hamiltonian. ## Then it tests whether the minimum degree of 'G' is at least _n/2_ where ## _n_ is the number of vertices. If so 'G' is Hamiltonian. Then, if 'G' is ## not too sparse, we check if the independence number of 'G' is greater than _n/2_. ## If so 'G' is not Hamiltonian. Failing these checks, we do a simple ## exhaustive search for a Hamiltonian cycle using depth-first-search. ## By setting ~infolevel[IsHamiltonian]~ to an integer greater than 1 ## a message will be displayed stating how the graph was proven ## (or disproven) to be Hamiltonian. ## ##- An example of a graph which is Hamiltonian for which it will take ## exponential time to find a Hamiltonian cycle is the hypercube in ## ~d~ dimensions which has _n=2^d_ vertices and _m=d*2^d_ edges. ## The algorithm has no difficulty in finding a Hamiltonian cycle for _d=5_ ## where _n=32_ and _m=80_ but for _d=6_, _n=64_, and _m=192_ it takes a long time. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(); ##> IsHamiltonian(P); ##< false ##> AddEdge(P, {1,3}); ##> IsHamiltonian(P, 'C'); ##< true ##> C; ##< [1, 2, 9, 8, 5, 4, 10, 6, 7, 3, 1] ##> DrawGraph(P); ##> H3 := SpecialGraphs:-HypercubeGraph(3); # 3-dimensional cube ##> IsHamiltonian(H3, 'C'); ##< true ##> C; ### ["000", "001", "011", "010", "110", "111", "101", "100", "000"] ##> HighlightTrail(H3, C, red); ##> DrawGraph(H3); ##> infolevel[IsHamiltonian] := 2; ##> IsHamiltonian(H3); ##> K33 := CompleteGraph(3,3); ##> IsHamiltonian(K33); ##< true ##> K34 := CompleteGraph(3,4); ##> IsHamiltonian(K34); ##< false ## ##SEEALSO ##- "DrawGraph" ##- "HighlightTrail" ##- "IsEulerian" ##- "SpecialGraphs[HypercubeGraph]" ##- "TravelingSalesman" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "HighlightTrail" : Help:GraphTheory[HighlightTrail] ##- "IsEulerian" : Help:GraphTheory[IsEulerian] ##- "TravelingSalesman" : Help:GraphTheory[TravelingSalesman] #---------ver. 23, modified by MG #---------ver. 24, rewritten to use simple DFS by MBM and SCL #---------ver. 25, independence number check added by Mahdad and MBM IsHamiltonian := proc(G::GRAPHLN, cycle::name) local DFS, V, C, M, i, n, A, D, d; DFS := proc(u,m) local v; C[m] := u; if m=n then return member(1,A[u]) fi; for v in A[u] do if M[v]=0 then M[v] := 1; if DFS(v,m+1) then return true; fi; M[v] := 0; fi; od; false; end; V := vlist(G); n := nops(V); if n=1 then # a graph with a single node is hamiltonian if nargs=2 then cycle := V fi; return true; fi; A := listn(G); if not IsDirected(G) and not IsConnected(G) then userinfo(2,{IsHamiltonian,GraphTheory},"graph is not connected ==> it's not hamiltonian"); return false; end if; if IsDirected(G) and not IsStronglyConnected(G) then userinfo(2,{IsHamiltonian,GraphTheory}, "directed graph is not strongly connected ==> it's not hamiltonian"); return false; end if; C := GetGraphAttribute(G,"hamiltonian_cycles"); if C <> FAIL then C := C[1]; if nargs=2 then cycle := [seq(V[C[i]],i=1..n),V[1]] fi; return true; fi; if ArticulationPoints(G) <> [] then userinfo(2,{IsHamiltonian,GraphTheory}, "graph is not biconnected ==> it's not hamiltonian"); return false fi; if getdir(G)=undirected then if MinimumDegree(G)>=n/2 then userinfo(2,{IsHamiltonian,GraphTheory}, "graph satisfies MinimumDegree(G) >= NumberOfVertices(G)/2 ==> it is hamiltonian"); if nargs=1 then return true; fi; fi; D := DegreeSequence(G); if mul(d-1,d=D) >= 2^n and IndependenceNumber(G)>n/2 then userinfo(2,{IsHamiltonian,GraphTheory}, "graph satisfies IndependenceNumber(G) > NumberOfVertices(G)/2 ==> it's not hamiltonian"); return false; fi; fi; C := Array(1..n); M := Array(1..n); M[1] := 1; if DFS(1,1) then userinfo(2,{IsHamiltonian,GraphTheory}, "cycle found using brute force search ==> it is hamiltonian"); if nargs=2 then cycle := [seq(V[C[i]],i=1..n),V[1]] fi; true else userinfo(2,{IsHamiltonian,GraphTheory}, "graph proven not hamiltonian by brute force search"); false; end if; end; ############################################## ##PROCEDURE(doti) IsPlanar ##ALIAS GraphTheory[IsPlanar] ##CALLINGSEQ ##- IsPlanar('G') ##- IsPlanar('G', 'faces') ## ##PARAMETERS ##- 'G' : graph ##- 'faces' : (optional) name ## ##DESCRIPTION ##- `IsPlanar` will return `true` if the graph is planar and `false` otherwise. ## If a name such as 'faces' is specified, then this name is assigned ## the set of lists of the vertices of each face of the graph. ## The strategy is to use an algorithm by Demoucron, etc. (see Algorithmic Graph Theory by Alan Gibbons). ## ##EXAMPLES ##> with(GraphTheory): ##> K4 := CompleteGraph(4); ##> IsPlanar(K4,'F'); ##< true ##> F; ### [[2, 1, 3], [4, 1, 2], [4, 2, 3], [3, 1, 4]] ##> DrawGraph(K4); ##> NumberOfVertices(K4) - NumberOfEdges(K4) + nops(F) - nops(ConnectedComponents(K4)) - 1; ##< 0 ##> P := SpecialGraphs:-PetersenGraph(); ##> IsPlanar(P); ##< false ##> DrawGraph(P); ## ##TEST ## Try(100, {op(map(convert, F, set))}, {{2, 1, 3}, {4, 1, 2}, {4, 2, 3}, {3, 1, 4}}); ## ##SEEALSO ##- "Contract" ##- "DrawGraph" ## ##XREFMAP ##- "Contract" : Help:GraphTheory[Contract] ##- "DrawGraph" : Help:GraphTheory[DrawGraph] #---------ver. 23, modified by MG IsPlanar := proc(G::GRAPHLN, F::name) local D, W, V, A, T, EW, n, m, N, test, newplanaremb, planaremb, c, ConC, artic, v, joinface1, joinface2, count, articInd1, articInd2, jf1, jf2, x, newface, k, w, b, deg1emb, deg1f,deg1face, wInd, deg1newface, L, GG, Tr, e, P, Cyc, CycLen, H, FaceEmb, f, EMBEDDABLE, VH, CC, Br, B, block, i, dummy, dummyint, dummymin, u, Pat, PatLen, fInd, face, uInd, vInd, face1, face2; D, W, V, A, T, EW := getops(G); n := nops(V); m := NumberOfEdges(G); N := {seq(i,i=1..n)}; if D = directed then return IsPlanar(UnderlyingGraph(G), args[2..nargs]) end if; if W = weighted then return IsPlanar(UnderlyingGraph(G), args[2..nargs]) end if; #(f)# #if m < 9 or n < 5 then return true end if; if n = 0 then if nargs=2 then F := []; end if; return true end if; if n = 1 then if nargs=2 then F := [[V[1]]]; end if; return true end if; if n = 2 then if m=0 then if nargs=2 then F := [[V[1]],[V[2]]] end if; return true else if nargs=2 then F := [[V[1],V[2]]] end if; return true end if; end if; #(a)#== if disconnected then apply to each component if not(IsConnected(G)) then test, newplanaremb := true,{}; planaremb := {}; c := 1; ConC := ConnectedComponents(G); while test and c <= nops(ConC) do test := IsPlanar(InducedSubgraph(G,ConC[c]), 'newplanaremb'); planaremb := [op(planaremb), op(newplanaremb)]; c := c + 1; end do; if test then if nargs=2 then F := planaremb end if; return true else if nargs=2 then F := FAIL end if; return false end if; end if; #(g)# if m > 3*n-6 then if nargs=2 then F := [] end if; return false end if; #(b)#== if seperable then apply to each block #artic := {}; #for v in V do if not(IsConnected(DeleteVertex(G, v))) then artic := artic union {v}; end if; end do; artic := ArticulationPoints(G); if nops(artic) <> 0 then v := artic[1]; #for v in artic do test, newplanaremb := true,[[v]]; #planaremb := {}; c := 1; ConC := ConnectedComponents(DeleteVertex(G,v)); while test and c <= nops(ConC) do test := IsPlanar(InducedSubgraph(G, [op({op(ConC[c]), v})]), 'newplanaremb'); if not(test) then if nargs=2 then F := FAIL end if; return false end if; if c=1 then planaremb := newplanaremb; else joinface1, joinface2 := planaremb[1], newplanaremb[1]; count := 2; while not(member(v, joinface1)) do joinface1 := planaremb[count]; count := count + 1; end do; count := 2; while not(member(v, joinface2)) do joinface2 := newplanaremb[count]; count := count + 1; end do; articInd1, articInd2 := 0, 0; jf1, jf2 := nops(joinface1), nops(joinface2); for x to jf1 do if joinface1[x] = v then articInd1 := x end if; end do; for x to jf2 do if joinface2[x] = v then articInd2 := x end if; end do; if articInd1 < jf1 and articInd2 < jf2 then newface := [seq(joinface1[x], x=1..articInd1), seq(joinface2[x], x=articInd2+1..jf2), seq(joinface2[x], x=1..articInd2), seq(joinface1[x], x=articInd1+1..jf1)]; elif articInd1 < jf1 then newface := [seq(joinface1[x], x=1..articInd1), seq(joinface2[x], x=1..jf2), seq(joinface1[x], x=articInd1+1..jf1)]; elif articInd2 < jf2 then newface := [seq(joinface1[x], x=1..jf1), seq(joinface2[x], x=articInd2+1..jf2), seq(joinface2[x], x=1..articInd2)]; else newface := [seq(joinface1[x], x=1..jf1), seq(joinface2[x], x=1..jf2)]; end if; planaremb := [op({op(planaremb), op(newplanaremb)} minus {joinface1, joinface2}), newface]; end if; c := c + 1; end do; if test then if nargs=2 then F := planaremb end if; return true else if nargs=2 then F := FAIL end if;return false end if; end if;#end do; #(c), (e)# #(d)# #for k to n do k := 1; while not(nops(A[k])=1 or k=n) do k:=k+1; end do; if k < n or nops(A[k])=1 then #if nops(A[k]) = 1 then v := V[k]; w := V[A[k][1]]; b := IsPlanar(DeleteVertex(G, v) , deg1emb ); if not b then if nargs=2 then F := FAIL end if; return false else deg1face := deg1emb[1]; count := 2; while not(member(w,deg1face)) do deg1face := deg1emb[count]; count := count + 1; end do; deg1f := nops(deg1face); for x to deg1f do if deg1face[x] = w then wInd := x end if; end do; if wInd < deg1f then deg1newface := [seq(deg1face[x], x=1..wInd), v, seq(deg1face[x], x=wInd+1..deg1f)] else deg1newface := [seq(deg1face[x], x=1..deg1f), v] end if; if nargs=2 then F := [op(deg1emb minus {deg1face}), deg1newface] end if; return true end if; end if; #if nops(A[k]) = 2 then return IsPlanar(Contract(G,{V[k],V[A[k][1]]}), 'F') end if; #end do; #(main)# #(1)#finding a circuit Cyc in the graph L := GraphInfo:-LabelToInteger(G); GG := GraphInfo:-StandardGraph(G); op(GG); Tr := SpanningTree(GG); e := (Edges(GG) minus Edges(Tr))[1]; ###P := PathGraph(ShortestPath(Tr,e[1],e[2])); P := ShortestPath(Tr,e[1],e[2]); P := Graph( P, 'Trail'(P) ); Cyc := vlist(P); CycLen := nops(Cyc); #(2-5)# H := Graph( Cyc, 'Trail'(op(Cyc),Cyc[1]) ); FaceEmb := {Cyc, [seq(Cyc[CycLen-j],j=0..CycLen-1)] }; #H, FaceEmb := CycleGraph(Cyc), {Cyc, [seq(Cyc[CycLen-j],j=0..CycLen-1)] }; f := 2; EMBEDDABLE := true; #B := {}; #(6)# while (f <> m - n + 2) and EMBEDDABLE do #(7)#find each bridge B of G relative to G_i #(8)#for each B find F(B,G_i hat) VH := {op(vlist(H))}; CC := ConnectedComponents(InducedSubgraph(GG, N minus VH) ); Br := map(j->{j}, Edges(InducedSubgraph(GG,VH)) minus Edges(H)); Br := `union`(seq({`union`(seq( {seq({h,j},j=A[h])}, h=CC[c] ))}, c=1..nops(CC))) union Br; B := [seq(0,i=1..nops(Br))]; block := 0; for i to nops(Br) do dummy := `union`(seq(j,j=Br[i])); dummyint := dummy intersect VH; dummymin := dummy minus VH; if nops(dummyint) > 1 then B[i] := [Br[i], dummyint, dummymin, {seq(`if`( dummyint subset {op(FaceEmb[k])}, [FaceEmb[k],k], NULL), k=1..f)}]; if B[i][4] = {} then if nargs=2 then F := FAIL end if;return false end if; if nops(B[i][4]) = 1 and block = 0 then block := B[i];end if; end if; end do; #B := {seq([b, `union`(seq(j,j=b)) intersect VH,`union`(seq(j,j=b)) minus VH, #{seq(`if`( (`union`(seq(j,j=b)) intersect VH) subset {op(FaceEmb[k])}, [FaceEmb[k],k], NULL), k=1..f)}], b=B)}; #B := {seq( `if`(nops(b[2]) > 1, b, NULL), b=B )}; ## B is the set of [a block, its contact vertices, its vertices, set of faces it can be drawn in] #(9-13)# if for some B, F(B,G_i hat) = 0 then false #if for some B nops(F(B,G_i hat))=1 then F:= F(B, G_i hat) # else B := any bridge and F any face such that F in F(B, G_i hat) # block := 0; # for b in B do # if b[4] = {} then return false, {} # elif nops(b[4])=1 then block := b; break; # else NULL # end if; # end do; if block = 0 then block := B[1];end if; #(14)# find path P_i subset B connecting two points of contact of B of G_i u, v := block[2][1], block[2][2]; if block[3] = {} then Pat := [u,v]; PatLen := 2; else #P := PathGraph(ShortestPath(DeleteEdge(InducedSubgraph(GG, block[3] union {u,v}), {u,v}), u, v)); #Pat := vlist(P); #Pat := ShortestPath(DeleteEdge(InducedSubgraph(GG, block[3] union {u,v}), {u,v}), u,v); if u in A[v] then Pat := ShortestPath(DeleteEdge(InducedSubgraph(GG, block[3] union {u,v}), {u,v}), u,v); else Pat := ShortestPath(InducedSubgraph(GG, block[3] union {u,v}), u,v); fi; P := Graph( Pat, 'Trail'(Pat) ); PatLen := nops(Pat); end if; #(15)# G[i+1] := G[i] + P[i] H := AddVertex(H, convert({op(Pat)} minus {u,v}, list) ); AddEdge(H, { seq({Pat[j],Pat[j+1]}, j=1..PatLen-1) }); #(16)# Obtain a planar embedding G_{i+1}hat of G_{i+1} by drawing P_i in the face F of G_i hat. fInd:= block[4][1][2]; face := FaceEmb[fInd]; uInd, vInd := 0, 0; for x to nops(face) do if face[x] = u then uInd := x elif face[x] = v then vInd := x elif uInd <>0 and vInd<>0 then break else NULL end if; end do; if uInd < vInd then face1 := [seq(face[x], x=uInd..vInd), seq(Pat[PatLen-x],x=1..PatLen-2)]; face2 := [seq(face[x], x=vInd..nops(face)),seq(face[x], x=1..uInd), seq(Pat[x],x=2..PatLen-1)]; else face1 := [seq(face[x], x=vInd..uInd), seq(Pat[x],x=2..PatLen-1)]; face2 := [seq(face[x], x=uInd..nops(face)),seq(face[x], x=1..vInd), seq(Pat[PatLen-x],x=1..PatLen-2)]; end if; FaceEmb := [op({op(FaceEmb)} minus {face}), face1, face2]; #(17-19)# f := f+1; end do; if f = m - n + 2 and EMBEDDABLE then if nargs=2 then F := map(k->map(j->V[j], k),FaceEmb) end if; return true end if; end; ############################################## ##PROCEDURE(doti) IsRegular ##ALIAS GraphTheory[IsRegular] ##CALLINGSEQ ##- IsRegular('G') ##- IsRegular('G', 'd') ## ##PARAMETERS ##- 'G' : graph ##- 'd' : (optional) name ## ##DESCRIPTION ##- An undirected graph 'G' is regular if each vertex has the same degree. ## For example, ~CycleGraph(4)~ is a regular graph of degree 2. ## ##- `IsRegular` will return `true` if the graph is regular and `false` otherwise. ## If a name 'd' is specified, then this name is assigned the degree of the graph. ## If the graph is not regular and a name is specified, then the name is assigned `FAIL`. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2},{2,3},{3,1},{3,4}}); ##> DegreeSequence(G); ##< [2, 2, 3, 1] ##> IsRegular(G); ##< false ##> P := SpecialGraphs:-PetersenGraph(); ##> DegreeSequence(P); ##< [seq(3, i=1..10)] ##> IsRegular(P,'r'); ##< true ##> r; ##< 3 ##> DrawGraph(P); ##> C := SpecialGraphs:-ClebschGraph(); ##> IsRegular(C,'r'); ##< true ##> r; ##< 5 ##> DrawGraph(C); ## ##SEEALSO ##- "Degree" ##- "DegreeSequence" ##- "MinimumDegree" ##- "MaximumDegree" ## ##XREFMAP ##- "Degree" : Help:GraphTheory[Degree] ##- "DegreeSequence" : Help:GraphTheory[DegreeSequence] ##- "MinimumDegree" : Help:GraphTheory[MinimumDegree] ##- "MaximumDegree" : Help:GraphTheory[MaximumDegree] #---------ver. 23, modified by MG IsRegular := proc(G::GRAPHLN, valency::name) local DegSet, n, i, A, k; n, A := nops(vlist(G)), listn(G); DegSet := {}; for i to n while nops(DegSet) < 2 do DegSet := DegSet union {nops(A[i])}; end do; k := nops(DegSet); if nargs=2 then valency := `if`(k=1, DegSet[1], FAIL); end if; evalb(k=1) end; # RP: help page merged with StronglyConnectedComponents IsStronglyConnected := proc(G::GRAPHLN) if nops(vlist(G))=0 then return true end if; evalb( nops( StronglyConnectedComponents(G) ) = 1 ) end: ############################################## ##PROCEDURE(doti) IsTournament ##ALIAS GraphTheory[IsTournament] ##CALLINGSEQ ##- IsTournament('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `IsTournament` returns `true` if the input graph is a tournament. ## It returns `false` otherwise. ## ##- A tournament is a directed graph 'G' that satisfies the following property: ## for every pair of vertices ~u~ and ~v~ in 'G' exactly one of the directed edges ## _[u,v]_ or _[v,u]_ is in 'G'. ## ##EXAMPLES ##> with(GraphTheory): ##> T1 := Digraph({[1,2],[2,3],[3,1]}); ##> IsTournament(T1); ##< true ##> T2 := Digraph({[1,2],[2,3],[3,1],[1,3]}); ##> IsTournament(T2); ##< false ##> T3 := Digraph({[1,2],[2,3]}); ##> IsTournament(T3); ##< false ## ##SEEALSO ##- "AdjacencyMatrix" ##- "HasEdge" ##- "RandomGraphs[RandomTournament]" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "HasEdge" : Help:GraphTheory[HasEdge] #---------ver. 24, author MBM IsTournament := proc(G::GRAPHLN) local n,A,u,v,m; if getdir(G) = undirected then error "graph must be directed"; end if; n := nops(vlist(G)); A := listn(G); for u to n do for v in A[u] do if member(u,A[v]) then return false fi; od od; m := add(nops(A[u]), u=1..n); evalb(m = n*(n-1)/2); end; ############################################## ##PROCEDURE(doti) IsTree ##ALIAS GraphTheory[IsTree] ##CALLINGSEQ ##- IsTree('G') ## ##PARAMETERS ##- 'G' : an undirected graph ## ##DESCRIPTION ##- An undirected graph 'G' on _n_ vertices is a tree if it is connected and ## has exactly _n-1_ edges. ## ##- The `IsTree` command returns `true` if the input graph is a tree, and `false` otherwise. ## ##EXAMPLES ##> with(GraphTheory): ##> T := Graph({{1,2},{1,3}}); # a path ##> IsTree(T); ##< true ##> C := Graph({{1,2},{2,3},{3,1}}); # a cycle ##> IsTree(C); ##< false ## ##SEEALSO ##- "IsAcyclic" ##- "IsConnected" ##- "IsForest" ##- "NumberOfEdges" ##- "NumberOfVertices" ##- "RandomGraphs[RandomTree]" ##- "SpanningTree" ##- "TreeHeight" ## ##XREFMAP ##- "IsAcyclic" : Help:GraphTheory[IsAcyclic] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "IsForest" : Help:GraphTheory[IsForest] ##- "NumberOfEdges" : Help:GraphTheory[NumberOfEdges] ##- "NumberOfVertices" : Help:GraphTheory[NumberOfVertices] ##- "SpanningTree" : Help:GraphTheory[SpanningTree] ##- "TreeHeight" : Help:GraphTheory[TreeHeight] #---------ver. 23, modified by MG IsTree := proc(G::GRAPHLN) if getdir(G) = directed then error "graph must be undirected"; end if; evalb( NumberOfEdges(G) = NumberOfVertices(G) - 1 ) and IsConnected(G); end; # RP: help page merged with IsDirected IsWeighted := proc(G::GRAPHLN) evalb(getwt(G) = weighted) end; ############################################## ##PROCEDURE(doti) LineGraph ##ALIAS GraphTheory[LineGraph] ##CALLINGSEQ ##- LineGraph('G') ## ##PARAMETERS ##- 'G' : undirected graph ## ##DESCRIPTION ##- `LineGraph` will create the line graph _L(G)_ of a given graph 'G'. ## The vertices of _L(G)_ are the edges of 'G' and two vertices are connected by an edge ## if the corresponding edges in 'G' are adjacent. ## ##EXAMPLES ##> with(GraphTheory): ##> K4 := CompleteGraph(4); ##> DrawGraph(K4); ##> L := LineGraph(K4): ##> DrawGraph(L); ##> Vertices(L); ### ["2-3", "1-3", "1-2", "2-4", "3-4", "1-4"] ##> Edges(GraphComplement(L)); # these edges are not adjacent in K4 ##< {{"2-3", "1-4"}, {"1-3", "2-4"}, {"3-4", "1-2"}} ## ##TEST ## Try(100, {op(Vertices(L))}, {"2-3", "1-3", "1-2", "2-4", "3-4", "1-4"}); ## ##SEEALSO ##- "DrawGraph" ##- "Edges" ##- "GraphComplement" ##- "Vertices" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "GraphComplement" : Help:GraphTheory[GraphComplement] ##- "Vertices" : Help:GraphTheory[Vertices] #---------ver. 23, modified by MG LineGraph := proc(G::GRAPHLN, r::positive) local V, A, E, LV, LG, LA, LL, m, k, i, j, B, C, LVstring, s1, s2, L, v, w, ratio, newG, vp, newvp; ratio := `if`(nargs > 1, r, .5); if getdir(G) = directed then error "expected an undirected graph, but received a directed graph"; end if; V, A, E := vlist(G), listn(G), convert(GraphInfo:-Edges(G), list); m := nops(E); LV := [seq({V[e[1]], V[e[2]]},e=E)]; L := GraphInfo:-LabelToInteger(G); LVstring := Array([""$m]); for i to m do s1, s2 := convert(op(1,LV[i]), string), convert(op(2,LV[i]), string); if L[op(1,LV[i])] > L[op(2,LV[i])] then s1,s2 := s2,s1 fi; LVstring[i] := sprintf("%s-%s", s1, s2); od; #LG := Graph(LVstring); #LA := listn(LG); LA := Array([{}$m]); LL := table(); for k to m do LL[E[k]] := k end do; for k to m do i, j := op(E[k]); B, C := A[i] minus {j}, A[j] minus {i}; LA[k] := {seq (LL[{i,b}],b=B), seq(LL[{j,c}],c=C)}; end do; newG := GRAPHLN(undirected, unweighted, [seq(LVstring[aux], aux=1..m)], LA, GRAPH_TABLE_NAME(), 0); #attribs GraphInfo:-SetAttrib(newG, [$1..m], map( e -> map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), e ), GraphInfo:-GetAttrib(G, E))); #---Drawing vp := GraphInfo:-GetVPos(G, VP_FIXED); if nops(vp)=0 then vp := GraphInfo:-GetVPos(G, VP_USER); fi; if nops(vp)=0 then vp := GraphInfo:-GetVPos(G, VP_DEFAULT); fi; if nops(vp)<>0 then newvp := Array(1..m); for i to m do v,w := E[i][1],E[i][2]; newvp[i] := evalf(ratio*vp[v] + (1-ratio)*vp[w]); od; GraphInfo:-SetVPos(newG, VP_FIXED, [seq(newvp[i], i=1..m)]); fi; return newG; end proc: ############################################## ##PROCEDURE(doti) MakeDirected ##ALIAS GraphTheory[MakeDirected] ##CALLINGSEQ ##- MakeDirected('G') ##- MakeDirected('G', 'M') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'M' : (optional) matrix ## ##DESCRIPTION ##- `MakeDirected` will return a directed graph with vertices from 'G'. ## For each edge in 'G', the arcs in both directions are in the new graph. ## If 'G' is a weighted graph, then a matrix 'M' may be included as part of ## the input; in such a case the arc weights are taken from the entries ## of 'M'. ## ##EXAMPLES ##> with(GraphTheory): ##> G := MakeDirected(CycleGraph(4)): ##> Edges(G); ##< {[4, 3], [3, 2], [1, 4], [2, 1], [2, 3], [3, 4], [4, 1], [1, 2]} ##> G := MakeWeighted(CycleGraph(4)): ##> M := Matrix([[0,0,0,1],[2,0,1,3],[0,1,0,4],[5,0,4,0]]): ##> G := MakeDirected(G, M): ##> Edges(G,'weights'); ##< {[[1,4],1],[[2,1],2],[[2,3],1],[[2,4],3],[[3,2],1],[[3,4],4],[[4,1],5],[[4,3],4]} ## ##SEEALSO ##- "IsDirected" ##- "MakeWeighted" ##- "UnderlyingGraph" ## ##XREFMAP ##- "IsDirected" : Help:GraphTheory[IsDirected] ##- "MakeWeighted" : Help:GraphTheory[MakeWeighted] ##- "UnderlyingGraph" : Help:GraphTheory[UnderlyingGraph] #---------ver. 23, modified by MG MakeDirected := proc(G::GRAPHLN) local EW, D, W, V, A, T, M; D, W, V, A, T, EW := getops(G); if D = directed then error"expected an undirected graph, but received a directed graph"; end if; if nargs = 1 then M := `if`(W=weighted, Matrix(EW,shape=[]),0); GRAPHLN( directed, W, V, A, eval(T), M) elif nargs = 2 then #if not (type(args[2],Matrix)) then error"2nd argument must be a matrix";end if; M := Matrix(args[2],shape=[]); Digraph(V,M,W); else error"expecting at most 2 arguments" end if; end; ############################################## ##PROCEDURE(doti) MakeWeighted ##ALIAS GraphTheory[MakeWeighted] ##CALLINGSEQ ##- MakeWeighted('G') ##- MakeWeighted('G', 'M') ## ##PARAMETERS ##- 'G' : unweighted graph ##- 'M' : (optional) matrix ## ##DESCRIPTION ##- `MakeWeighted` will return a graph with vertices and edges from 'G'. ## If 'M' is part of the input, then the edge weights are taken from it; ## otherwise edge weights are assumed to be 1. If 'G' is undirected, then ## 'M' is assumed to be a symmetric matrix. ## ##- For efficiency, use ~datatype=integer~ for wordsize integer weights ## and ~datatype=float[8]~ for numerical (decimal) edge weights. ## ##- To read or modify the edge weights of a weighted graph, use the "GetEdgeWeight" and "SetEdgeWeight" commands. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2},{2,3},{3,1}}); ##> M := Matrix([[0,2,3],[2,0,1],[3,1,0]]); ##> H1 := MakeWeighted(G, M); ##> Edges(H1); ##< {{1, 2}, {1, 3}, {2, 3}} ##> WeightMatrix(H1); ##<(verification="LinearAlgebra:-Equal") M ##> M := Matrix(M,datatype=float[8],shape=symmetric); ##> H2 := MakeWeighted(G,M); ##> WeightMatrix(H2); ##<(verification="LinearAlgebra:-Equal") M ## ##SEEALSO ##- "GetEdgeWeight" ##- "IsWeighted" ##- "MakeDirected" ##- "SetEdgeWeight" ##- "UnderlyingGraph" ##- "WeightMatrix" ## ##XREFMAP ##- "GetEdgeWeight" : Help:GraphTheory[GetEdgeWeight] ##- "IsWeighted" : Help:GraphTheory[IsWeighted] ##- "MakeDirected" : Help:GraphTheory[MakeDirected] ##- "SetEdgeWeight" : Help:GraphTheory[SetEdgeWeight] ##- "UnderlyingGraph" : Help:GraphTheory[UnderlyingGraph] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] #---------ver. 23, modified by MG #---------ver. 24, modified by MBM MakeWeighted := proc(G::GRAPHLN) local EW, D, W, V, A, T, M; if nargs = 1 then M := AdjacencyMatrix(G) elif nargs = 2 then M := args[2]; if not (type(M,Matrix)) then error"2nd argument must be a Matrix"; end if; else error"expecting at most 2 arguments" end if; D, W, V, A, T, EW := getops(G); if W = weighted then error"expected an unweighted, but received a weighted graph"; end if; M := Matrix(M,shape=[`if`(D=directed, NULL, symmetric)]); Graph(D, V, M, weighted) #GRAPHLN( D, weighted, V, A, eval(T), M); end; ######################################### ##PROCEDURE(doti) MaxFlow ##ALIAS GraphTheory[MaxFlow] ##CALLINGSEQ ##- MaxFlow('G', 's', 't') ## ##PARAMETERS ##- 'G' : weighted graph ##- 's' : vertex of the graph (source) ##- 't' : vertex of the graph (sink) ## ##DESCRIPTION ##- `MaxFlow` will return the optimal value for the max flow problem along with ## an optimal flow (as a Matrix). ## The strategy is the Push-Relabel (Push-Preflow) algorithm due to Goldberg et al. ## (see Introduction to Algorithms, Cormen, Leiserson, Rivest, 2nd edition) ## ##EXAMPLES ##> with(GraphTheory): ##> A := Matrix([[0,1,0,4,0,0],[0,0,1,0,3,0],[0,1,0,0,0,1],[0,0,3,0,1,0],[0,0,0,1,0,4],[0,0,0,0,0,0]]); ##> N := Digraph(A, weighted); ##> IsNetwork(N); ##< {1}, {6} ##> DrawNetwork(N); ##> MaxFlow(N, 1, 6); ## ##TEST ## f, F := MaxFlow(N, 1, 6): ## Try(100,f,4); ## Try[LinearAlgebra:-Equal](101, F, Matrix(6,6,{(4,3)=2,(2,5)=2,(1,4)=3,(5,6)=3,(3,2)=1,(3,6)=1,(4,5)=1,(1,2)=1},datatype=anything,storage=sparse,order=Fortran_order,shape=[])); ## ##SEEALSO ##- "FlowPolynomial" ##- "IsCutSet" ##- "IsNetwork" ##- "WeightMatrix" ## ##XREFMAP ##- "FlowPolynomial" : Help:GraphTheory[FlowPolynomial] ##- "IsCutSet" : Help:GraphTheory[IsCutSet] ##- "IsNetwork" : Help:GraphTheory[IsNetwork] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] #---------ver. 23, modified by MG MaxFlow := proc(G::GRAPHLN, ss::VERTEXTYPE, tt::VERTEXTYPE) local D, W, V, A, T, c, n, L, E, Push, df, cf, Relabel, Update, Ef, u, v, h, e, f, x, OverFlowing, rel, s, t, i, j, maxflow, S, ToS; #mytime, timecount; #remove D, W, V, A, T, c := getops(G); n := nops(V); L := GraphInfo:-LabelToInteger(G); E := GraphInfo:-Edges(G, 'weights'); s, t := L[ss], L[tt]; if W=unweighted then error"1st argument must be a weighted graph. Use `MakeWeighted`" end if; if not(member(ss,V) and member(tt,V)) then error "2nd and 3rd argument must be vertices of the graph" end if; #Push proc Push := proc(u,v) #print(u,v); #print("eu,ev,fuv,cfuv", e[u],e[v],f[u,v], cf[u,v]); df[u,v] := min(e[u],cf[u,v]); #print(%,"A"); f[u,v] := f[u,v] + df[u,v];#print(%,"B"); f[v,u] := -f[u,v];#print(%,"C"); e[u] := e[u] - df[u,v];#print(%, "D"); e[v] := e[v] + df[u,v];#print(%,"E"); end; #Relabel proc Relabel := proc(u) S := seq(h[v],v={seq(`if`(Ef[u,j]=1, j, NULL),j=1..n)}); h[u] := `if`(S=NULL, infinity, 1 + min(S)); end; # Init a preflow # timecount := 0; #remove for u to n do h[u] := 0; e[u] := 0;end do; for x in E do f[x[1][1],x[1][2]] := 0; f[x[1][2],x[1][1]] := 0;end do; h[s] := n; for u in A[s] do f[s,u] := c[s,u]; f[u,s] := -c[s,u]; e[u] := c[s,u]; e[s] := e[s] - c[s,u]; end do; #update residual newtwork Update := proc() local i,j; for i to n do for j to n do if i<>j then Ef[i,j] := `if`(c[i,j] > f[i,j], 1, 0); cf[i,j] := `if`(f[i,j]=infinity, 0, c[i,j] - f[i,j]); end if; end do; end do; end; #Init OverFlowing := {seq( `if`(e[u]>0, u, NULL), u=1..n) } minus {s,t}; #mytime := time(): #remove Update(); #timecount := timecount + time()-mytime; #remove #main while OverFlowing <>{} do u := OverFlowing[1]; for v to n do if Ef[u,v] = 1 and h[u] = h[v] + 1 then Push(u,v); if v<>s and v<>t then OverFlowing := OverFlowing union {v};end if; #if u<>s and u<>t and e[u] > 0 ... if e[u] = 0 then OverFlowing := OverFlowing minus {u};end if; #mytime := time(): #remove #Update(); #changed to the following lines Ef[u,v] := `if`(c[u,v] > f[u,v], 1, 0); cf[u,v] := `if`(f[u,v]=infinity, 0, c[u,v] - f[u,v]); Ef[v,u] := `if`(c[v,u] > f[v,u], 1, 0); cf[v,u] := `if`(f[v,u]=infinity, 0, c[v,u] - f[v,u]); #timecount := timecount + time()-mytime; #remove end if; end do; rel := true; for v in {seq(`if`(Ef[u,j]=1, j, NULL),j=1..n)} do if h[u] > h[v] then rel := false; break; end if; end do; if rel then Relabel(u); end if; end do; maxflow := table(); for e in E do i, j := e[1][1],e[1][2]; if f[i,j] > 0 then maxflow[V[i],V[j]] := f[i,j];end if; end do; #print(op(f)); remove ToS := {seq(`if`(member(s, A[i]), i, NULL), i=1..n)}; #lprint(timecount); #remove for i in ({$1..n} minus (ToS union A[s])) do f[s,i] := 0; end do; add(f[s,i], i={$1..n}), Matrix(n, n, convert( map(x->op(map(v->L[v], [lhs(x)])) = rhs(x), op(2,eval(maxflow))), set ), storage=sparse); end; ############################################# ##PROCEDURE(doti) MaximumClique ##TITLE CliqueNumber ##TITLE MaximumClique ##ALIAS GraphTheory[MaximumClique], GraphTheory[CliqueNumber] ##CALLINGSEQ ##- CliqueNumber('G') ##- MaximumClique('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `CliqueNumber` returns the number of vertices in a largest clique of 'G'. ## `MaximumClique` returns a list of vertices which comprise a largest clique. ## The strategy is a branch-and-bound backtracking algorithm using the greedy color bound. ## (see Kreher and Stinson, 1999) ## ##EXAMPLES ##> with(GraphTheory): ##> G := GraphComplement(CompleteGraph(3,4)); ##> DrawGraph(G); ##> CliqueNumber(G); ##< 4 ##> MaximumClique(G); ##< [4, 5, 6, 7] ## ##SEEALSO ##- "IndependenceNumber" ##- "IsClique" ##- "MaximumIndependentSet" ## ##XREFMAP ##- "IndependenceNumber" : Help:GraphTheory[IndependenceNumber] ##- "IsClique" : Help:GraphTheory[IsClique] ##- "MaximumIndependentSet" : Help:GraphTheory[MaximumIndependentSet] #---------ver. 23, modified by MG MaximumClique := proc(G::GRAPHLN) local ConnectedMaximumClique, Opt1Size, Opt1Clique, W, CurrClique, CurrSize; ConnectedMaximumClique:= proc(G) local MaxClique, OptSize, OptClique, V, A, n, C, x, mycount; MaxClique := proc(G, q) local y, M, tt; mycount := mycount+1: if q > OptSize then OptSize := q; OptClique := [seq(x[i], i=0..q-1)]; userinfo(2, MaximumClique,"Largest clique so far:",OptClique,"size",OptSize,"found at state space node number", mycount); end if; # Compute the choice set if q = 0 then C[0] := {seq (i,i=1..n)} else tt:=x[q-1]: C[q] := `intersect`(A[x[q-1]],{seq(i,i=tt+1..n)},C[q-1]); end if; # M := q + GreedyColor(InducedSubgraph(G,map(k->V[k],C[q])))[1]; #GreedyBound(G, C, q); M:= q + nops(C[q]); #SizeBound for y in C[q] do if M <= OptSize then return;end if; x[q] := y; procname(G, q+1); end do; end; OptSize := 0: mycount := 0: V, A := vlist(G),listn(G): n := nops(V): if n=0 then return [] end if; MaxClique(G, 0); userinfo(2, MaximumClique, "Size of state space: ", mycount); map(k->V[k],OptClique); end; if IsConnected(G) then return ConnectedMaximumClique(G) fi; Opt1Size := 0; Opt1Clique := []; for W in ConnectedComponents(G) do CurrClique := ConnectedMaximumClique(InducedSubgraph(G,W)); CurrSize := nops(CurrClique); if CurrSize > Opt1Size then Opt1Size := CurrSize; Opt1Clique := CurrClique; end if; end do; return Opt1Clique; end; ############################################## ##PROCEDURE(doti) MinimumDegree ##ALIAS GraphTheory[MinimumDegree] ##CALLINGSEQ ##- MaximumDegree('G') ##- MinimumDegree('G') ## ##PARAMETERS ##- 'G' : undirected graph ## ##DESCRIPTION ##- `MaximumDegree` returns the largest degree of the graph. ##- `MaximumDegree` returns the smallest degree of the graph. ##- A graph is regular its minimum degree is equal to its maximum degree. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph(Trail(1,2,3,4,2,5,6,7,2,8,1)); ##> MaximumDegree(G); ##< 6 ##> MinimumDegree(G); ##< 2 ##> DrawGraph(G); ## ##SEEALSO ##- "Degree" ##- "DegreeSequence" ##- "IsRegular" ## ##XREFMAP ##- "Degree" : Help:GraphTheory[Degree] ##- "DegreeSequence" : Help:GraphTheory[DegreeSequence] ##- "IsRegular" : Help:GraphTheory[IsRegular] #---------ver. 23, modified by MG MaximumDegree := proc(G::GRAPHLN) local n, A; n, A := nops(vlist(G)), listn(G); if getdir(G)=directed then error "the input graph must be undirected"; end if; max( seq ( nops(A[i]), i=1..n ) ); end; MinimumDegree := proc(G::GRAPHLN) local n, A; n, A := nops(vlist(G)), listn(G); if getdir(G)=directed then error "the input graph must be undirected"; end if; min( seq ( nops(A[i]), i=1..n ) ); end; ############################################## ##PROCEDURE(doti) MaximumIndependentSet ##TITLE IndependenceNumber ##TITLE MaximumIndependentSet ##ALIAS GraphTheory[MaximumIndependentSet], GraphTheory[IndependenceNumber] ##CALLINGSEQ ##- IndependenceNumber('G') ##- MaximumIndependentSet('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `IndependenceNumber` returns the cardinality of a largest independent set of the graph 'G'. ## This is equal to the "CliqueNumber" of the complement of 'G'. ## `MaximumIndependentSet` returns a list of vertices comprising a maximum independent set of 'G'. ## The strategy is a branch-and-bound backtracking algorithm using the greedy color bound ## (see Kreher and Stinson, 1999). ## ##EXAMPLES ##> with(GraphTheory): ##> G := CompleteGraph(3, 4); ##> DrawGraph(G); ##> IndependenceNumber(G); ##< 4 ##> MaximumIndependentSet(G); ##< [4, 5, 6, 7] ##> C := GraphComplement(G): ##> DrawGraph(C); ##> CliqueNumber(C); ##< 4 ##> MaximumClique(C); ##< [4, 5, 6, 7] ## ##SEEALSO ##- "CliqueNumber" ##- "GraphComplement" ##- "MaximumClique" ## ##XREFMAP ##- "CliqueNumber" : Help:GraphTheory[CliqueNumber] ##- "GraphComplement" : Help:GraphTheory[GraphComplement] ##- "MaximumClique" : Help:GraphTheory[MaximumClique] #---------ver. 23, modified by MG MaximumIndependentSet:= proc(G::GRAPHLN) MaximumClique(GraphComplement(G)) end; ########################################################################## ##PROCEDURE(doti) MinimalSpanningTree ##TITLE MinimalSpanningTree ##TITLE KruskalsAlgorithm ##TITLE PrimsAlgorithm ##ALIAS GraphTheory[MinimalSpanningTree], GraphTheory[KruskalsAlgorithm], GraphTheory[PrimsAlgorithm] ##AUTHOR Mahdad Khatarinejad and Michael Monagan ##DATE August 2005 ##CALLINGSEQ ##- MinimalSpanningTree('G') ##- MinimalSpanningTree('G','w') ##- KruskalsAlgorithm('G','w') ##- PrimsAlgorithm('G','w') ## ##PARAMETERS ##- G : an undirected graph, weighted or unweighted ##- w : (optional) name ## ##DESCRIPTION ##- `MinimalSpanningTree`, `KruskalsAlgorithm`, and `PrimsAlgorithm` all return a ## spanning tree of the undirected graph 'G' with minimum possible weight. ## If the graph 'G' is unweighted, each edge is considered to have weight 1. ## ##- If the optional second paramameter 'w' is given, it is assigned the weight ## of the minimal spanning tree. ## ##- The routine `PrimsAlgorithm` uses Prim's algorithm for computing the minimal ## spanning tree and the routine `KruskalsAlgorithm` uses Kruskal's algorithm. ## The routine `MinimalSpanningTree` uses Kruskal's algorithm. ## ##- Setting ~infolevel[KruskalsAlgorithm] := 4;~ and ~infolevel[PrimsAlgorithm] := 4;~ ## will result in some information being printed out indicating the steps of the ## two algorithms. ## ##EXAMPLES ##> with(GraphTheory): ##> A:= Matrix([[0, 1, 0, 4, 0, 0], ## [1, 0, 1, 0, 3, 0], ## [0, 1, 0, 3, 0, 1], ## [4, 0, 3, 0, 1, 0], ## [0, 3, 0, 1, 0, 4], ## [0, 0, 1, 0, 4, 0]]): ## ##> G:= Graph(A): ##> T := MinimalSpanningTree(G): ##> Edges(T,weights); ##< {[{1, 2}, 1], [{2, 3}, 1], [{3, 4}, 3], [{3, 6}, 1], [{4, 5}, 1]} ##> add(GetEdgeWeight(G,e), e=Edges(T)); ##< 7 ##> S := SpanningTree(G): ##> add(GetEdgeWeight(G,e), e=Edges(S)); ##> PrimsAlgorithm(G, 'w'): ##> w; ##< 7 ##> G := RandomGraphs:-RandomGraph(100, 0.5, weights=0.0 .. 1.0, connected): ## ##> infolevel[KruskalsAlgorithm] := 4: ##> T := KruskalsAlgorithm(G): ### KruskalsAlgorithm: "constructing minimal spanning tree on 100 vertices." ### KruskalsAlgorithm: "using Kruskal's algorithm at time 0.19" ### KruskalsAlgorithm: "making heap of 2491 edges at time: 0.2" ### KruskalsAlgorithm: "finding the edges at time: 0.28" ### KruskalsAlgorithm: "exiting Kruskal's algorithm at time 0.349" ## ##SEEALSO ##- "AllPairsDistance" ##- "Diameter" ##- "SpanningTree" ##- "WeightMatrix" ## ##XREFMAP ##- "AllPairsDistance" : Help:GraphTheory[AllPairsDistance] ##- "Diameter" : Help:GraphTheory[Diameter] ##- "SpanningTree" : Help:GraphTheory[SpanningTree] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] #---------ver. 23, modified by MG KruskalsAlgorithm := proc(G::GRAPHLN,weight::name) local V, A, E, n, M, H, e, W, Walk, Link, i, j, u, v, t, T; # Author: MBM August 2005. if getdir(G) = directed then error "the input graph must be undirected"; end if; V, A := vlist(G), listn(G); n := nops(V); userinfo(2,KruskalsAlgorithm,sprintf("constructing minimal spanning tree on %d vertices.",n)); if n=0 then return G end if; # M := AdjacencyMatrix(G); M := `if`(getwt(G)='weighted', WeightMatrix(G), AdjacencyMatrix(G)); userinfo(3,KruskalsAlgorithm,sprintf("using Kruskal's algorithm at time %g",time())); E := [seq(seq(`if`(i e2[2]) end, op(E) ); userinfo(3,KruskalsAlgorithm,sprintf("finding the edges at time: %g",time())); ################################################################################## # The main difficulty in Kruskal's algorithm is identifying when insertion of a # new edge into the components of the minimal spanning tree constructed so far # would cause a cycle, and merging two components when an edge is inserted. # We use an array A of links to represent the components, each a set of vertices. # A[i] = u means vertex i is in the same component (sub tree) as vertex u. # A = [0,5,0,3,0,2,5,0] means we have 4 components: {1}, {2,5,6,7}, {3,4}, {8} # Walk(i) finds the last vertex on the chain starting at i. E.g. Walk(6) = 5. # Thus Walk(i) = Walk(j) means vertex i and j are in the same component. # Link(i,u) links ALL vertices on the chain starting at i to be u. # E.g. Link(6,3) causes assignments A[6] := 3; A[2] := 3; A[5] := 3; resulting in # A = [0,3,0,3,3,3,5,0] which means 3 components: {1}, {2,3,4,5,6,7}, {8} # Author: MBM August 2005. ################################################################################## Walk := proc(i) local j,k; j := i; k := A[i]; while k<>0 do j := k; k := A[j]; od; j; end: Link := proc(i,u) local j,k; j := i; while j<>0 and j<>u do k := j; j := A[j]; A[k] := u; od; # MBM: (j,A[j]) := (A[j],u); is not evaluated correctly in Maple 10 NULL; end; A := Array(1..n,fill=0); # contains components of the MST E := Array(1..n); # contains edges of the MST W := 0; # weight of the MST t := 1; while t u in MST E := Array(1..n); # contains edges of the MST W := 0; # weight of the MST t := 1; u := 1; F[u] := 1; H := heap[new]( proc(e1,e2) evalb(e1[2] > e2[2]) end ); for v in A[u] do if F[v]=0 then e := [[u,v],M[u,v]]; heap[insert](e,H); fi; od; while t with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(); ##> G := Mycielski(P); ##> ChromaticNumber(G, 'bound'); ##< 3 .. 4, [0, 1, 0, 1, 2, 1, 2, 0, 2, 0, 0, 1, 0, 1, 2, 1, 2, 0, 2, 0, 3] ##> ChromaticNumber(G); ##< 4 ## ##SEEALSO ##- "ChromaticNumber" ## ##XREFMAP ##- "ChromaticNumber" : Help:GraphTheory[ChromaticNumber] #---------ver. 23, modified by MG Mycielski := proc(G::GRAPHLN) local j,jj,D, W, V,A,AA,T, EW, st,v,n, newG, vp, newvp, i, ratio, att, E; # # builds a (k+1)-chromatic triangle-free graph from a k-chromatic #triangle-free graph # if nargs <> 1 then error "expected 1 argument" end if; D, W, V, AA, T, EW := getops(G); if D=directed or W=weighted then error "The graph must be undirected and unweighted. Use UnderlyingGraph"; end if; n := nops(V): st:=n+1; for v in V do if type(v,integer) then if v >= st then st:=v+1 end if: end if: end do: A := Array(1..2*n+1, AA, fill={}); for j to n do A[n+j] := AA[j] union {2*n+1}; for jj in AA[j] do A[jj] := A[jj] union {n+j}; end do: end do: A[2*n+1]:= {$(n+1..2*n)}; newG := GRAPHLN(undirected, unweighted, [op(V),$(st..st+n)], eval(A), GRAPH_TABLE_NAME(), 0); #---attribs E := op( GraphInfo:-Edges(G) ); att := map(x->map(a->`if`(member(lhs(a), GT_DRAW_ATTRIBS), NULL, a), x), GraphInfo:-GetAttrib(G, [$1..n, E])); GraphInfo:-SetAttrib(newG, [$1..n, E], att); #---Drawing vp := GraphInfo:-GetVPos(G, VP_FIXED); if nops(vp)<>0 then newvp := Array(1..2*n+1, [op(vp)]); newvp[2*n+1] := sum(vp[aux], aux=1..n)/n; ratio := 1./3; for i to n do newvp[n+i] := evalf(ratio*newvp[2*n+1] + (1-ratio)*vp[i]); od; GraphInfo:-SetVPos(newG, VP_FIXED, [seq(newvp[i], i=1..2*n+1)]); fi; return newG; end proc; # RP: help page merged with Arrivals Neighbors := proc (G::GRAPHLN, v::VERTEXTYPE) local V, A, n, i, j, Nbrs; if getdir(G)=directed then Nbrs := Neighbors(UnderlyingGraph(G),args[2..nargs]); else V, A := vlist(G), listn(G); if nargs=1 then n := nops(V); Nbrs := [seq( [seq( V[j], j=A[i] )], i=1..n )]; else if member(v,V,'i') then Nbrs := [seq( V[j], j=A[i] )]; else error "%1 is not a vertex of the given graph.",v; fi; end if; end if; end; ############################################ ##PROCEDURE(doti) NumberOfEdges ##TITLE NumberOfEdges ##TITLE NumberOfVertices ##ALIAS GraphTheory[NumberOfEdges], GraphTheory[NumberOfVertices] ##CALLINGSEQ ##- NumberOfEdges('G') ##- NumberOfVertices('G') ## ##PARAMETERS ##- 'G' : a graph ## ##DESCRIPTION ##- `NumberOfEdges` will return the number of edges (or arcs) in 'G'. ##- `NumberOfVertices` will return the number of vertices in 'G'. ## ##EXAMPLES ##> with(GraphTheory): ##> K4 := CompleteGraph(4); ##> NumberOfVertices(K4); ##< 4 ##> NumberOfEdges(K4); ##< 6 ##> H := Digraph( Trail(1,2,3,1,4,3), Trail(4,2,1,3) ): ##> NumberOfEdges(H); ##< 8 ##> NumberOfVertices(H); ##< 4 ## ##SEEALSO ##- "Edges" ##- "Graph" ##- "Digraph" ##- "Vertices" ## ##XREFMAP ##- "Edges" : Help:GraphTheory[Edges] ##- "Graph" : Help:GraphTheory[Graph] ##- "Digraph" : Help:GraphTheory[Digraph] ##- "Vertices" : Help:GraphTheory[Vertices] #---------ver. 23, modified by MG NumberOfVertices := proc(G::GRAPHLN) nops(vlist(G)); end; NumberOfEdges := proc(G::GRAPHLN) local n, A, d; n,A := nops(vlist(G)),listn(G); d := add(nops(A[i]), i=1..n); if getdir(G)=undirected then d/2 else d end if; end; ############################################# ##PROCEDURE(doti) NumberOfSpanningTrees ##ALIAS GraphTheory[NumberOfSpanningTrees] ##CALLINGSEQ ##- NumberOfSpanningTrees('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `NumberOfSpanningTrees` will return the number of labelled spanning trees of 'G'. ## The strategy is to evaluate the determinant of a certain matrix related to the graph ## (see Introduction to Graph Theory, by Douglas B. West) ## ##EXAMPLES ##> with(GraphTheory): ##> K3 := CompleteGraph(3); ##> NumberOfSpanningTrees(K3); ##< 3 ##> K4 := CompleteGraph(4); ##> NumberOfSpanningTrees(K4); ##< 16 ## ##SEEALSO ##- "IsTree" ##- "SpanningTree" ## ##XREFMAP ##- "IsTree" : Help:GraphTheory[IsTree] ##- "SpanningTree" : Help:GraphTheory[SpanningTree] #---------ver. 23, modified by MG NumberOfSpanningTrees := proc (G::GRAPHLN) local n, D, W, V, A, T, EW, Adj, Q, e, i ; D, W, V, A, T, EW := getops(G); n := nops(V); #Adj := copy(AdjacencyMatrix(G)); Adj := AdjacencyMatrix(G); Q := -Adj; Q[1,1]:=1; for i from 2 to n do Q[i,1]:=0; Q[1,i]:=0; Q[i,i]:= nops(A[i]); end do; LinearAlgebra:-Determinant(Q); end; # RP: hidden export # ############################################ # #PROCEDURE(doti) OptimalVertexColoring # #ALIAS GraphTheory[OptimalVertexColoring] # #CALLINGSEQ # #- OptimalVertexColoring('G') # # # #PARAMETERS # #- 'G' : undirected graph # # # #DESCRIPTION # #- `OptimalVertexColoring` will return the list of color classes of an optimal proper coloring of vertices. # # The algorithm uses a backtracking technique. # # # # # #EXAMPLES # #> with(GraphTheory): # #> P := SpecialGraphs:-PetersenGraph(): # #> OptimalVertexColoring(P); # #< [[1, 3, 8, 10], [2, 4, 6], [5, 7, 9]] # # # #SEEALSO # #- "ChromaticNumber" #---------ver. 23, modified by MG OptimalVertexColoring := proc(G::GRAPHLN) local VC; ChromaticNumber(G, 'VC'); VC end; # RP: hidden export # ############################################ # #PROCEDURE(doti) OptimalEdgeColoring # #ALIAS GraphTheory[OptimalEdgeColoring] # #CALLINGSEQ # #- OptimalEdgeColoring('G') # # # #PARAMETERS # #- 'G' : undirected graph # # # #DESCRIPTION # #- `OptimalEdgeColoring` will return the list of color classes of an optimal proper edge coloring. # # The algorithm uses a backtracking technique. # # # # # #EXAMPLES # #> with(GraphTheory): # #> C5 := CycleGraph(5); # #> EC := OptimalEdgeColoring( C5 ); # #> nops(EC); # three colors are needed # #< 3 # #> C6 := CycleGraph(6); # #> EC := OptimalEdgeColoring( C6 ); # #> nops(EC); # two colors needed # #< 2 # #SEEALSO # #- "ChromaticIndex" #---------ver. 23, modified by MG OptimalEdgeColoring := proc(G::GRAPHLN) local EC; EdgeChromaticNumber(G, 'EC'); EC end; #---------ver. 23, modified by MG # RP: help page combined with Degree InDegree := proc(G::GRAPHLN, v::VERTEXTYPE) local A, L, d, j, a; if not v in vlist(G) then error "%1 is not a vertex of the graph", v; end if; if getdir(G) = 'undirected' then error"expected a directed graph--use Degree";end if; A := listn(G); L := GraphInfo:-LabelToInteger(G); d := 0; j := L[v]; for a in A do if j in a then d := d + 1;end if; end do; d; end; # RP: help page combined with Degree OutDegree := proc(G::GRAPHLN,v::VERTEXTYPE) local A, L; if not v in vlist(G) then error "%1 is not a vertex of the graph", v; end if; if getdir(G) = undirected then error"expected a directed graph--use Degree";end if; A := listn(G); L := GraphInfo:-LabelToInteger(G); nops(A[L[v]]); end; ############################################## ##PROCEDURE(doti) RelabelVertices ##ALIAS GraphTheory[RelabelVertices] ##CALLINGSEQ ##- RelabelVertices('G','S') ## ##PARAMETERS ##- 'G' : a graph ##- 'V' : a list of vertex labels ## ##DESCRIPTION ##- `RelabelVertices`('G','V') returns a new graph with vertex labels ## changed to be those in 'V'. The graph 'G' is not modified. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2},{1,3},{1,4}}): ##> Vertices(G); ##< [1, 2, 3, 4] ##> Edges(G); ##< {{1,3}, {1,2}, {1,4}} ##> H := RelabelVertices(G,[a,b,c,d]): ##> Vertices(H); ##< [a, b, c, d] ##> Edges(H); ##< {{a, b}, {c, a}, {d, a}} ## ##SEEALSO ##- "GraphInfo[StandardGraph]" ##- "Vertices" ## ##XREFMAP ##- "Vertices" : Help:GraphTheory[Vertices] #---------ver. 23, modified by MG RelabelVertices := proc(G::GRAPHLN, V::list(VERTEXTYPE)) local n, ip; n := nops(vlist(G)); if nops(V) <> n or nops({op(V)}) <> n then error "wrong number of vertices in %1", V; end if; makevertices(G,V); end; ############################################## ##PROCEDURE(doti) SeidelSpectrum ##ALIAS GraphTheory[SeidelSpectrum] ##CALLINGSEQ ##- SeidelSpectrum('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `SeidelSpectrum` will return the Seidel spectrum of the eigenvalues of a specified graph. ## That is the eigenvalues of the matrix _J-I-2*A_ where _J_ is the all-one matrix, _I_ is the ## identity matrix and _A_ is the adjacency matrix of the graph. ## The output is a list _L_. Each element of _L_ is a list of size 2, where ## the first element is an eigenvalue and the second element is its multiplicity. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-ClebschGraph(); ##> SeidelSpectrum(G); ##< [[-3, 10], [5, 6]] ##> P := SpecialGraphs:-PetersenGraph(); ##> SeidelSpectrum(P); ##< [[-3, 5], [3, 5]] ## ##SEEALSO ##- "AdjacencyMatrix" ##- "GraphSpectrum" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "GraphSpectrum" : Help:GraphTheory[GraphSpectrum] #---------ver. 23, modified by MG SeidelSpectrum := proc(G::GRAPHLN) local M, e, S, count, x, k, i, n, m, E; n := nops(vlist(G)); M := Matrix(n,n,1)- LinearAlgebra:-IdentityMatrix(n)-2*AdjacencyMatrix(G); e := LinearAlgebra:-Eigenvalues(M); S := sort([seq(e[i],i=1..n)]); m := nops({op(S)}); count := Array(1..m); E := Array(1..m); x, k := S[1], 1; for i to n do if S[i] = x then count[k] := count[k] + 1 else E[k] := [x,count[k]]; count[k+1]:=count[k+1]+1; x:=S[i]; k:=k+1; end if; end do; E[m] := [x,count[m]]; [seq(E[i], i=1..m)]; end; ############################################## ##PROCEDURE(doti) SequenceGraph ##ALIAS GraphTheory[SequenceGraph] ##CALLINGSEQ ##- SequenceGraph('L') ## ##PARAMETERS ##- 'L' : list ## ##DESCRIPTION ##- `SequenceGraph` will return a graph with the specified degree sequence given as input, if ## such a graph exists. It returns an error message otherwise. ## To check if a graph with given degree sequence exists, use IsGraphicSequence. ## ##EXAMPLES ##> with(GraphTheory): ##> L := [3, 2, 4, 2, 3, 4, 5, 7]; ##> IsGraphicSequence(L); ##< true ##> G := SequenceGraph(L); ##> sort(DegreeSequence(G)); ##< [2, 2, 3, 3, 4, 4, 5, 7] ## ##SEEALSO ##- "DegreeSequence" ##- "IsGraphicSequence" ## ##XREFMAP ##- "DegreeSequence" : Help:GraphTheory[DegreeSequence] ##- "IsGraphicSequence" : Help:GraphTheory[IsGraphicSequence] #---------ver. 23, modified by MG SequenceGraph := proc(L::list) local T, ind, IND, v, Nbr, w, n, A, i, k, deg, E, m, comp; if IsGraphicSequence(L) then A := Array(L, storage=sparse); n := nops(L); IND := [seq(i,i=1..n)]; comp := proc(i,j) evalb(A[i]>=A[j]) end; E := {}; for k to n do ind := sort( IND , comp); v := ind[1]; deg := A[v]; if A[v]=0 then break end if; Nbr := {seq(ind[j],j=2..deg+1)}; E := E union {seq( {v,w}, w in Nbr) }; A[v] := 0; for w in Nbr do A[w] := A[w] - 1 end do; end do; Graph([$1..n],E) else error" No such a graph exists" end if; end; ############################################# ##PROCEDURE(doti) ShortestPath ##ALIAS GraphTheory[ShortestPath] ##CALLINGSEQ ##- ShortestPath('G', 'u', 'v') ## ##PARAMETERS ##- 'G' : graph ##- 'u', 'v' : vertices of the graph ## ##DESCRIPTION ##- `ShortestPath` returns a shortest path from 'u' to 'v' using a breadth-first search. ## Edge weights are ignored. ## The output is a list of vertices in the order they appear on the path. ## If no such a path exists, an error is returned. ## ##- To compute shortest paths with respect to edge weights, use "DijkstrasAlgorithm". ## ##EXAMPLES ##> with(GraphTheory): ##> C6 := CycleGraph(6); ##> ShortestPath(C6,1,5); ##< [1, 6, 5] ## ##SEEALSO ##- "DijkstrasAlgorithm" ##- "Distance" ## ##XREFMAP ##- "DijkstrasAlgorithm" : Help:GraphTheory[DijkstrasAlgorithm] ##- "Distance" : Help:GraphTheory[Distance] #---------ver. 23, modified by MG ShortestPath := proc(G::GRAPHLN,u::VERTEXTYPE,v::VERTEXTYPE) local d, P, pathseq, V, L, i, j; V := vlist(G); if not u in V or not v in V then error "2nd and 3rd argument must be vertices of the graph";end if; L := GraphInfo:-LabelToInteger(G); i, j := L[u], L[v]; if not type(i,integer) then error "%1 is not a vertex in this graph", u; fi; if not type(j,integer) then error "%1 is not a vertex in this graph", v; fi; if i = j then pathseq := [u] else BFS(G, i, d, P); if P[j]=NIL then error "no path from %1 to %2 exists",u,v; else pathseq := [op(ShortestPath(G, u, V[P[j]])),v]; end if; end if; # PathGraph( pathseq ); pathseq; end; ############################################# ##PROCEDURE(doti) DijkstrasAlgorithm ##ALIAS GraphTheory[DijkstrasAlgorithm] ##AUTHOR Al Erickson ##CALLINGSEQ ##- DijkstrasAlgorithm('G', 's', 't') ##- DijkstrasAlgorithm('G', 's', 'T') ##- DijkstrasAlgorithm('G', 's') ## ##PARAMETERS ##- 'G' : a graph with nonnegative edge weights or no weights ##- 's', 't' : vertices of the graph 'G' ##- 'T' : list of vertices of the graph 'G' ## ##DESCRIPTION ##- If 'G' is an unweighted graph, the edges weights of 1 are assumed. ## ##- If 'G' is a weighted graph, `DijkstrasAlgorithm`('G','s','t') returns the ## cheapest weighted path from vertex 's' to vertex 't' in the graph 'G'. ## If a path from 's' to 't' exists, the output is a list of the form ## ~[[s,...,t],w]~ where ~[s,...,t]~ is the path and ~w~ is the weight of ## that path. If no such path exists the output is _[[],infinity]_. ## ##- In the second calling sequence where 'T' is a list of vertices of ## 'G', this is short for ~[seq(DijkstrasAlgorithm(G,s,t), t=T)]~, ## save that the algorithm does not need to recompute cheapest paths. ## ##- In the third calling sequence where no destination vertices are ## given, this is short for ~DijkstrasAlgorithm(G,s,Vertices(G))~, ## i.e. the cheapest path from 's' to every vertex in 'G' is output. ## ##- To compute distances between all pairs of vertices simultaneously, ## use the "AllPairsDistance" command. To ignore edge weights ## (and use a faster breadth-first search) use the "ShortestPath" command. ## ##EXAMPLES ##> with(GraphTheory): ##> C6 := Graph( { [{1,2},1], [{2,3},3], [{3,4},7], [{4,5},3], [{5,6},3], [{1,6},3]} ); ##> DijkstrasAlgorithm(C6, 1, 4); ##< [[1,6,5,4], 9] ##> DrawGraph(C6); ##> DijkstrasAlgorithm(C6, 1); ##< [[[1], 0], [[1,2], 1], [[1,2,3], 4], [[1,6,5,4], 9], [[1,6,5], 6], [[1,6], 3]] ##> G := Graph( { [[1,2],2],[[1,3],2],[[2,3],2],[[3,1],2], [[4,5],2],[[5,6],2],[[6,4],2] } ); ##> DrawGraph(G); ##> DijkstrasAlgorithm(G, 1, 3); ##< [[1, 3], 2] ##> DijkstrasAlgorithm(G, 4, 6); ##< [[4, 5, 6], 4] ##> DijkstrasAlgorithm(G, 1, 6); ##< [[], infinity] ## ##SEEALSO ##- "AllPairsDistance" ##- "ShortestPath" ## ##XREFMAP ##- "AllPairsDistance" : Help:GraphTheory[AllPairsDistance] ##- "ShortestPath" : Help:GraphTheory[ShortestPath] #---------ver. 24, AE ############## #Dijkstra's Shortest Path Algorith #Author: Al Erickson #returns sequence of vertices of shortest path from w to s in G #pseudocode due to wikipedia.org #n Dijkstra(G, w, s) # 2 for each vertex v in V[G] // Initializations # 3 d[v] := infinity # 4 previous[v] := undefined # 5 d[s] := 0 # 6 S := empty set # 7 Q := V[G] # 8 while Q is not an empty set // The algorithm itself # 9 u := Extract_Min(Q) #10 S := S union {u} #11 for each edge (u,v) outgoing from u #12 if d[u] + w(u,v) < d[v] // Relax (u,v) #13 d[v] := d[u] + w(u,v) #14 previous[v] := u # #1 S := empty sequence #2 u := t #3 while defined previous[u] #4 insert u to the beginning of S #5 u := previous[u] # #i timed this a bit in late may 2006 and it seems to be a bit better than quadratic ############################### DijkstrasAlgorithm := proc(G::GRAPHLN,source::VERTEXTYPE) local w,V,A,n,previous,d,S,D,u,v,i,j,M,W,SS,U,m,L,s,MM; V,A:=vlist(G),listn(G); M:=`if`(IsWeighted(G),eweight(G),AdjacencyMatrix(G));#is AdjacencyMatrix as slow at WeightMatrix? n:=nops(V); L := GraphInfo:-LabelToInteger(G); s := L[source]; if not type(s,integer) then error "%1 is not a vertex in this graph", source; fi; previous:=Array(1..n,fill=undefined); d:=seq(`if`(i<>s,[i,infinity],[s,0]),i=1..n); D := heap[new]( proc(e1,e2) e1[2] > e2[2] end,d ); d:=Array(1..n,[seq(i[2],i=[d])]); S:=Array(1..n,[0$n]); for i from 1 to n do u:=heap[extract](D); S[u[1]]:=1; for v in A[u[1]] do if S[v]<> 1 then MM:=M[u[1],v]; if MM < 0 then error "weights must be non-negative" fi; W:= u[2] + MM; if W < d[v] then d[v]:=W; previous[v]:=u[1]; heap[insert]([v,d[v]],D); fi; fi; od; od; if nargs=2 then w:={$1..n}; SS:=Array(1..n); elif nargs = 3 then if type(args[3],list) then w:={seq(L[i],i=args[3])}; else w:={L[args[3]]}; fi; else error "too many arguments"; fi; for U in w do if not type(U,integer) then error "%1 is not a vertex in this graph", U fi; if U=s then SS[U] := [[source],0]; next; fi; S:=Array(1..n,fill=0); W,u,i:=0,U,1; while previous[u]<>undefined do W:=W+M[previous[u],u]; S[i]:=u; u:=previous[u]; i:=i+1; od; if i<>1 then S:=convert([source,seq(V[S[i-j]],j=1..i-1)],'list'); else S:=[]; W:=infinity; fi; SS[U]:=[S,W]; od; SS := convert(SS,'list'); if nargs=3 and not type(args[3],list) then op(SS) else SS fi; end: ############################################## ##PROCEDURE(doti) SpanningTree ##ALIAS GraphTheory[SpanningTree] ##CALLINGSEQ ##- SpanningTree('G') ##- SpanningTree('G', 'r') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'r' : vertex of the graph ## ##DESCRIPTION ##- `SpanningTree` will return a spanning tree of 'G', a subgraph that contains all the vertices and is a tree. ## Edge weights are ignored. ## ##- To compute a minimal-weight spanning tree for a weighted graph, use "MinimalSpanningTree". ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(); ##> T1 := SpanningTree(P); ##> IsTree(T1); ##< true ##> DrawGraph(P); ##> DrawGraph(T1); ##> T2 := SpanningTree(P,5): ##> Edges(T1); ##< {{2, 3}, {5, 8}, {1, 5}, {2, 9}, {4, 5}, {6, 7}, {6, 10}, {1, 2}, {1, 6}} ##> Edges(T2); ##< {{5, 8}, {1, 5}, {4, 5}, {4, 10}, {8, 9}, {1, 2}, {3, 4}, {1, 6}, {7, 8}} ## ##SEEALSO ##- "IsTree" ##- "MinimalSpanningTree" ##- "TreeHeight" ## ##XREFMAP ##- "IsTree" : Help:GraphTheory[IsTree] ##- "MinimalSpanningTree" : Help:GraphTheory[MinimalSpanningTree] ##- "TreeHeight" : Help:GraphTheory[TreeHeight] #---------ver. 23, modified by MG SpanningTree := proc(G::GRAPHLN, rt::VERTEXTYPE) local v, s, n, d, P, V, L, Vtree, Etree, newG, M, E; if getdir(G) = directed then error"the input graph must be undirected"; end if; M := `if`(getwt(G)='weighted', WeightMatrix(G), NULL); if not IsConnected(G) then error "graph must be connected"; end if; V := vlist(G); n := nops(V); if n=0 or n=1 then return G end if; L := GraphInfo:-LabelToInteger(G); if nargs=2 then s := L[rt] else s:=1 end if; BFS(G, s, d, P); Vtree := {seq( `if`(P[v]=NIL, NULL, v), v=1..n)}; Etree := { seq ( {P[v],v}, v=Vtree) }; Vtree := Vtree union {s}; Etree := `if`(getwt(G)=weighted, map(S->[map(k->V[k],S),M[op(S)]],Etree), map(S->map(k->V[k],S),Etree)); Vtree := map(k->V[k],[op(Vtree)]); newG := Graph(Vtree, Etree); #---attribs E := op(GraphInfo:-Edges(newG)); GraphInfo:-SetAttrib(newG, [$1..n, E], GraphInfo:-GetAttrib(G, [$1..n, E])); newG; end; ############################################# ##PROCEDURE(doti) GraphSpectrum ##ALIAS GraphTheory[GraphSpectrum] ##CALLINGSEQ ##- GraphSpectrum('G') ##- GraphSpectrum('G', 'exact') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `GraphSpectrum` will return the spectrum of the eigenvalues of a specified graph. ## The output is a list _L_. Each element of _L_ is a list of size 2, where ## the first element is an eigenvalue and the second element is its multiplicity. ## if the second argument is provided, the evaluation of the eigenvalues will not be ## carried out using floating points. ## ##EXAMPLES ##> with(GraphTheory): ##> C5 := CycleGraph(5); ##> GraphSpectrum(C5); ##< [[-1.618033990, 2], [0.6180339900, 2], [2.000000000, 1]] ##> GraphSpectrum(C5, exact); ##< [[-1/2-1/2*5^(1/2), 2], [-1/2+1/2*5^(1/2), 2], [2, 1]] ##> f := CharacteristicPolynomial(C5,x); ##< x^5-5*x^3+5*x-2 ##> factor(f); ##< (x - 2)*(x^2 + x - 1)^2 ## ##SEEALSO ##- "AdjacencyMatrix" ##- "CharacteristicPolynomial" ##- "IsIntegerGraph" ##- "SeidelSpectrum" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "CharacteristicPolynomial" : Help:GraphTheory[CharacteristicPolynomial] ##- "IsIntegerGraph" : Help:GraphTheory[IsIntegerGraph] ##- "SeidelSpectrum" : Help:GraphTheory[SeidelSpectrum] #---------ver. 23, modified by MG GraphSpectrum := proc(G::GRAPHLN) local M, e, ef, count, x, k, i, j, n, m, E, exct; exct := false; if nargs > 1 then if type(args[2], symbol) and args[2]=exact then exct := true; else error"2nd argument can only be the symbol 'exact' but received %1.",args[2]; fi; fi; M := AdjacencyMatrix(G); if not exct then M := evalf(M); fi; n := nops(vlist(G)); if exct then e := sort(LinearAlgebra:-Eigenvalues(M), proc(x,y) evalf(Re(x)round(x*10^(Digits-2))*10.^(2-Digits), LinearAlgebra:-Eigenvalues(M))) fi; m := nops({seq(e[i],i=1..n)}); count := Array(1..m); E := Array(1..m); x, k := e[1], 1; for i to n do if e[i] = x then count[k] := count[k] + 1 else E[k] := [x,count[k]]; count[k+1]:=count[k+1]+1; x:=e[i]; k:=k+1; end if; end do; E[m] := [x,count[m]]; convert(E, list); end; ############################################## ##PROCEDURE(doti) IsStronglyConnected ##TITLE IsStronglyConnected ##TITLE StronglyConnectedComponents ##ALIAS GraphTheory[IsStronglyConnected], GraphTheory[StronglyConnectedComponents] ##AUTHOR Simon Lo ##DATE May 2005 ## ##CALLINGSEQ ##- IsStronglyConnected('G') ##- StronglyConnectedComponents('G') ## ##PARAMETERS ## 'G' : graph ## ##DESCRIPTION ##- A graph 'G' is strongly connected if for each vertex ~u~ in 'G' there is ## a path to every other vertex in 'G'. Note: a graph with one vertex ## is strongly connected. If 'G' is an undirected graph, then being ## strongly connected is equivalent to being connected. An example ## of a strongly connected graph is the directed cycle graph. ## ##- `IsStronglyConnected`('G') will return `true` if the input graph is a ## a stongly connected graph. It will return `false` otherwise. ## ##- `StronglyConnectedCompontents` computes the maximal subgraphs of 'G' ## which are strongly connected. It returns them as a set of sets ## of vertices where the number of sets indicates the number of ## of strongly connected components. ## ##EXAMPLES ## The graph below is connected but not strongly connected since vertex 1 is not reachable from vertices 2 or 3. ##> with(GraphTheory): ##> T := Digraph( [1,2,3], {[1,2],[1,3],[2,3],[3,2]} ); ##> DrawGraph(T); ##> IsConnected(T); ##< true ##> IsStronglyConnected(T); ##< false ##> ConnectedComponents(T); ##< [[1, 2, 3]] ##> StronglyConnectedComponents(T); ##< [[1], [2, 3]] ##> IsStronglyConnected( Digraph(Trail(1,2,3,4,5)) ); ##< false ##> IsStronglyConnected( Digraph(Trail(1,2,3,4,5,1)) ); ##< true ##> G := Digraph({[1,2],[2,3],[3,4]}); ##> StronglyConnectedComponents(G); ##< [[1], [2], [3], [4]] ##> AddArc(G,[4,3]); ##> StronglyConnectedComponents(G); ##< [[1], [2], [3, 4]] ##> DrawGraph(G); ##> AddArc(G, [4,2]); ##> StronglyConnectedComponents(G); ##< [[1], [2, 3, 4]] ## ##SEEALSO ##- "Digraph" ##- "IsConnected" ##- "ConnectedComponents" ## ##XREFMAP ##- "Digraph" : Help:GraphTheory[Digraph] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "ConnectedComponents" : Help:GraphTheory[ConnectedComponents] #---------ver. 23, modified by MG StronglyConnectedComponents := proc(G::GRAPHLN) local D,W,V,A,T,EW,StrongConnect,i,j,Stack,top,Number,Lowlink,OnStack,u,n,k,SCC,t; StrongConnect := proc(v) local w; i := i+1; Number[v] := i; Lowlink[v] := i; top := top+1; Stack[top] := v; OnStack[v] := true; for w in A[v] do if Number[w] = 0 then StrongConnect(w); Lowlink[v] := min(Lowlink[v],Lowlink[w]) elif Number[w] < Number[v] then if OnStack[w] then Lowlink[v] := min(Lowlink[v],Number[w]) end if end if end do; if Lowlink[v] = Number[v] then t := top; while t>0 and Number[Stack[t]] >= Number[v] do OnStack[Stack[t]] := false; t := t-1; end do; SCC[k] := [seq(V[Stack[j]],j=t+1..top)]; top := t; k := k+1; end if end proc: D, W, V, A, T, EW := getops(G); i := 0; k := 1; n := nops(V); Stack := Array(1..n); top := 0; Number := Array(1..n); Lowlink := Array(1..n); OnStack := Array(1..n,fill=false); for u to n do if Number[u] = 0 then StrongConnect(u) end if end do; sort([seq(SCC[i],i=1..k-1)], proc(x,y) nops(x) with(GraphTheory): ##> K5 := CompleteGraph(5); ##> E := {{1,2},{2,3},{3,4},{4,1}}; ##> H := Subgraph(K5, E); ##> evalb(Edges(H)=E); ##< true ##> HighlightSubgraph(K5, H); ##> DrawGraph(K5); ## ##SEEALSO ##- "DeleteEdge" ##- "HighlightSubgraph" ##- "InducedSubgraph" ## ##XREFMAP ##- "DeleteEdge" : Help:GraphTheory[DeleteEdge] ##- "HighlightSubgraph" : Help:GraphTheory[HighlightSubgraph] ##- "InducedSubgraph" : Help:GraphTheory[InducedSubgraph] #---------ver. 23, modified by MG Subgraph := proc (G::GRAPHLN, ES::{set,list}) local D, W, V, A, T, EW, L, M, n, VS, GS, e; D, W, V, A, T, EW := getops(G); n, L := nops(V), GraphInfo:-LabelToInteger(G); if not({op(ES)} subset Edges(G)) then error "2nd argument must be a subset of edges of the graph, but received %1",ES; end if; if W=unweighted then VS := [op(`union`(seq({op(e)}, e=ES)))]; #VS := V; `if`(D=directed, Digraph(VS,ES), Graph(VS,ES)); else VS := [op(`union`(seq({op(e[1])}, e=ES)))]; #VS := V; M := Matrix(nops(VS), storage=sparse, `if`(D=directed, NULL, shape=symmetric)); for e in ES do M[L[e[1][1]],L[e[1][2]]] := EW[L[e[1][1]],L[e[1][2]]]; end do; `if`(D=directed, Digraph(VS,M, weighted), Graph(VS,M,weighted)); end if; end; ############################################## ##PROCEDURE(doti) TopologicSort ##ALIAS GraphTheory[TopologicSort] ##CALLINGSEQ ##- TopologicSort('G') ## ##PARAMETERS ##- 'G' : acyclic directed graph ## ##DESCRIPTION ##- `TopologicSort` will return a linear ordering of vertices of an acyclic ## digraph that is consistent with the arcs of the digraph. This means ## a vertex ~u~ precedes a vertex ~v~ if there is an arc from ~u~ to ~v~. ## The output is a list. ## ##EXAMPLES ##> with(GraphTheory): ##> DG := Digraph({[c,a],[c,b],[c,d],[a,d],[b,d],[a,b]}): ##> IsAcyclic(DG); ##< true ##> TopologicSort(DG); ##< [c, a, b, d] ## ##SEEALSO ##- "Digraph" ##- "IsAcyclic" ##- "TopologicalSort" ## ##XREFMAP ##- "Digraph" : Help:GraphTheory[Digraph] ##- "IsAcyclic" : Help:GraphTheory[IsAcyclic] #---------ver. 23, modified by MG TopologicSort := proc(G::GRAPHLN) local d, f, P, L, v, F, Vert; if IsAcyclic(G) then DFS( G, d, f, P); L := GraphInfo:-LabelToInteger(G); Vert := vlist(G); F := proc(a,b) evalb(f[L[a]]>f[L[b]]) end proc; sort(Vert,F); else error"the input graph must be an acyclic digraph" end if; end; ############################################## ##PROCEDURE(doti) TravelingSalesman ##ALIAS GraphTheory[TravelingSalesman] ##CALLINGSEQ ##- TravelingSalesman('G') ##- TravelingSalesman('G', 'M') ## ##PARAMETERS ##- 'G' : a connected (di)graph ##- 'M' : a matrix containing edge weights (optional) ## ##DESCRIPTION ##- `TravelingSalesman` will return two objects, ~w~ of type numeric ## and the second ~C~ a list which is a permutation of the vertices ## The first output is the optimal value for the traveling salesman ## problem, and the second is a Hamiltonian cycle that achieves ## the optimal value. ## ##- The algorithm is a branch-and-bound algorithm using the Reduce ## bound (see Kreher and Stinson, 1999). ## ##- If a second argument is specified, it will be used for the weights. ## ## If an edge from vertex ~u~ to ~v~ is not in 'G' then, regardless of the ## edge weight in 'M', it will be treated as infinity. ## ##- If 'G' is not a weighted graph then the adjacency matrix of 'G' will ## be used for the edge weights. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({[{1,2},2],[{2,3},2],[{3,4},2],[{4,1},2]}); ##> TravelingSalesman(G); ### 8, [1,2,3,4,1] ##> AddEdge(G,{[{2,4},1],[{1,3},1]}); # edges of weight 1 ##> DrawGraph(G,style=circle); ##> w, tour := TravelingSalesman(G); ### 6, [1,2,4,3,1] ##> HighlightTrail(G,tour,red); ##> DrawGraph(G,style=circle); ##> G := CompleteGraph(10): ##> M := Matrix([[ 0 , 68, 37, 95, 57, 30, 1 , 25, 71, 84 ], ## [ 68, 0 , 9 , 26, 90, 26, 97, 29, 47, 78 ], ## [ 37, 9 , 0 , 84, 59, 11, 67, 61, 75, 35 ], ## [ 95, 26, 84, 0 , 1 , 99, 55, 63, 19, 8 ], ## [ 57, 90, 59, 1 , 0 , 61, 66, 18, 7 , 48 ], ## [ 30, 26, 11, 99, 61, 0 , 93, 10, 14, 54 ], ## [ 1 , 97, 67, 55, 66, 93, 0 , 47, 20, 95 ], ## [ 25, 29, 61, 63, 18, 10, 47, 0 , 28, 52 ], ## [ 71, 47, 75, 19, 7 , 14, 20, 28, 0 , 92 ], ## [ 84, 78, 35, 8 , 48, 54, 95, 52, 92, 0 ]]): ##> TravelingSalesman(G, M); ##< 142, [1, 8, 6, 2, 3, 10, 4, 5, 9, 7, 1] ## ##TEST ## Try(100, w, 6); ## ##SEEALSO ##- "AllPairsDistance" ##- "IsHamiltonian" ##- "WeightMatrix" ## ##XREFMAP ##- "AllPairsDistance" : Help:GraphTheory[AllPairsDistance] ##- "IsHamiltonian" : Help:GraphTheory[IsHamiltonian] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] #---------ver. 23, modified by MG TravelingSalesman := proc(G::GRAPHLN) local TSP3, OptC, OptX, C, n, V, X, M, k, j, m, mycount, mycount2; TSP3 := proc(q) #option remember; local i, cost, count, nextbound, nextchoice, sortednextbound, sortednextchoice, x ; #q := args[1]; #for i from 0 to q-1 do X[i] := args[i+2]; end do; if q = n then cost := add(M[1+X[i],1+X[i+1]],i=0..n-2) + M[1+X[n-1],1+X[0]]; #mycount := mycount+1; # print(mycount); #remove if cost < OptC then OptC := cost; OptX := copy(X); end if; end if; if q = 0 then C[q] := {0}; elif q = 1 then C[q] := {seq(i,i=1..n-1)}; else C[q] := C[q - 1] minus {X[q-1]}; end if; count := 0; for x in C[q] do X[q] := x; nextchoice[count] := x; nextbound[count] := ReduceBound(X,q+1,n,M); count := count + 1; end do; sortednextbound := sort([seq(nextbound[i],i=0..count-1)],`<=`); sortednextchoice := map(i->nextchoice[i], sort([seq(i,i=0..count-1)], proc(i,j) evalb(nextbound[i] <= nextbound[j]) end)); for i from 1 to count do if sortednextbound[i] < OptC then X[q] := sortednextchoice[i]; TSP3(q+1); #else mycount2:=mycount2+1; #remove end if; end do; end: #main #mycount, mycount2 :=0,0; #remove #if not (type(args[1],GRAPHLN)) then error"1st argument must be a (di)graph" end if; if not(IsConnected(G)) then error"TravelingSalesman expects a connected graph but received %1", G end if; V := vlist(G); n := nops(V); if nargs = 1 then if IsWeighted(G) then M := Matrix(eweight(G),datatype=anything); else M := AdjacencyMatrix(G); fi; for k to n do for j to n do if M[k,j] = 0 then M[k,j] := infinity end if;end do;end do; elif nargs = 2 then if not (type(args[2],Matrix)) then error"2nd argument must be a Matrix";end if; M := args[2]; else error"expecting at most 2 arguments" end if; X[0]:=0; OptC := infinity: TSP3(1); #print(mycount, mycount2); if OptC=infinity then (infinity,[]) else (OptC, [seq(V[OptX[i]+1],i=0..n-1),V[OptX[0]+1]]) end if; end; ############################################## ##PROCEDURE(doti) TuttePolynomial ##ALIAS GraphTheory[TuttePolynomial] ##CALLINGSEQ ##- TuttePolynomial('G', 'x', 'y') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'x' : internal activity variable ##- 'y' : external activity variable ## ##DESCRIPTION ##- `TuttePolynomial` will return a bivariate polynomial in 'x' and 'y' ## when 'x' and 'y' are variables or the evaluation of the bivariate ## polynomial when 'x' or 'y' are values. ## ##EXAMPLES ##> with(GraphTheory): ##> G := CompleteGraph(4): ##> TuttePolynomial(G, x, y); ##< y^3+3*y^2+4*x*y+2*y+2*x+3*x^2+x^3 ## ##SEEALSO ##- "AcyclicPolynomial" ##- "ChromaticPolynomial" ##- "FlowPolynomial" ##- "RankPolynomial" ##- "SpanningPolynomial" ## ##XREFMAP ##- "AcyclicPolynomial" : Help:GraphTheory[AcyclicPolynomial] ##- "ChromaticPolynomial" : Help:GraphTheory[ChromaticPolynomial] ##- "FlowPolynomial" : Help:GraphTheory[FlowPolynomial] ##- "RankPolynomial" : Help:GraphTheory[RankPolynomial] ##- "SpanningPolynomial" : Help:GraphTheory[SpanningPolynomial] #---------ver. 23, modified by MG TuttePolynomial := proc(GG::GRAPHLN,x::algebraic,y::algebraic) local j, n, E, T, G, tp, EW; G := `if`(getwt(GG) = unweighted, MakeWeighted(GG), GG); E := GraphInfo:-Edges(G, 'weights'); EW := op(6, G); for j to nops(op(3, G)) do if 0 < EW[j, j] then E := {op(E), [{j}, EW[j, j]]} end if end do; n := nops( op(3,G) ); tp := proc(E,n) local j,e,EDel,ECon,T; option remember; if nops(E) = 0 then return 1; end if; e := [E[1][1], 1]; EDel := TPDelEdge(E, e); if nops(e[1]) = 1 then T := y*procname(EDel,n); return simplify(T) elif TPCutEdge(E,e,n) then ECon := TPContract(E,e,n); T := x*procname(ECon,n-1); return T else ECon := TPContract(E,e,n); T := procname(ECon,n-1)+procname(EDel,n); return simplify(T) end if end proc: tp(E,n); end; ############################################# ##PROCEDURE(doti) UnderlyingGraph ##ALIAS GraphTheory[UnderlyingGraph] ##CALLINGSEQ ##- UnderlyingGraph('G') ## ##PARAMETERS ##- 'G' : graph ## ##DESCRIPTION ##- `UnderlyingGraph` will return the underlying graph of a graph, i.e. dropping the directions ## of the arcs and the weights of the edges (or arcs). ## ##- Note that `UnderlyingGraph`('G') = ~Graph(Vertices(G), Neighbors(G))~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Digraph({[1,2],[2,3],[3,4],[4,1]}); ##> Edges(G); ##< {[2, 3], [3, 4], [1, 2], [4, 1]} ##> Neighbors(G); ##> H := UnderlyingGraph(G): ##> Edges(H); ##< {{2, 3}, {4, 1}, {1, 2}, {3, 4}} ##> Neighbors(H); ##< [[2, 4], [1, 3], [2, 4], [1, 3]] ## ##SEEALSO ##- "IsDirected" ##- "IsWeighted" ##- "MakeDirected" ##- "MakeWeighted" ## ##XREFMAP ##- "IsDirected" : Help:GraphTheory[IsDirected] ##- "IsWeighted" : Help:GraphTheory[IsWeighted] ##- "MakeDirected" : Help:GraphTheory[MakeDirected] ##- "MakeWeighted" : Help:GraphTheory[MakeWeighted] #---------ver. 23, modified by MG UnderlyingGraph := proc(G::GRAPHLN) local D, W, V, A, T, EW, n, Q, C, i, j, B; D, W, V, A, T, EW := getops(G); if D=undirected then CopyGraph(G); else n := nops(V); Q := table(); C := Array(1..n); for i to n do for j in A[i] do C[i] := C[i]+1; Q[i,C[i]] := j; C[j] := C[j]+1; Q[j,C[j]] := i; end do; end do; B := Array(1..n); for i to n do B[i] := {seq(Q[i,j],j=1..C[i])} end do; GRAPHLN(undirected, unweighted, V, B, COPY_TABLE(T), 0) end if; end; #---------ver. 23, modified by MG # RP: help file merged with EdgeConnectivity VertexConnectivity := proc(G::GRAPHLN) local D, W, V, A, T, EW, n, N, E, Edg, f, vc, i, j, F, sigma, H; #some initial tests, like weighted, directed check,.... D, W, V, A, T, EW := getops(G); n := nops(V); if D = directed then return VertexConnectivity(UnderlyingGraph(G)) end if; if W = weighted then return VertexConnectivity(GRAPHLN(undirected, unweighted, V, A, eval(T), 0)) end if; # RP: no return statement was clearly a bug if not IsConnected(G) then return 0 end if; if nops(ArticulationPoints(G)) > 0 then return 1 end if; sigma := sort([$1..n], proc(i,j) nops(A[i]) > nops(A[j]) end proc): H := GraphInfo:-ApplyPermutation(G,sigma); A := listn(H); ### constructing the appropriate network N := MakeWeighted(Digraph(2*n)); E := GraphInfo:-Edges(H); if nops(E) = n*(n-1)/2 then return n-1 end if; f:=e->([[2*e[2],2*e[1]-1],1],[[2*e[1],2*e[2]-1],1]); #external edges Edg := map(f,E); Edg := Edg union {seq( [[2*i-1,2*i],1],i=1..n)}; N := AddArc(N, Edg); vc := n; i := 0; while not( i > vc) do i := i + 1; for j from i+1 to n do if not member(j,A[i]) then F:= [MaxFlow(N, 2*i, 2*j-1)][1]; if F < vc then vc := F; end if; end if; end do; end do; vc end; ############################################# ##PROCEDURE(doti) Vertices ##TITLE Vertices ##TITLE Edges ##ALIAS GraphTheory[Vertices] ##ALIAS GraphTheory[Edges] ##CALLINGSEQ ##- Vertices('G') ##- Edges('G') ##- Edges('G', 'weights') ##- Edges('G', 'weights'=`false`) ## ##PARAMETERS ##- G : a graph ## ##DESCRIPTION ##- `Vertices`('G') will return a list of the vertex labels of 'G'. ##- `Edges`('G') will return a set of the edges of 'G'. The second argument ## is used to include or exclude edge weights from output. ##- To count vertices and edges, use the "NumberOfVertices" or "NumberOfEdges" commands. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph([1,2,3,4], {{1,2},{1,3},{1,4}}); ##> Vertices(G); ##< [1, 2, 3, 4] ##> Edges(G); ##< {{1, 2}, {1, 3}, {1, 4}} ##> G := Graph([a,b,c], {[a,b],[b,c],[c,a]}); ##> Vertices(G); ##< [a, b, c] ##> Edges(G); ##< {[a, b], [b, c], [c, a]} ##> A := Matrix([[0,1,1],[1,0,1],[1,1,0]]): ##> G := Graph(A); ##> Edges(G); ##< {{2, 3}, {1, 2}, {1, 3}} ##> A := Matrix([[0.0,0.5,0.0],[0.0,0.0,1.0],[1.5,0.0,0.0]]): ##> G := Graph(A); ##> Edges(G); ##< {[1, 2], [2, 3], [3, 1]} ##> Edges(G, 'weights'); ##< {[[1, 2], 0.5], [[2, 3], 1.0], [[3, 1], 1.5]} ## ##SEEALSO ##- "AddVertex" ##- "AddEdge" ##- "Graph" ##- "Neighbors" ##- "RelabelVertices" ##- "PermuteVertices" ##- "SetEdgeWeight" ## ##XREFMAP ##- "AddVertex" : Help:GraphTheory[AddVertex] ##- "AddEdge" : Help:GraphTheory[AddEdge] ##- "NumberOfVertices" : Help:GraphTheory[NumberOfVertices] ##- "NumberOfEdges" : Help:GraphTheory[NumberOfEdges] ##- "Graph" : Help:GraphTheory[Graph] ##- "Neighbors" : Help:GraphTheory[Neighbors] ##- "PermuteVertices" : Help:GraphTheory[PermuteVertices] ##- "RelabelVertices" : Help:GraphTheory[RelabelVertices] ##- "SetEdgeWeight" : Help:GraphTheory[SetEdgeWeight] #---------ver. 23, modified by MG Vertices := proc(G::GRAPHLN) vlist(G); end; Edges := proc(G::GRAPHLN) local n, D, W, V, A, T, EW, wts; D, W, V, A, T, EW := getops(G); n := nops(V); if nargs > 1 then if type(args[2], symbol) and args[2]='weights' then wts := true; elif type(args[2], equation) and lhs(args[2])='weights' and type(rhs(args[2]), boolean) then wts := rhs(args[2]); else error"ivalid argument %1",args[2]; fi; else wts := false; fi; if wts then if W = unweighted then error"the input graph is unweighted." elif D=undirected then {seq ( seq ( [{V[i],V[j]},EW[i,j] ],j=A[i] ), i=1..n ) } else {seq ( seq ( [ [V[i],V[j]],EW[i,j] ],j=A[i] ), i=1..n ) } end if; else if D=undirected then {seq ( seq ( {V[i],V[j]},j=A[i] ), i=1..n ) } else {seq ( seq ( [V[i],V[j]],j=A[i] ), i=1..n ) } fi; fi; end; ############################################# ##PROCEDURE(doti) SpanningPolynomial ##ALIAS GraphTheory[SpanningPolynomial] ##CALLINGSEQ ##- SpanningPolynomial('G', 'x') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'x' : variable or value ## ##DESCRIPTION ##- `SpanningPolynomial` will return a polynomial in 'x' when 'x' is a ## variable or the evaluation of the polynomial when 'x' is a value. ## The value of this polynomial at a value ~0 <= p <= 1~ gives the ## probability that 'G' is spanning (connected if 'G' is connected) ## when each edge operates with probability ~p~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-PetersenGraph(): ##> f := SpanningPolynomial(G,x); ##< 2000*x^9-9828*x^10+20370*x^11-22755*x^12+14430*x^13-4920*x^14+704*x^15 ##> eval(f, x=0.75); ##< 0.815372841 ##> SpanningPolynomial(G,0.35); ##< 0.02142980972 ## ##SEEALSO ##- "EdgeConnectivity" ##- "IsConnected" ##- "TuttePolynomial" ## ##XREFMAP ##- "EdgeConnectivity" : Help:GraphTheory[EdgeConnectivity] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "TuttePolynomial" : Help:GraphTheory[TuttePolynomial] #---------ver. 23, modified by MG SpanningPolynomial := proc (G::GRAPHLN, p::algebraic) local z, T, j,k,n,L,LP,relpoly; if nargs <> 2 then error "SpanningPolynomial(G,p) expects two arguments" end if; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; if IsConnected(G) then relpoly := proc(G,p,n) local c,d,k,u,v,w,t,H; # special code for the connected case # Author: Michael Monagan, 199? # Choose first vertex of minimum degree d := n; for k to nops(G) while d > 0 do if G[k] <> infinity then c := nops(indets(G[k])); if c < d then d := c; u := k fi end if; end do; if d = 0 then if n = 1 then RETURN(1) else RETURN(0) end if end if; v := op(1,op(1,indets(G[u]))); c := coeff(G[u],X[v],1); if d = 1 then # Isolated node contraction H := subsop( u=infinity, v=G[v]-c*X[u], G ); RETURN( expand( (1-(1-p)^c) * procname(H,p,n-1) ) ) end if; # First delete the edge of multiplicity c between vertices u and v # (All edges between u and v have failed with probability (1-p)^c) H := subsop( u=G[u]-c*X[v], v=G[v]-c*X[u], G ); t := (1-p)^c * procname(H,p,n); # Now contract vertices u and v (at least one edge has not failed) H := subsop( u=infinity, v=H[u]+H[v], subs(X[u]=X[v],H) ); t := expand( (1-(1-p)^c) * procname(H,p,n-1) + t ); # Now remember this computation procname(G,p,n) := t; end: L := op(4,G): n := NumberOfVertices(G): LP := Array(1..n): for j from 1 to n do for k in L[j] do LP[j] := LP[j]+ X[k]; end do: end do: LP := convert(LP,list); relpoly(LP,p,n); else # code that works in unconnected case T := TuttePolynomial(G, 1, z); simplify(p^(nops(vlist(G))- nops(ConnectedComponents(G)))*subs(z = 1/(1-p), T/(z^degree(T)))) end if; end proc: ############################################# ##PROCEDURE(doti) ChromaticPolynomial ##ALIAS GraphTheory[ChromaticPolynomial] ##CALLINGSEQ ##- ChromaticPolynomial('G', 'x') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'x' : variable or value ## ##DESCRIPTION ##- `ChromaticPolynomial` will return a polynomial in 'x' when 'x' is ## a variable or the evaluation of the polynomial when 'x' is a value. ## The value of this polynomial at a positive integer ~k~ gives the ## number of proper vertex colorings of 'G' using ~k~ colors. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-PetersenGraph(); ##> f := ChromaticPolynomial(G, x); ##< x*(x-1)*(x-2)*(x^7-12*x^6+67*x^5-230*x^4+529*x^3-814*x^2+775*x-352) ##> eval(f, x=2); ### must be zero since the Petersen graph is not 2-colorable ##< 0 ##> eval(f, x=3); ##< 120 ## ##SEEALSO ##- "ChromaticNumber" ##- "IsVertexColorable" ##- "TuttePolynomial" ## ##XREFMAP ##- "ChromaticNumber" : Help:GraphTheory[ChromaticNumber] ##- "IsVertexColorable" : Help:GraphTheory[IsVertexColorable] ##- "TuttePolynomial" : Help:GraphTheory[TuttePolynomial] #---------ver. 23, modified by MG ChromaticPolynomial := proc (G::GRAPHLN, lambda::algebraic) local t, T; if nargs <> 2 then error "ChromaticPolynomial expects two arguments" end if; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; T := TuttePolynomial(G, t, 0); (-1)^(nops(vlist(G))- nops(ConnectedComponents(G)))*factor(simplify( lambda^nops(ConnectedComponents(G))* subs(t = 1- lambda, T))) end proc: ############################################# ##PROCEDURE(doti) FlowPolynomial ##ALIAS GraphTheory[FlowPolynomial] ##CALLINGSEQ ##- FlowPolynomial('G', 'x') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'x' : variable or value ## ##DESCRIPTION ##- `FlowPolynomial` will return a polynomial in 'x' when 'x' is a ## variable or the evaluation of the polynomial when 'x' is a value. ## The value of this polynomial at a positive integer ~k~ gives the ## number of nowhere-zero flows on 'G' with edge labels chosen from ## the integers modulo ~k~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-PetersenGraph(); ##> f := FlowPolynomial(G, x); ##< 240-620*x+x^6-15*x^5+624*x^2-325*x^3+95*x^4 ##> eval(f, x=4); ##< 0 ##> eval(f, x=5); ##< 240 ## ##SEEALSO ##- "TuttePolynomial" ## ##XREFMAP ##- "TuttePolynomial" : Help:GraphTheory[TuttePolynomial] #---------ver. 23, modified by MG FlowPolynomial := proc (G::GRAPHLN, h::algebraic) local z, T; if nargs <> 2 then error "FlowPolynomial(G,h) expects two arguments" end if; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; T := TuttePolynomial(G, 0, z); simplify((-1)^(nops(Edges(G))- nops(vlist(G)) + nops(ConnectedComponents(G)))* subs(z = 1- h, T)) end proc: ############################################# ##PROCEDURE(doti) RankPolynomial ##ALIAS GraphTheory[RankPolynomial] ##CALLINGSEQ ##- RankPolynomial('G', 'x', 'y') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'x', 'y' : variables or values ## ##DESCRIPTION ##- `RankPolynomial` will return a bivariate polynomial in 'x' and 'y' ## when 'x' and 'y' are variables or the evaluation of the polynomial ## when 'x' or 'y' are values. ## ##EXAMPLES ##> with(GraphTheory): ##> K4 := CompleteGraph(4); ##> f := RankPolynomial(K4, x, y); ##< 16+15*y+6*y^2+y^3+15*x+4*y*x+6*x^2+x^3 ##> eval(f, {x=1, y=1}); # number of subgraphs ##< 64 ##> eval(f, {x=1, y=0}); # number of acyclic subgraphs ##< 38 ##> eval(f, {x=0, y=1}); # number of subgraphs whose rank = rank(G) ##< 38 ##> eval(f, {x=0, y=0}); # number of maximum spanning forests ##< 16 ## ##SEEALSO ##- "TuttePolynomial" ## ##XREFMAP ##- "TuttePolynomial" : Help:GraphTheory[TuttePolynomial] #---------ver. 23, modified by MG RankPolynomial := proc (G::GRAPHLN, x::algebraic, y::algebraic) if nargs <> 3 then error "RankPolynomial(G,x,y) expects three arguments" end if; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; TuttePolynomial(G, x+1, y+1); end proc: ############################################# ##PROCEDURE(doti) AcyclicPolynomial ##ALIAS GraphTheory[AcyclicPolynomial] ##CALLINGSEQ ##- AcyclicPolynomial('G', 'x') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'x' : variable or value ## ##DESCRIPTION ##- `AcyclicPolynomial` will return a polynomial in 'x' when 'x' is a ## variable or the evaluation of the polynomial when 'x' is a value. ## The value of this polynomial at a value ~0 <= p <= 1~ gives the ## probability that 'G' is acyclic when each edge operates with ## probability ~p~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-PetersenGraph(): ##> f := AcyclicPolynomial(G, x); ##< (-1+x)^6*(240*x^9+450*x^8+480*x^7+380*x^6+240*x^5+126*x^4+56*x^3+21*x^2+6*x+1) ##> eval(f, x=0.75); ##< 0.08118482678 ##> AcyclicPolynomial(G, 0.35); ##< 0.9316067337 ## ##SEEALSO ##- "IsAcyclic" ##- "TuttePolynomial" ## ##XREFMAP ##- "IsAcyclic" : Help:GraphTheory[IsAcyclic] ##- "TuttePolynomial" : Help:GraphTheory[TuttePolynomial] #---------ver. 23, modified by MG AcyclicPolynomial := proc(G::GRAPHLN, p::algebraic) local t, T; if nargs <> 2 then error "AcyclicPolynomial(G,h) expects two arguments" end if; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; T:=TuttePolynomial(G, t, 1); simplify((1-p)^(nops(Edges(G))- nops(vlist(G)) +nops(ConnectedComponents(G)))*subs(t = 1/p, T/(t^degree(T)))) end proc: ############################################# ##PROCEDURE(doti) GraphPolynomial ##ALIAS GraphTheory[GraphPolynomial] ##CALLINGSEQ ##- GraphPolynomial('G') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ## ##DESCRIPTION ##- `GraphPolynomial` will return a polynomial in the variables ## _x1_, ..., _xn_ when 'G' is a graph with _n_ vertices. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph([1,2,3,4,5,6],{{4,5},{3,4},{4,6},{5,6},{3,5},{1,4},{2,6}}): ##> GraphPolynomial(G); ##< (x4-x6)*(x3-x4)*(x3-x5)*(x1-x4)*(x2-x6)*(x5-x6)*(x4-x5) #---------ver. 23, modified by MG GraphPolynomial := proc(G::GRAPHLN) local f,e,i,j; if getdir(G)='directed' or getwt(G)='weighted' then error "1st argument must be a simple graph (undirected and unweighted). Use `UnderlyingGraph`"; fi; f := 1: for e in Edges(G) do i,j:=e[1],e[2]: if i < j then f := f*(x||i - x||j) end if; end do: end proc: ############################################### ##PROCEDURE(doti) ChromaticNumber ##ALIAS GraphTheory[ChromaticNumber] ##CALLINGSEQ ##- ChromaticNumber('G', 'col') ##- ChromaticNumber('G', '`bound`') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'col' : (optional) name ## ##DESCRIPTION ##- `ChromaticNumber` computes the chromatic number of a graph 'G'. ## If a name 'col' is specified, then this name is assigned ## the list of color classes of an optimal proper coloring of vertices. ## The algorithm uses a backtracking technique. ## ##- If the option '`bound`' is provided, then an estimate of the ## chromatic number of the graph is returned. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(): ##> ChromaticNumber(P, 'bound'); ##< 3 .. 3 ##> ChromaticNumber(P, 'col'); ##< 3 ##> col; ##< [[1, 3, 8, 10], [2, 4, 6], [5, 7, 9]] ## ##SEEALSO ##- "CircularChromaticNumber" ##- "EdgeChromaticNumber" ##- "GreedyColor" ##- "IsVertexColorable" ##- "Mycielski" ## ##XREFMAP ##- "CircularChromaticNumber" : Help:GraphTheory[CircularChromaticNumber] ##- "EdgeChromaticNumber" : Help:GraphTheory[EdgeChromaticNumber] ##- "GreedyColor" : Help:GraphTheory[GreedyColor] ##- "IsVertexColorable" : Help:GraphTheory[IsVertexColorable] ##- "Mycielski" : Help:GraphTheory[Mycielski] #---------ver. 23, modified by MG ChromaticNumber := proc(G::GRAPHLN, VC::name) local k, n, X, LI, L, chi, CHI, Gcolor, K, Kcolor, AM, C, found, kstar, Colorstar, kVC, i, lb, ub, MC, cn, P, c, j, CC, V; if getdir(G)=directed or getdir(G)=weighted then error "simple graph expected. See `UnderlyingGraph`." fi; kVC := proc(q) local i, z, x, y; # if X is a full feasible solution, output it if (q = n) then found := true; Colorstar := convert(X[0..q-1], list); end if; # compute the choice set C[q] if (q = n) then C[q] := {}; else C[q] := {seq(i, i=0..k-1)}; for i from 0 to q-1 do if (AM[P[q+1],P[i+1]] > 0) then C[q] := C[q] minus {X[i]} end if; end do; end if; for z in C[q] do X[q] := z; if found=false then procname(q + 1); end if; end do; return Colorstar; end: V := vlist(G); n := nops(V); if n=0 then if nargs=2 then VC := []; end if; return 0 end if; LI := GraphInfo:-LabelToInteger(G); MC := map(x->LI[x], MaximumClique(G)); cn := nops(MC); P := [op(MC),op({$1..n} minus {op(MC)})]; chi := max(cn, ceil(n/IndependenceNumber(G))); chi := `if`((NumberOfEdges(G)*2/(n^2-n))<0.6, CliqueNumber(G), ceil(n/IndependenceNumber(G))); CHI, Gcolor := GreedyColor(GraphInfo:-ApplyPermutation(G, P)): L := [seq(i,i=chi..CHI)]; if nargs=2 and args[2]='bound' then chi := max(cn, ceil(n/IndependenceNumber(G))); return chi..CHI; else if nops(L) =1 then CC := [seq({}, i=1..L[1])]; for i to n do CC[Gcolor[i]+1] := CC[Gcolor[i]+1] union {V[P[i]]}; end do; #V[i] replaced by V[P[i]] by M.G. if nargs=2 then VC := map(x->convert(x,list), CC); end if; return L[1]; end if; AM := AdjacencyMatrix(G); X := Array(0..n-1); k := floor((L[1] + L[-1])/2); lb := L[1]; ub := L[-1]; while ub > lb do found := false; Colorstar := []; for j from 0 to cn-1 do X[j] := j; end do; #X[0] := 0: Kcolor := kVC(cn); if nops(Kcolor)>0 then ub:=k; Gcolor := Kcolor; else lb := k+1; end if; k := lb + floor((ub-lb)/2); #if k=L then return L,Gcolor; end if; end do: c := [seq(0,i=1..n)]; for i to n do c[P[i]] := Gcolor[i]; end do; CC := [seq({}, i=1..ub)]; for i to n do CC[c[i]+1] := CC[c[i]+1] union {V[i]}; end do; if nargs=2 then VC := map(x->convert(x,list), CC); end if; return ub; fi; end proc; ############################################### ##PROCEDURE(doti) ChromaticIndex ##TITLE ChromaticIndex ##TITLE EdgeChromaticNumber ##ALIAS GraphTheory[ChromaticIndex], GraphTheory[EdgeChromaticNumber] ##CALLINGSEQ ##- ChromaticIndex('G', 'col') ##- EdgeChromaticNumber('G', 'col') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'col' : (optional) name ## ##DESCRIPTION ##- `ChromaticIndex` and `EdgeChromaticNumber` compute the ## chromatic index (or edge chromatic number) of a graph 'G'. ## If a name 'col' is specified, then this name is assigned ## the list of color classes of an optimal proper edge coloring. ## The algorithm uses a backtracking technique, except when 'G' is bipartite, ## where a more efficient algorithm is used. ## ##EXAMPLES ##> with(GraphTheory): ##> K4 := CompleteGraph(4); ##> EdgeChromaticNumber(K4, 'col'); ##< 3 ##> col; ### [{{2, 3}, {1, 4}}, {{3, 4}, {1, 2}}, {{2, 4}, {1, 3}}] ##> DrawGraph(K4); ## ##TEST ## Try(100, {op(col)}, {{{2, 3}, {1, 4}}, {{3, 4}, {1, 2}}, {{2, 4}, {1, 3}}}); ## ##SEEALSO ##- "ChromaticNumber" ##- "CircularEdgeChromaticNumber" ##- "IsEdgeColorable" ## ##XREFMAP ##- "ChromaticNumber" : Help:GraphTheory[ChromaticNumber] ##- "CircularEdgeChromaticNumber" : Help:GraphTheory[CircularChromaticNumber] ##- "IsEdgeColorable" : Help:GraphTheory[IsEdgeColorable] #---------ver. 23, modified by MG ChromaticIndex := proc(G::GRAPHLN, c::name) local D, W, V, A, L, factor, M, P, X, Y, N, F, i, j, n, Delta, e, deg, aux, Gcopy, Cedges, cn, C; if getdir(G)=directed or getwt(G)=weighted then error"The input graph is expected to be undirected and unweighted. Use `ChromaticIndex(UnderlyingGraph(G))'." fi; D,W,V,A := getdir(G),getwt(G),vlist(G),listn(G); L := GraphInfo:-LabelToInteger(G); if D=directed or W=weighted then error "G must be an undirected unweighted graph." fi; if IsBipartite(G, 'P') then if nargs=1 then MaximumDegree(G); else n := nops(V); deg := [seq(nops(A[aux]), aux=1..n)]; Delta := max(op(deg)); if min(op(deg)) = Delta then X, Y := seq(map(t->L[t], P[aux]), aux=1..2); M := Matrix(n+2); for i in X do for j in A[i] do M[i,j] := 1; od od; for i in X do M[n+1,i] := 1; od; for j in Y do M[j,n+2] := 1; od; factor := NULL; to Delta do aux, F := MaxFlow(Graph(M, weighted), n+1, n+2); F := convert(map(x->[lhs(x)], op(2, F)), set); factor := factor, map(e->`if`({op(e)} subset {$1..n}, {V[e[1]],V[e[2]]}, NULL), F); for e in F do i,j:=op(e); if {i,j} intersect {n+1,n+2} = {} then M[i,j] := M[i,j]-1 fi od: od; factor := [factor]; #HighlightEdge( G, factor); c := factor; Delta; else X, Y := seq(map(t->L[t], P[aux]), aux=1..2); M := Matrix(2*n+2); for i in X do for j in A[i] do M[i,j], M[j+n,i+n] := 1, 1; od od; for i in X do M[2*n+1,i], M[i+n,2*n+2] := 1, 1; M[i, i+n] := Delta - deg[i]; od; for j in Y do M[2*n+1,j+n], M[j,2*n+2] := 1, 1; M[j+n, j] := Delta - deg[j]; od; factor := NULL; to Delta do aux, F := MaxFlow(Graph(M, weighted), 2*n+1, 2*n+2); F := convert(map(x->[lhs(x)], op(2, F)), set); factor := factor, map(e->`if`({op(e)} subset {$1..n}, {V[e[1]],V[e[2]]}, NULL), F); for e in F do i,j:=op(e); if {i,j} intersect {2*n+1,2*n+2} = {} then M[i,j] := M[i,j]-1 fi od: od; factor := [factor]; #HighlightEdge( G, factor); c := factor; Delta; fi; fi; else Gcopy := GraphInfo:-StandardGraph(G); V := vlist(G); cn := ChromaticNumber(LineGraph(Gcopy), C); Cedges := [seq(map(e->map(x->V[x],convert(sscanf(e, "%d-%d"), set)), C[aux]), aux=1..cn)]; #HighlightEdge( G, Cedges); if nargs=2 then c := map(x->convert(x, set), Cedges) end if; cn fi; end proc; EdgeChromaticNumber := proc() ChromaticIndex(args) end; ################################################# ##AUTHOR Sara Khodadad ##DATE Feb. 5, 2005 ##PROCEDURE(doti) DrawGraph ##ALIAS GraphTheory[DrawGraph] ##HALFLINE draw a graph stored in the Graph data structure ## ##CALLINGSEQ ##- DrawGraph('G') ##- DrawGraph('G', `style`='s') ##- DrawGraph('G', `style`=`tree`, `root`='v') ##- DrawGraph('G', `dimension`='d') ##- DrawGraph('G', `style`=`spring`) ##- DrawGraph('G', `style`=`spring`, `redraw`) ## ##PARAMETERS ##- 'G' : graph ##- 's' : (optional) `circle`, `tree`, `bipartite`, `spring` ##- 'd' : (optional) integer 2 or 3 ## ##RETURNS ## returns a PLOT data structure ## ##DESCRIPTION ##- `DrawGraph` displays the vertices and edges of a graph 'G' as a Maple plot. ## If 'G' has fewer than 100 vertices, the vertex labels are also displayed. ## If 'G' is a weighted graph with fewer than 46 edges then the edge weights ## are displayed. ## ##- The style option forces `DrawGraph` to display the input graph in a specific ## style. There are four different styles supported for displaying a graph: ## `circle`, `tree`, `bipartite` and `spring`. ## All components of a disconnected graph are detected and are displayed ## separately. The type of each graph or a component of a disconnected ## graph is distinguished and is displayed accordingly. ## ##- The display of vertex labels may be forced or suppressed with ## the option `showlabels`=`true` and `showlabels`=`false`, respectively. ## ##- The display of edge weights may be forced or suppressed with ## the option `showweights`=`true` and `showweights`=`false`, respectively. ## ##- If the `style`=`tree` drawing option is specified then the additional ## optional argument `root`='v' may be specified to specify the root vertex 'v'. ## ##- The `spring` option is so named because it simulates a physical model ## where the vertices are are modelled as protons repelling each other and ## the edges are modelled as springs attracting adjacent vertices. ## This leads to a dense system of non-linear ODEs to be solved and so ## this option becomes quite expensive beyond 100 vertices. ## At this time the code for the spring option requires that the ## graph be connected and it does not display edge weights in 3 dimensions. ## ## `redraw` : redraw the graph using a different random starting position ## `animate`=`true` : create a 50 frame animation of the model ## ##- By default, we have predefined the vertex positions for paths, ## cycles, cliques and most of the graphs in the "SpecialGraphs", e.g., ## the Petersen graph, so that when displayed, they appear as they ## would in a textbook. The user may specify the vertex positions ## for the display of a graph using the "SetVertexPosition" command. ## ##- By default, all vertices are yellow and all edges are blue. ## The user may set individual vertex and edge colors using the ## "HighlightVertex" and "HighlightEdges" commands. The user may ## set vertex and edge colors of a subgraph of 'G' using the ## "HighlightSubgraph" command, and set edge colors of a trail, path ## or cycle of 'G' using the "HighlightTrail" command. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph(undirected,{{1,2},{2,3},{3,4},{4,1}}); # a cycle ##> DrawGraph(G); ##> F := Graph(6,undirected,{{1,2},{2,3},{5,6}}); # a forest ##> DrawGraph(F); ##> C := Graph(directed,{[1,2],[2,3],[3,4],[4,1]}); # a directed cycle ##> DrawGraph(C); ##> DrawGraph(C,style=circle); ##> W := Matrix([[0,2,3,1],[2,0,4,1],[3,4,0,5],[6,2,5,0]]); ##> G := Graph(directed,weighted,W); ##> DrawGraph(G); ##> K33 := CompleteGraph(3,3); ##> DrawGraph(K33, style=bipartite); ##> T := SpanningTree(K33); ##> DrawGraph(T, style=tree, root=2); ##> HighlightEdges(K33,T,red); ##> DrawGraph(K33); ##> P := SpecialGraphs:-PetersenGraph(); ##> DrawGraph(P); ##> DrawGraph(P,style=spring); ##> DrawGraph(P,style=spring,redraw); ##> DrawGraph(P,style=spring,animate=true); ##> H := SpecialGraphs:-HypercubeGraph(3); ##> DrawGraph(H); ##> DrawGraph(H,style=spring,dimension=3); ##> IsHamiltonian(H,'cycle'); ##< true ##> cycle; ##> HighlightTrail(H,cycle,red); ##> DrawGraph(H); ##> T := RandomGraphs:-RandomTree(100); ##> DrawGraph(T); ##> S := SpecialGraphs:-SoccerBallGraph(); ##> DrawGraph(S); ##> DrawGraph(S,style=spring,dimension=3); ## ##SEEALSO ##- "DrawNetwork" ##- "HighlightEdges" ##- "HighlightSubgraph" ##- "HighlightTrail" ##- "HighlightVertex" ##- "RandomGraphs" ##- "SpecialGraphs" ## ##XREFMAP ##- "DrawNetwork" : Help:GraphTheory[DrawNetwork] ##- "HighlightEdges" : Help:GraphTheory[HighlightEdges] ##- "HighlightSubgraph" : Help:GraphTheory[HighlightSubgraph] ##- "HighlightTrail" : Help:GraphTheory[HighlightTrail] ##- "HighlightVertex" : Help:GraphTheory[HighlightVertex] ##- "RandomGraphs" : Help:GraphTheory[RandomGraphs] ##- "SpecialGraphs" : Help:GraphTheory[SpecialGraphs] #---------ver. 23, modified by MG DrawGraph := proc(H::GRAPHLN); GraphDrawing:-DrawGraph(args) end; #----------------------------------------- ##AUTHOR Sara Khodadad ##DATE Apr. 12, 2005 ##PROCEDURE(doti) HighlightVertex ##TITLE HighlightVertex ##TITLE HighlightEdges ##TITLE HighlightSubgraph ##TITLE HighlightTrail ##ALIAS GraphTheory[HighlightVertex], GraphTheory[HighlightEdges], GraphTheory[HighlightSubgraph], GraphTheory[HighlightTrail] ##HALFLINE highlight a subgraph of a graph ## ##CALLINGSEQ ##- HighlightVertex('G', 'V') ##- HighlightVertex('G', 'V', 'C') ##- HighlightEdges('G', 'E') ##- HighlightEdges('G', 'E', 'C') ##- HighlightSubgraph('G', 'S') ##- HighlightSubgraph('G', 'S', 'C1', 'C2') ##- HighlightTrail('G', 'T') ##- HighlightTrail('G', 'T', 'C') ## ##PARAMETERS ##- 'G' : graph ##- 'V' : a single vertex or a list of vertices of 'G' ##- 'E' : a single edge or a list or set of edges of 'G' ##- 'S' : a subgraph or a list or set of subgraphs of 'G' ##- 'T' : a list of vertices (the trail) of 'G' ##- 'C' : (optional) color or list of colors ##- 'C1', 'C2' : (optional) colors ## ##DESCRIPTION ##- By default the "DrawGraph" command draws the vertices of the ## graph 'G' in yellow and the edges of a graph in blue. ## The commands `HighlightVertex`, `HighlightEdge`, `HighlightTrail`, and ## and `HighlightSubgraph` allow you to specify colors for individual ## vertices, individual edges, a trail (also path and cycle) of edges, ## and the edges and vertices of a subgraph of a graph respectively. ## The default hightlight color for a vertex is green. ## The default hightlight color for an edge is red. ## ##- If 'V' is a vertex in the graph 'G' then `HighlightVertex`('G','S','C') sets the ## color of the vertex to be 'C'. If 'V' is a list of vertices in 'G' then 'C' ## may be a single color or a list of colors. ## ##- If 'E' is an edge of 'G' then `HighlightEdges`('G','E','C') sets the color of the ## edge to be 'C'. ## If E is a list or set of edges of 'G' then 'C' may be a single color or a ## list of colors. ## ##- If 'S' is a subgraph of 'G' then `HighlightSubgraph`('G','S','C1','C2') sets the color ## of the edges of 'S' in 'G' to be 'C1' and of the vertices of 'S' in 'G' to be 'C2'. ## If 'S' is a list or set of subgraphs of 'G' then 'C' may be a single color or ## a list of colors. ## ##- If 'T' is a list of vertices in the graph 'G' then `HighlightTrail`('G','T','C') sets ## the color of the edges on the trail 'T' to be 'C'. ## ##- Colors may be specfied by their name, e.g., `red`, `cyan`, `magenta`, or by ## there RGB color values as ~COLOR(RGB, r, g, b)~ or by the HSV values as ## ~COLOR( HSV, h, s, v )~ or ~COLOR( HUE, x )~ where 'r', 'g', 'b', 'h', 's', 'v', and 'x' ## must be numerical values between 0 and 1. ## ##EXAMPLES ##> with(GraphTheory): ##> K5 := CompleteGraph(5); ##> HighlightVertex(K5,1); ##> DrawGraph(K5); ##> ST := SpanningTree(K5); ##> HighlightEdges(K5, Edges(ST), red); ##> DrawGraph(K5); ##> G := Graph({{1,2},{2,3},{3,1},{3,4},{4,5},{5,6},{6,4}}); ##> A := ArticulationPoints(G); ##< [3, 4] ##> HighlightVertex(G,A,magenta); ##> DrawGraph(G); ##> B := BiconnectedComponents(G); ##> C := InducedSubgraph(G,B[1]); ##> HighlightSubgraph(G,C,red,green); ##> DrawGraph(G,style=spring); ##> K5 := CompleteGraph(5); ##> IsHamiltonian(K5,'cycle'); ##< true ##> cycle; ##> mustard := COLOR(RGB,0.9,0.6,0.0); ##> HighlightTrail(K5, cycle, mustard); ##> DrawGraph(K5); ## ##SEEALSO ##- "DrawGraph" ##- "Edges" ##- "Subgraph" ##- "Trail" ##- "Vertices" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "Edges" : Help:GraphTheory[Edges] ##- "Subgraph" : Help:GraphTheory[Subgraph] ##- "Trail" : Help:GraphTheory[Trail] ##- "Vertices" : Help:GraphTheory[Vertices] #---------- version v.24 MBM HighlightEdges := proc(G::GRAPHLN) GraphDrawing:-HighlightEdges(args) end; HighlightSubgraph := proc(G::GRAPHLN) GraphDrawing:-HighlightSubgraph(args) end; HighlightTrail := proc(G::GRAPHLN) GraphDrawing:-HighlightTrail(args) end; HighlightVertex := proc(G::GRAPHLN) GraphDrawing:-HighlightVertex(args) end; #----------------------------------------- ##PROCEDURE(doti) SetVertexPositions ##ALIAS GraphTheory[SetVertexPositions] ##CALLINGSEQUENCE ##- SetVertexPositions('G', 'vp') ## ##PARAMETERS ##- 'G' : graph ##- 'vp' : list of pairs of numbers ## ##DESCRIPTION ## `SetVertexPositions`('G', 'vp') sets the vertex positions of the graph 'G' ## for graph drawing. The vertex positions should be input in the format ## ~[[x1,y1],[x2,y2],...,[xn,yn]]~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph([$1..6], {{1,2},{1,4},{4,5},{2,5},{2,3},{3,6},{5,6}}); ##> DrawGraph(G); ##> vp := [[0, 0], [0.5, 0], [1, 0], [0, .5], [.5, .5], [1, .5]]: ##> SetVertexPositions(G, vp): ##> DrawGraph(G); ## ##SEEALSO ##- "DrawGraph" ##- "GetVertexPositions" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "GetVertexPositions" : Help:GraphTheory[GetVertexPositions] #---------ver. 23, modified by MG SetVertexPositions := proc(G::GRAPHLN, vl::list) local n, i; n := nops(vlist(G)); if nops(vl)<> n then error "list of vertex positions is expected to have size %1", n; else if not type(vl,list([numeric$2])) and not type(v1,list([numeric$3])) then error "vertex positions are expected to be 2-dimensional or 3-dimensional and numeric"; fi; fi; GraphInfo:-SetVPos(G, VP_USER, vl); end; ############################################### ##PROCEDURE(doti) GetVertexPositions ##ALIAS GraphTheory[GetVertexPositions] ##CALLINGSEQ ##- GetVertexPositions('G') ##- GetVertexPositions('G', `style`='s') ## ##PARAMETERS ##- 'G' : graph ##- 's' : (optional) a style ## ##DESCRIPTION ##- A list of coordinates of the positions of the vertices in the given ## drawing style. ## If the vertex positions for the given style are not set before, ## the empty list is returned. ##- The style 's' can be any one of `fixed`, `circular`, `tree`, `bipartite`, `spring`, ## `user`, or `default`. If no style is specified, the default drawing style of the graph ## is used. ## ##EXAMPLES ##> with(GraphTheory): ##> vp := GetVertexPositions(CycleGraph(9)); ##> G := Graph(Trail(0,1,2,3,4,5,6,7,8,9,1), Trail(4,0,7)): ##> SetVertexPositions(G, [[0,0], op(vp)]): ##> DrawGraph(G); ## ##- We will disguise the Petersen graph by drawing it using the spring option and make those vertex positions the default. ## ##> P := SpecialGraphs:-PetersenGraph(); ##> DrawGraph(P, style=spring); ##> S := GetVertexPositions(P, style=spring); ##> Q := CopyGraph(P); ##> SetVertexPositions(Q, S); ##> DrawGraph(Q); ## ##SEEALSO ##- "DrawGraph" ##- "SetVertexPositions" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "SetVertexPositions" : Help:GraphTheory[SetVertexPositions] #---------ver. 23, modified by MG GetVertexPositions := proc(G::GRAPHLN, sty) local s, equiv; if nargs=1 then s := GraphInfo:-GetDefaultDrawStyle(G); s := `if`(s=FAIL, VP_FIXED, s); else if not type(sty, equation) then error "2nd argument is expected to be of the form style=..."; fi; equiv := [fixed=VP_FIXED, circular=VP_CIRCLE, tree=VP_TREE, bipartite=VP_BIPARTITE, spring=VP_SPRING, user=VP_USER, default=VP_DEFAULT]; s := subs(equiv, rhs(sty)); if not member(s, map(rhs, equiv)) then error "Invalid style %1.", rhs(sty); fi; fi; GraphInfo:-GetVPos(G, s, vl); end; ############################################### ##PROCEDURE(doti) CircularChromaticNumber ##ALIAS GraphTheory[CircularChromaticNumber] ##CALLINGSEQ ##- CircularChromaticNumber('G', 'col') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'col' : (optional) name ## ##DESCRIPTION ##- `CircularChromaticNumber` will return the circular chromatic number of a graph 'G'. ## If a name 'col' is specified, then this name is assigned ## the list of colors of an optimal proper coloring of vertices. ## The algorithm uses a backtracking technique. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-FlowerSnark(5): ##> CircularChromaticNumber(G, 'col'); ##< 5/2 ##> col; ##< [0, 2, 4, 1, 3, 2, 0, 2, 0, 2, 4, 1, 4, 1, 3, 1, 3, 0, 3, 0] ## ##SEEALSO ##- "ChromaticNumber" ##- "CircularEdgeChromaticNumber" ##- "IsVertexColorable" ##- "Mycielski" ## ##XREFMAP ##- "CircularChromaticNumber" : Help:GraphTheory[CircularChromaticNumber] ##- "EdgeChromaticNumber" : Help:GraphTheory[EdgeChromaticNumber] ##- "GreedyColor" : Help:GraphTheory[GreedyColor] ##- "IsVertexColorable" : Help:GraphTheory[IsVertexColorable] ##- "Mycielski" : Help:GraphTheory[Mycielski] #---------ver. 23, modified by MG CircularChromaticNumber := proc(G::GRAPHLN, VC::name) local kVC, V, n, al, CHI, Gcolor, PV, i, p, q, L, AM, X, ind, k, d, lb, ub, found, Colorstar, Kcolor, C, a, lowerbound, omega; if getdir(G)=directed or getwt(G)=weighted then error"The input graph is expected to be undirected and unweighted. Use `CircularChromaticNumber(UnderlyingGraph(G))'." fi; kVC := proc(q) local i, z, x, y; # if X is a full feasible solution, output it if (q = n) then found := true; Colorstar := convert(X[0..q-1], list); end if; # compute the choice set C[q] if (q = n) then C[q] := {}; else C[q] := {seq(i, i=0..k-1)}; for i from 0 to q-1 do if (AM[q+1,i+1] > 0) then C[q] := C[q] minus {seq(X[i]-j mod k,j=-d+1..d-1)} end if; end do; end if; for z in C[q] do X[q] := z; if found=false then procname(q + 1); end if; end do; return Colorstar; end: V := vlist(G); n := nops(V); if n=0 then return 0,[]; end if; al := IndependenceNumber(G); omega := CliqueNumber(G); lowerbound := max(n/al, omega); CHI, Gcolor := GreedyColor(G); PV := table(sparse); for p to n do for q to al do a := p/q; if PV[a] = 0 and a <= CHI and a >= lowerbound then PV[a] := 1 end if; end do; end do; L := sort( map(x->op(x), [indices(PV)]) ); if nops(L) =1 then if nargs=2 then VC := Gcolor; end if; return L[1]; end if; AM := AdjacencyMatrix(G); X := Array(0..n-1); ind := floor(nops(L)/2); k, d := numer(L[ind]), denom(L[ind]); lb := 1; ub := nops(L); while ub > lb do found := false; Colorstar := []; X[0] := 0: Kcolor := kVC(1); if nops(Kcolor)>0 then ub:=ind; Gcolor := Kcolor; else lb := ind+1; end if; ind := lb + floor((ub-lb)/2); if ind > lb and ind < ub then if numer(L[ind-1]) < numer(L[ind]) then ind := ind-1; if numer(L[ind+2]) < numer(L[ind]) and ub - lb > 2 then ind := ind+2 end if; elif numer(L[ind+1]) < numer(L[ind]) then ind := ind+1 end if; end if; k, d := numer(L[ind]), denom(L[ind]); end do: if nargs=2 then VC := Gcolor; end if; return k/d; end: ############################################### ##PROCEDURE(doti) CircularChromaticIndex ##TITLE CircularChromaticIndex ##TITLE CircularEdgeChromaticNumber ##ALIAS GraphTheory[CircularChromaticIndex], GraphTheory[CircularEdgeChromaticNumber] ##CALLINGSEQ ##- CircularChromaticIndex('G', 'col') ##- CircularEdgeChromaticNumber('G', 'col') ## ##PARAMETERS ##- 'G' : undirected unweighted graph ##- 'col' : name used to return the list of colors of an optimal proper coloring (optional) ## ##DESCRIPTION ##- `CircularChromaticIndex` and `CircularEdgeChromaticNumber` will return ## the circular chromatic index (circular edge chromaatic number) of a graph 'G'. ## If a name 'col' is specified, then this name is assigned ## the list of colors of an optimal proper edge coloring. ## The algorithm uses a backtracking technique. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(); ##> CircularChromaticIndex(P, 'col'); ##< 11/3 ##> col; ### [{9,10}=0,{1,5}=0,{1,6}=3,{1,2}=6,{3,4}=1,{2,3}=9,{3,7}=5,{2,9}=3,{4,5}=8,{5,8}=5,{4,10}=4,{6,7}=10,{6,10}=7,{8,9}=8,{7,8}=2}] # not unique ## ##SEEALSO ##- "CircularChromaticNumber" ##- "EdgeChromaticNumber" ##- "IsEdgeColorable" ## ##XREFMAP ##- "CircularChromaticNumber" : Help:GraphTheory[CircularChromaticNumber] ##- "EdgeChromaticNumber" : Help:GraphTheory[EdgeChromaticNumber] ##- "IsEdgeColorable" : Help:GraphTheory[IsVertexColorable] #---------ver. 23, modified by MG CircularChromaticIndex := proc(G::GRAPHLN, EC::name) local c, C, LG, V, E; if getdir(G)=directed or getwt(G)=weighted then error"The input graph is expected to be undirected and unweighted. Use `CircularChromaticIndex(UnderlyingGraph(G))'." fi; LG := LineGraph(GraphInfo:-StandardGraph(G)); c := CircularChromaticNumber(LG, C); if nargs=2 then V := vlist(G); E := map( e->map(x->V[x], convert(sscanf(e,"%d-%d"),set)) , vlist(LG) ); EC := [seq(E[i]=C[i], i=1..nops(E))]; end if; c end proc; CircularEdgeChromaticNumber := proc() CircularChromaticIndex(args) end; # RP: merged into IsVertexColorable # ############################################## # #PROCEDURE(doti) IsKDColorable # #ALIAS GraphTheory[IsKDColorable] # #CALLINGSEQ # #- IsKDColorable('G', 'k', 'd', 'col') # # # #PARAMETERS # #- 'G' : undirected unweighted graph # #- 'k', 'd' : positive integers # #- 'col' : (optional) name # # # #DESCRIPTION # #- ~IsKDColorable(G,k,d)~ will return `true` if the graph 'G' is '(k,d)' # # colorable, and `false` otherwise. That is, it returns `true` if the # # vertices of 'G' can be colored with 'k' colors such that two vertices # # with any given color are at least distance 'd' appart. # # # #- If a name 'col' is specified, then this name is assigned # # the list of colors of an optimal proper coloring of vertices, if it exists. # # The algorithm uses a backtracking technique. # # # #EXAMPLES # #> with(GraphTheory): # #> J7 := SpecialGraphs:-FlowerSnark(7): # #> IsKDColorable(J7, 7, 3, 'col'); # #< true # #> col; # #< [0, 3, 6, 2, 5, 1, 4, 3, 0, 3, 0, 3, 6, 2, 6, 2, 5, 2, 5, 1, 5, 1, 4, 1, 4, 0, 4, 0] # #> IsKDColorable(J7, 9, 4); # #< false # #SEEALSO # #- IsKColorable # #- IsKDEdgeColorable #---------ver. 23, modified by MG # RP: now a hidden export (use IsVertexColorable) IsKDColorable := proc(G::GRAPHLN, k::nonnegint, d::posint, VC::name) local n, X, L, chi, CHI, Gcolor, K, Kcolor, AM, C, found, kstar, Colorstar, kVC, i, lb, ub, MC, cn, P, c, j, CC, V; kVC := proc(q) local i, z, x, y; # if X is a full feasible solution, output it if (q = n) then found := true; Colorstar := convert(X[0..q-1], list); end if; # compute the choice set C[q] if (q = n) then C[q] := {}; else C[q] := {seq(i, i=0..k-1)}; for i from 0 to q-1 do if (AM[q+1,i+1] > 0) then C[q] := C[q] minus {seq(X[i]-j mod k,j=-d+1..d-1)} end if; end do; end if; for z in C[q] do X[q] := z; if found=false then procname(q + 1); end if; end do; return Colorstar; end: V := vlist(G); n := nops(V); if n=0 then return true,[]; end if; AM := AdjacencyMatrix(G); X := Array(0..n-1); found:=false; Colorstar := []; X[0] := 0: Kcolor := kVC(1); if nargs=4 then VC := `if`(nops(Kcolor)=0,FAIL, Kcolor); end if; if nops(Kcolor) > 0 then return true else return false end if; end: # RP: merged into IsEdgeColorable # ############################################## # #PROCEDURE(doti) IsKDEdgeColorable # #ALIAS GraphTheory[IsKDEdgeColorable] # #CALLINGSEQ # #- IsKDEdgeColorable('G', 'k', 'd') # #- IsKDEdgeColorable('G', 'k', 'd', 'col') # # # #PARAMETERS # #- 'G' : undirected unweighted graph # #- 'k', 'd' : positive integers # #- 'col' : (optional) name # # # #DESCRIPTION # #- ~IsKDEdgeColorable(G,k,d)~ will return `true` if the graph 'G' is # # '(k,d)'-edge colorable, and `false` otherwise. That is, it returns `true` # # if the edges of 'G' can be colored with 'k' colors such that two edges # # with any given color are at least distance 'd' appart. # # # #- If a name 'col' is specified, then this name is assigned # # the list of colors of an optimal proper edge coloring, if it exists. # # The algorithm uses a backtracking technique. # # # #EXAMPLES # #> with(GraphTheory): # #> P := SpecialGraphs:-PetersenGraph(): # #> IsKDEdgeColorable(P, 11, 3, 'col'); # #< true # #> col; # #< [{9,10}=0,{1,5}=0,{1,6}=3,{1,2}=6,{3,4}=1,{2,3}=9,{3,7}=5,{2,9}=3,{4,5}=8,{5,8}=5,{4,10}=4,{6,7}=10,{6,10}=7,{8,9}=8,{7,8}=2] # #> IsKDEdgeColorable(P, 7, 2); # #< false # #SEEALSO # #- "IsKDColorable" # #- "IsKEdgeColorable" #---------ver. 23, modified by MG # RP: now a hidden export (use IsEdgeColorable) IsKDEdgeColorable := proc(G::GRAPHLN, k::posint, d::posint, EC::name) local b, C, E, LG, V; if getdir(G)=directed or getdir(G)=weighted then error "simple graph expected. See `UnderlyingGraph`." fi; LG := LineGraph(GraphInfo:-StandardGraph(G)); b := IsKDColorable(LG, k, d, C); if nargs=4 then V := vlist(G); E := map( e->map(x->V[x], convert(sscanf(e,"%d-%d"),set)) , vlist(LG) ); EC := [seq(E[i]=C[i], i=1..nops(E))]; end if; b end: # RP: merged into IsVertexColorable # ############################################## # #PROCEDURE(doti) IsKColorable # #ALIAS GraphTheory[IsKColorable] # #CALLINGSEQ # #- IsKColorable('G', 'k', 'col') # # # #PARAMETERS # #- 'G' : undirected graph # #- 'k' : positive integer # #- 'col' : (optional) name # # # #DESCRIPTION # #- ~IsKColorable(G,k)~ returns `true` if the graph 'G' is 'k'-colorable # # and `false` otherwise. That is, if the vertices of 'G' can be colored # # with 'k' colors such that no two adjacent vertices have the same color. # # # #- If a name 'col' is specified, then this name is assigned the # # list of colors of a 'k'-coloring of the vertices of 'G', if it exists. # # # #- The algorithm first tries a greedy coloring of the vertices of 'G' where we # # start with a maximum clique in 'G', then, if this fails to find a 'k'-coloring # # it does an exhaustive search using a backtracking algorithm. The problem # # of testing if a graph is 'k'-colorable is NP-complete, meaning that no # # efficient (polynomial time) algorithm is known. The exhaustive search # # will take exponential time on some graphs. # # # #EXAMPLES # #> with(GraphTheory): # #> P := SpecialGraphs:-PetersenGraph(); # #> IsKColorable(P, 2); # #< false # #> IsKColorable(P, 3, 'col'); # #< true # #> col; # #< [[1, 3, 8, 10], [2, 4, 6], [5, 7, 9]]; # # # #SEEALSO # #- "ChromaticNumber" # #- "IsKDColorable" #---------ver. 23, modified by MG #---------ver. 25, modified by MBM # RP: now a hidden export (use IsVertexColorable) IsKColorable := proc(G::GRAPHLN, k::nonnegint, VC::name) local n, A, X, LI, L, CHI, Gcolor, Kcolor, AM, C, kVC, i, MC, cn, P, Q, c, j, CC, V; kVC := proc(q) local i, z, S, C; if q=n then return true fi; # solution is in X #C[q] := {seq(i, i=0..k-1)}; #for i from 1 to q do # if (AM[P[q+1],P[i]] > 0) then C[q] := C[q] minus {X[i]} end if; #end do; S := A[P[q+1]] intersect {op(P[1..q])}; C := {$0..k-1} minus {seq(X[Q[i]],i=S)}; for z in C do X[q+1] := z; if procname(q + 1) then return(true); end if; end do; return false; end: V := vlist(G); n := nops(V); userinfo(3,{IsVertexColorable,GraphTheory}, sprintf("Color a graph with %d vertices using %d colors.",n,k)); if n=0 then if nargs=3 then VC := []; end if; return true; end if; LI := GraphInfo:-LabelToInteger(G); MC := map(x->LI[x], MaximumClique(G)); cn := nops(MC); userinfo(3,{IsVertexColorable,GraphTheory}, sprintf("Maximum clique of size %d found.",cn)); if k < cn then return false; fi; P := [op(MC),op({$1..n} minus {op(MC)})]; Q := Array(1..n); for i to n do Q[P[i]] := i od; Q := [seq(Q[i],i=1..n)]; CHI, Gcolor := GreedyColor(GraphInfo:-ApplyPermutation(G, P)): userinfo(3,{IsVertexColorable,GraphTheory}, sprintf("Greedy coloring with %d colors found.",CHI)); if k>=CHI then Kcolor := Gcolor else #AM := AdjacencyMatrix(G); A := listn(G); X := Array(1..n); for j from 1 to cn do X[j] := j-1; end do; # fix the first cn colors userinfo(3,{IsVertexColorable,GraphTheory}, sprintf("Backtracking starting: %d vertices left to color",n-cn)); if kVC(cn) then Kcolor := [seq(X[j],j=1..n)] else Kcolor := [] fi; end if; if nops(Kcolor)>0 then if nargs=3 then c := Array(1..n); # [seq(0,i=1..n)]; for i to n do c[P[i]] := Kcolor[i]; end do; CC := Array(1..k,fill={}); # [seq({}, i=1..k)]; for i to n do CC[c[i]+1] := CC[c[i]+1] union {V[i]}; end do; VC := convert( map(x->convert(x, list), CC), list ); end if; return true else #if nargs=3 then VC := FAIL; end if; return false; end if; end proc: # RP: merged into IsEdgeColorable # ############################################## # #PROCEDURE(doti) IsKEdgeColorable # #ALIAS GraphTheory[IsKEdgeColorable] # #CALLINGSEQ # #- IsKEdgeColorable('G', 'k') # #- IsKEdgeColorable('G', 'k', 'col') # # # #PARAMETERS # #- 'G' : undirected graph # #- 'k' : positive integer # #- 'col' : name used to return the list of colors of an optimal proper coloring (optional) # # # #DESCRIPTION # #- ~IsKEdgeColorable(G,k)~ returns `true` if the graph 'G' is 'k'-edge # # colorable and `false` otherwise. That is, if the edges of 'G' can be # # colored with 'k' colors such that no two indicent edges have the # # same color. # # # #- If a name 'col' is specified, then this name is assigned the list # # of colors of an optimal proper coloring of edges, if it exists. # # The algorithm uses a backtracking technique. # # # #EXAMPLES # #> with(GraphTheory): # #> G := SpecialGraphs:-PetersenGraph(): # #> IsKEdgeColorable(G, 3); # #< false # #> IsKEdgeColorable(G, 4, 'col'); # #< true # #> col; # #< [{{2,3},{7,8},{9,10},{1,5}},{{3,4},{1,2},{5,8},{6,10}},{{1,6},{3,7},{2,9},{4,5}},{{4,10},{6,7},{8,9}}] # #> map(nops, col); # #< [4, 4, 4, 3] # # # #SEEALSO # #- "ChromaticIndex" # #- "EdgeChromaticNumber" # #- "IsKDEdgeColorable" #---------ver. 23, modified by MG # RP: now a hidden export (use IsEdgeColorable) IsKEdgeColorable := proc(G::GRAPHLN, k::nonnegint, EC::name) local b, C, V, extractedge; if getdir(G)=directed or getdir(G)=weighted then error "simple graph expected. See `UnderlyingGraph`." fi; V := vlist(G); b := IsKColorable(LineGraph(GraphInfo:-StandardGraph(G)), k, 'C'); if nargs=3 then extractedge := proc(s) local i, j; i, j := op(sscanf(s, "%d-%d")); {V[i], V[j]}; end; EC := map(L->convert(map(extractedge, L), set), C); fi; b end: ############################################### ##PROCEDURE(doti) IsVertexColorable ##ALIAS GraphTheory[IsVertexColorable] ##CALLINGSEQ ##- IsVertexColorable('G', 'k', 'col') ##- IsVertexColorable('G', 'k', 'd', 'col') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'k' : non-negative integer (the number of colors) ##- 'd' : (optional) positive integer (distance) ##- 'col' : (optional) name ## ##DESCRIPTION ##- ~IsVertexColorable(G,k)~ returns `true` if the graph 'G' is 'k'-colorable ## and `false` otherwise. That is, if the vertices of 'G' can be colored ## with 'k' colors such that no two adjacent vertices have the same color. ## ##- If an optional argument 'd' is specified, ~IsVertexColorable(G,k,d)~ will ## return `true` if the graph 'G' is '(k,d)' colorable, and `false` otherwise. ## That is, it returns `true` if the vertices of 'G' can be colored with 'k' ## colors such that two vertices with any given color are at least distance ## 'd' appart. When 'd' is not specified it is assumed to be 1. ## ##- If a name 'col' is specified, then this name is assigned the ## list of colors of a coloring of the vertices of 'G', if it exists. ## ##- The algorithm first tries a greedy coloring of the vertices of 'G' ## starting with a maximum clique in 'G'. If this fails to find a 'k'-coloring ## it does an exhaustive search using a backtracking algorithm. The problem ## of testing if a graph is 'k'-colorable is NP-complete, meaning that no ## efficient (polynomial time) algorithm is known. The exhaustive search ## will take exponential time on some graphs. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(); ##> IsVertexColorable(P, 2); ##< false ##> IsVertexColorable(P, 3, 'col'); ##< true ##> col; ##< [[1, 3, 8, 10], [2, 4, 6], [5, 7, 9]] ##> J7 := SpecialGraphs:-FlowerSnark(7): ##> IsVertexColorable(J7, 7, 3, 'col'); ##< true ##> col; ##< [0, 3, 6, 2, 5, 1, 4, 3, 0, 3, 0, 3, 6, 2, 6, 2, 5, 2, 5, 1, 5, 1, 4, 1, 4, 0, 4, 0] ##> IsVertexColorable(J7, 9, 4); ##< false ## ##SEEALSO ##- "ChromaticNumber" ##- "CircularChromaticNumber" ##- "GreedyColor" ##- "IsEdgeColorable" ## ##XREFMAP ##- "ChromaticNumber" : Help:GraphTheory[ChromaticNumber] ##- "CircularChromaticNumber" : Help:GraphTheory[CircularChromaticNumber] ##- "GreedyColor" : Help:GraphTheory[GreedyColor] ##- "IsEdgeColorable" : Help:GraphTheory[IsEdgeColorable] IsVertexColorable := proc(G::GRAPHLN, k::nonnegint, d::{name, posint}, col::name) if nargs=2 then IsKColorable(G, k) elif nargs=3 and type(d, 'name') then IsKColorable(G, k, d) elif nargs=3 then IsKDColorable(G, k, d) elif nargs=4 then IsKDColorable(G, k, d, col) else error "wrong number of arguments" end if end proc: ############################################### ##PROCEDURE(doti) IsEdgeColorable ##ALIAS GraphTheory[IsEdgeColorable] ##CALLINGSEQ ##- IsEdgeColorable('G', 'k', 'col') ##- IsEdgeColorable('G', 'k', 'd', 'col') ## ##PARAMETERS ##- 'G' : undirected graph ##- 'k' : non-negative integer (the number of colors) ##- 'd' : (optional) positive integer (distance) ##- 'col' : (optional) name ## ##DESCRIPTION ##- ~IsEdgeColorable(G,k)~ returns `true` if the graph 'G' is 'k'-edge ## colorable and `false` otherwise. That is, if the edges of 'G' can be ## colored with 'k' colors such that no two indicent edges have the ## same color. ## ##- If an optional argument 'd' is specified, ~IsEdgeColorable(G,k,d)~ will ## return `true` if the graph 'G' is '(k,d)'-edge colorable, and `false` otherwise. ## That is, it returns `true` if the edges of 'G' can be colored with 'k' ## colors such that two edges with any given color are at least distance ## 'd' appart. When 'd' is not specified it is assumed to be 1. ## ##- If a name 'col' is specified, then this name is assigned the list ## of colors of an optimal proper coloring of edges of 'G', if it exists. ## The algorithm uses a backtracking technique. ## ##EXAMPLES ##> with(GraphTheory): ##> G := SpecialGraphs:-PetersenGraph(): ##> IsEdgeColorable(G, 3); ##< false ##> IsEdgeColorable(G, 4, 'col'); ##< true ##> col; ### [{{2,3},{7,8},{9,10},{1,5}},{{3,4},{1,2},{5,8},{6,10}},{{1,6},{3,7},{2,9},{4,5}},{{4,10},{6,7},{8,9}}] ##> map(nops, col); ### [4, 4, 4, 3] ##> IsEdgeColorable(G, 11, 3, 'col'); ##< true ##> col; ### [{9,10}=0,{1,5}=0,{1,6}=3,{1,2}=6,{3,4}=1,{2,3}=9,{3,7}=5,{2,9}=3,{4,5}=8,{5,8}=5,{4,10}=4,{6,7}=10,{6,10}=7,{8,9}=8,{7,8}=2] ##> IsEdgeColorable(G, 7, 2); ##< false ## ##SEEALSO ##- "CircularChromaticIndex" ##- "EdgeChromaticNumber" ##- "IsVertexColorable" ## ##XREFMAP ##- "CircularChromaticIndex" : Help:GraphTheory[CircularChromaticIndex] ##- "EdgeChromaticNumber" : Help:GraphTheory[EdgeChromaticNumber] ##- "IsVertexColorable" : Help:GraphTheory[IsVertexColorable] #---------ver. 23, modified by MG IsEdgeColorable := proc(G::GRAPHLN, k::nonnegint, d::{name, posint}, col::name) if nargs = 2 then IsKEdgeColorable(G, k) elif nargs = 3 and type(d, 'name') then IsKEdgeColorable(G, k, d) elif nargs = 3 then IsKDEdgeColorable(G, k, d) elif nargs > 3 then IsKDEdgeColorable(G, k, d, col) else error "wrong number of arguments" end if end proc: ############################################# ##PROCEDURE(doti) ArticulationPoints ##ALIAS GraphTheory[ArticulationPoints] ##CALLINGSEQ ##- ArticulationPoints('G') ## ##PARAMETERS ##- 'G' : undirected graph ## ##DESCRIPTION ##- A vertex ~v~ in 'G' is an articulation point of the graph 'G' if removing ## it and it's incident edges increases the number of connected components. ## ##- ~ArticulationPoints(G)~ returns a list of the vertices of 'G' which are ## articulation points. ## ##EXAMPLES ##> with(GraphTheory): ##> P5 := PathGraph(5); ##> ArticulationPoints(P5); ##< [2, 3, 4] ##> C5 := CycleGraph(5); ##> ArticulationPoints(C5); ##< [] ## ##SEEALSO ##- "IsBiconnected" ##- "IsConnected" ##- "VertexConnectivity" ## ##XREFMAP ##- "IsBiconnected" : Help:GraphTheory[IsBiconnected] ##- "IsConnected" : Help:GraphTheory[IsConnected] ##- "VertexConnectivity" : Help:GraphTheory[VertexConnectivity] #---------ver. 23, modified by MG ArticulationPoints := proc(G::GRAPHLN) local DFS, C, P, S, u, n, V, A, d, f, t, L, T; V, A := vlist(G), listn(G); n := nops(V); if getdir(G)=directed then return ArticulationPoints(UnderlyingGraph(G)) end if; if not(IsConnected(G)) then error"the input graph must be connected" end if; DFS := proc(u) local v; C[u] := 1; t := t + 1; L[u] := t; d[u] := L[u]; for v in A[u] do if v<>P[u] then if C[v] = 0 then P[v] := u; T[u] := T[u]+1; DFS(v); L[u] := min(L[u], L[v]); if L[v] >= d[u] then S[u] := 1 end if; else if d[v] < d[u] then L[u] := min(L[u], d[v]) end if; end if; end if; end do; C[u] := 2; t := t + 1; f[u] := t; end; L := Array(1..n); d := Array(1..n); f := Array(1..n); C := Array(1..n); P := Array(1..n); T := Array(1..n); S := Array(1..n); t := 0; for u to n do if C[u] = 0 then DFS(u); if T[u] <= 1 then S[u] := 0; end if; end if; end do; [seq(`if`(S[u]=1, V[u], NULL),u=1..n)] end; ############################################# ##PROCEDURE(doti) ImportGraph ##TITLE ImportGraph ##TITLE ExportGraph ##ALIAS GraphTheory[ImportGraph], GraphTheory[ExportGraph] ##CALLINGSEQ ##- ImportGraph('FileName', 'format') ##- ExportGraph('G', 'FileName', 'format') ## ##PARAMETERS ##- 'G' : graph ##- 'FileName' : string or symbol or function ##- 'format' : symbol or string ## ##DESCRIPTION ##- `ImportGraph` reads a graph from a file. The supported formats are ## '`dimacs`', '`dimacs_relaxed`', '`combinatorica`' and '`edges`'. ## ##- `ExportGraph` writes a graph into a file using the specified format. The ## supported formats are '`dimacs`' (only for undirected unweighted graphs), ## '`combinatorica`' (only for undirected unweighted graphs), `edges` (only for ## undirected unweighted graphs) and '`metapost`'. ## ##- To export a graph in Maple's format, use the "save" command. ## This saves the entire Maple data structure to a file, ## including vertex positions (used for drawing) and highlighted vertices. ## To read it back in later, use the "read" command. ## ##EXAMPLES ##> with(GraphTheory): ##> P := SpecialGraphs:-PetersenGraph(); ##> ExportGraph(P, "Graph1.mp", 'metapost'); ##- This creates the file \"Graph1.mp\" in the current working directory ## (see `currentdir`). In Unix, the ``mpost'' command can then be used to ## convert a metapost file to PostScript, for inclusion in a LaTeX document. ## ##> HighlightSubgraph(P, InducedSubgraph(P, [6,7,8,9,10])); ##> DrawGraph(P); ##>(execute=false) save P, "petersen.txt": ##- We have highlighted the star in the Petersen graph and saved it to a file ## \"petersen.txt\" in the current working directory. When the file is read, ## the graph will be reloaded (in the variable P) with the highlighting intact. ##>(execute=false) P := 'P': # unassign P ##>(execute=false) read "petersen.txt": ##> DrawGraph(P); ## ##SEEALSO ##- "Graph" ##- "read" ##- "save" ## ##XREFMAP ##- "Graph" : Help:GraphTheory[Graph] #---------ver. 23, modified by MG ImportGraph := proc(FileName::{string,symbol,function}, format::{symbol,string}) local fn, line, x, y, n, e, vertices, edg, E, G, vals, j, inp, a, b, count, v, T, f, m, V; fn := convert(FileName, string); if format = 'dimacs' or format = "dimacs" then vertices := NULL; edg := table(); edg["count"] := 0; fclose(fn); line := readline(fn): while line <> 0 do line := StringTools[LowerCase](line); if substring(line, 1..2) = "c " then # Do nothing! elif substring(line, 1..2) = "p " then n,e := op(sscanf(line, "p edge %d%d")); vertices := true; elif substring(line, 1..2) = "e " then vals := sscanf(line, "e %d%d"); x, y := op(vals); edg["count"] := edg["count"] + 1; edg[edg["count"]] := {x,y}; else error sprintf("Can not interprete input line: '%s'", line); fi; line := readline(fn); od: E := {seq(edg[aux], aux=1..edg["count"])}; if vertices = NULL or edg["count"] <> e or nops(E) <> e/2 then error "invalid file format!"; fi; Graph(n, E); elif format in {'edges', "edges"} then fclose(fn); f := fopen(fn, READ); n, m := op(fscanf(f, "%d%d")); E := {seq({op(fscanf(f, "%d%d"))}, i=1..m)}; if not map(nops, E)={2} then error "invalid file %1", fn; fi; G := Graph([$0..n-1], E); fclose(f); G; elif format = 'dimacs_relaxed' or format = "dimacs_relaxed" then vertices := NULL; edg := table(); edg["count"] := 0; fclose(fn); line := readline(fn): while line <> 0 do line := StringTools[LowerCase](line); j := 1; while line[j] = " " do j := j+1 od; if substring(line, j..j+1) = "c " then # Do nothing! elif substring(line, j..j+1) = "p " then n,e := op(sscanf(substring(line, j..length(line)), "p edge %d%d")); vertices := true; elif substring(line, j..j+1) = "e " then vals := sscanf(substring(line, j..length(line)), "e %d%d"); x, y := op(vals); edg["count"] := edg["count"] + 1; edg[edg["count"]] := {x,y}; else WARNING(sprintf("Can not interprete input line: '%s'", line)); fi; line := readline(fn); od: if vertices = NULL then error "invalid file format!"; fi; Graph(n, {seq(edg[aux], aux=1..edg["count"])}); elif format = 'combinatorica' or format = "combinatorica" then fclose(fn): line := readline(fn): inp := "": while line <> 0 do inp := cat(inp, line); line := readline(fn) od; inp := StringTools:-Remove(StringTools:-IsSpace, inp): if inp[1..7] <> "Graph[{" then error "Invalid file format." fi; #reading the edg a := 8: edg := table(): edg["count"] := 0; while 1=1 do b := a; if inp[b]="{" then count := 1; else error "Invalid file format." fi; while count > 0 do b := b+1; if b > length(inp) then error "Invalid file format." fi; if inp[b]="{" then count := count+1 elif inp[b]="}" then count := count-1 fi; od; e := sscanf(inp[a..b], "{{%d,%d}}"); if nops(e)=2 then edg["count"] := edg["count"] + 1; edg[edg["count"]] := convert(e, set); else error "Invalid file format." fi; if inp[b+1]="}" then break; elif inp[b+1]="," then a := b+2; else error "Invalid file format." fi od: E := [seq(edg[aux], aux=1..edg["count"])]; #we have to deal with the multiple edg later vertices := convert(map(x->op(x), E), set); if min(op(vertices)) < 1 then error "Invalid file format: vertices must be labelled by natural numbers." else n := max(op(vertices)); fi; #reading the vertices #the following is for when the list of positions is given #we must also handle functions like CircularEmbedding[n] #are there any other? vertices := table(); vertices["count"] := 0; if inp[b+1..b+3] = "},{" then a := b+4; while 1=1 do b := a; if inp[b]="{" then count := 1; else error "Invalid file format." fi; while count > 0 do b := b+1; if b > length(inp) then error "Invalid file format." fi; if inp[b]="{" then count := count+1 elif inp[b]="}" then count := count-1 fi; od; v := sscanf(inp[a..b], "{{%f,%f}"); if nops(v)=2 then vertices["count"] := vertices["count"] + 1; vertices[vertices["count"]] := v; else error "Invalid file format." fi; if inp[b+1]="}" then break; elif inp[b+1]="," then a := b+2; else error "Invalid file format." fi od: elif inp[b+1..b+20]="},CircularEmbedding[" then if n <> op(sscanf(inp[b+20..length(inp)], "[%d]")) then error "Invalid file format."; fi; fi; G := Graph(n, {op(E)}); if vertices["count"] = n then GraphInfo:-SetVPos(G, VP_FIXED, [seq(vertices[i], i=1..n)]); fi; G; elif format in {'metapost', "metapost"} then error "cannot Import a graph in this format"; else error "Unrecognized format %1.",format; end if; end proc: #------------------------------------------------------------ ExportGraph := proc(G::GRAPHLN, FileName::{string,symbol}, format::{symbol,string}) local fname, fn, V, E, e, n, j, x, y, c, s, vp, L, scale, endpoint, ep, mpunit, mpvrtxrad; fname := `if`(type(FileName, string), FileName, convert(FileName, string)); fclose(fname); if nargs=4 then if args[4] <> append then error "The 4-th argument must be 'append'"; elif format=dimacs then error "The DIMACS format does not support append."; else fn := fopen(fname, APPEND); fprintf(fn, "\n\n"); fi; else fn := fopen(fname, WRITE); fi; if format = 'edges' or format = "edges" then if getdir(G)=directed or getwt(G)=weighted then error "You can only export a simple graph to this format. Use 'UnderlyingGraph'." fi; fprintf(fn, "%0d\n%0d\n\n", NumberOfVertices(G), NumberOfEdges(G)); E := map(convert, convert(GraphInfo:-Edges(G), list), list ); E := sort(E, proc(x,y) x[1]0 then fprintf(fn, " {{%d, %d}}\n }\n ,\n", E[j][1], E[j][2]); fi; vp := GetDefaultVPos(G); if nops(vp)<>0 then fprintf(fn, " {\n"); for j to n-1 do fprintf(fn, " {{%f, %f}},\n", op(vp[j])); od; fprintf(fn, " {{%f, %f}}\n }\n]\n", op(vp[n])); else #fprintf(fn, "CircularEmbedding[%d]]\n", n); #CircularEmbedding is not supported by the GraphEditor x,y := 0,1; c,s := cos(2*Pi/n), sin(2*Pi/n); fprintf(fn, " {\n"); for j to n-1 do fprintf(fn, " {{%f, %f}},\n", x, y); x,y := c*x - s*y, s*x + c*y; od; fprintf(fn, " {{%f, %f}}\n }\n]\n", x, y); fi; elif format = 'metapost' or format = "metapost" then if getdir(G)=directed then endpoint := proc(a, b, r) local x, y; if abs(a[1] - b[1]) < 1e-5 then x := b[1]; y := b[2] + `if`(a[2] with(GraphTheory): ##> Q3 := SpecialGraphs:-HypercubeGraph(3); ##> Neighborhood(Q3, "000"); ##< ["001", "010", "100"] ##> Neighborhood(Q3, "000", `closed`); ##< ["000", "001", "010", "100"] ## ##SEEALSO ##- "AdjacencyMatrix" ##- "Degree" ##- "Neighbors" ## ##XREFMAP ##- "AdjacencyMatrix" : Help:GraphTheory[AdjacencyMatrix] ##- "Degree" : Help:GraphTheory[Degree] ##- "Neighbors" : Help:GraphTheory[Neighbors] #---------ver. 23, modified by MG Neighborhood := proc (G::GRAPHLN, v::VERTEXTYPE, ntype) local V, A, L, n, j, Nbrs; V, A := vlist(G), listn(G); n := nops(V); L := GraphInfo:-LabelToInteger(G); if not type(L[v], integer) then error "%1 is not a vertex of the given graph", v; end if; j := L[v]; if nargs=2 or ntype='open' then Nbrs := {seq(`if`(member(j,A[i]) or member(i,A[j]), i, NULL),i=1..n)} elif ntype='closed' then Nbrs := {j, seq(`if`(member(j,A[i]) or member(i,A[j]), i, NULL),i=1..n)} else error "third argument should be either open or closed, but received %1", ntype end if; map(x->V[x], [op(Nbrs)]); end; # RP: this command was removed # ############################################# # ClosedNeighborhood := proc (G::GRAPHLN, v::VERTEXTYPE) # local V, A, L, n, j, Nbrs; # V, A := vlist(G), listn(G); # n := nops(V); # L := GraphInfo:-LabelToInteger(G); # # if not type(L[v], integer) then # error "%1 is not a vertex of the given graph.",v; # fi; # # j := L[v]; # Nbrs := {j,seq(`if`(member(j,A[i]) or member(i,A[j]), i, NULL),i=1..n)}; # map(x->V[x], [op(Nbrs)]); # end; ############################################# ##PROCEDURE(doti) BipartiteMatching ##ALIAS GraphTheory[BipartiteMatching] ##CALLINGSEQ ##- BipartiteMatching('G') ## ##PARAMETERS ##- 'G' : undirected unweighted bipartite graph ## ##DESCRIPTION ##- `BipartiteMatching`('G') returns the size of a maximum matching in a bipartite ## graph 'G'. It also returns the set of edges of one maximum matching. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({{1,2}, {2,3}, {3,4}, {3,8}, {4,5}, {5,6}, {6,7}}); ##> B := BipartiteMatching(G); ##< 4, {{1, 2}, {3, 8}, {4, 5}, {6, 7}} ## ##- Draw the matching in red ## ##> HighlightEdges(G, B[2]); ##> DrawGraph(G,style=bipartite); ## ##SEEALSO ##- "DrawGraph" ##- "HighlightEdges" ##- "IsBipartite" ## ##XREFMAP ##- "DrawGraph" : Help:GraphTheory[DrawGraph] ##- "HighlightEdges" : Help:GraphTheory[HighlightEdges] ##- "IsBipartite" : Help:GraphTheory[IsBipartite] #---------ver. 23, modified by MG BipartiteMatching := proc (G::GRAPHLN) local V, A, N, P, X, Y, E, L, v, w, a, b, n, source, sink, k, T, M, e; if not IsBipartite(G, 'P') then error "The graph is not bipartite." fi; if getdir(G) = 'directed' or getwt(G) = 'weighted' then error "The input graph must be a simple graph."; fi; V := vlist(G); n := nops(V); source, sink := n+1, n+2; A := listn(G); L := GraphInfo:-LabelToInteger(G); X, Y := op(P); E := seq([source,L[v]], v in X); for v in X do a := L[v]; for b in A[a] do E := E, [a,b]; od; od; E := E,seq([L[w],sink], w in Y); N := Graph([$1..n+2], {E}, weighted); k, T := MaxFlow(N, source, sink); T := convert(map(x->[lhs(x)], op(2, T)), set); M := NULL; for e in T do if e[1]<=n and e[2]<=n then M := M, {V[e[1]], V[e[2]]}; fi; od; k, {M}; end proc; ############################################# ##PROCEDURE(doti) CartesianProduct ##TITLE CartesianProduct ##TITLE TensorProduct ##ALIAS GraphTheory[CartesianProduct], GraphTheory[TensorProduct] ##CALLINGSEQ ##- CartesianProduct('G1', 'G2', ...) ##- TensorProduct('G1', 'G2', ...) ## ##PARAMETERS ##- 'G1', 'G2', ... : graphs ## ##DESCRIPTION ## ##- `CartesianProduct` accepts a sequence of graphs as its arguments and returns the ## Cartesian product of those graphs. If ~V1~ is the vertices of ~G1~ and ~V2~ the vertices ## of ~G2~ then the vertices of ~G~, the cartesian product of ~G1~ and ~G2~, are ~V1 X V2~. ## If ~u~ is a vertex in ~G1~ and ~v~ in ~G2~ we label the vertices in ~G~ by ~u:v~. ## For ~u1,u2~ in ~V1~ and ~v1,v2~ in ~V2~, the edge ~(u1:v1, u2:v2)~ is in ~G~ iff ## ~u1~ is adjacent to ~u2~ and ~v1 = v2~ or ~u1 = u2~ and ~v1~ is adjacent to ~v2~. ## ##- `TensorProduct` accepts a sequence of graphs as its arguments and returns the ## tensor product of those graphs. If ~V1~ is the vertices of ~G1~ and ~V2~ the vertices ## of ~G2~ then the vertices of ~G~ the tensor product of ~G1~ and ~G2~ are ~V1 X V2~. ## If ~u~ is a vertex in ~G1~ and ~v~ in ~G2~ we label the vertices in ~G~ by ~u:v~. ## For ~u1,u2~ in ~V1~ and ~v1,v2~ in ~V2~, the edge ~u1:v1,u2:v2~ is in ~G~ iff ## ~u1~ is adjacent to ~u2~ in ~G1~ and ~v1~ is adjacent to ~v2~ in ~G2~. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph( {{0,1}} ); ##> H := CartesianProduct(G,G); ##> Vertices(H); ##> Edges(H); ##< {{"0:0", "0:1"}, {"0:0", "1:0"}, {"0:1", "1:1"}, {"1:0", "1:1"}} ##> T := TensorProduct(G,G); ##> Vertices(T); ##> Edges(T); ##< {{"1:0", "0:1"}, {"0:0", "1:1"}} ##> with(StringTools): ##> with(SpecialGraphs): ##> H := CartesianProduct(G,G,G); ##> V := map(v->Select(IsBinaryDigit, v), Vertices(H)); ##< ["000", "001", "010", "011", "100", "101", "110", "111"] ##> Q := RelabelVertices(H, V); ##> evalb( Edges(Q) = Edges(HypercubeGraph(3))); ##< true ## ##SEEALSO ##- "DisjointUnion" ##- "GraphJoin" ##- "GraphUnion" ## ##XREFMAP ##- "DisjointUnion" : Help:GraphTheory[DisjointUnion] ##- "GraphJoin" : Help:GraphTheory[GraphJoin] ##- "GraphUnion" : Help:GraphTheory[GraphUnion] #---------ver. 23, modified by MG #---------ver. 26, modified by MBM CartesianProduct := proc(G1::GRAPHLN, G2::GRAPHLN) local H, D1, W1, V1, A1, n1, D2, W2, V2, A2, n2, D, W, V, A, i, j; if nargs > 2 then return CartesianProduct(G1,CartesianProduct((args[2..nargs]))); fi; D1, W1, V1, A1 := op(1..4, G1); D2, W2, V2, A2 := op(1..4, G2); if D1 <> D2 then error "Graphs must be either all directed or all undirected." fi; if W1 = weighted or W2 = weighted then error "Graphs must be unweighted." fi; D := D1; n1, n2 := nops(V1), nops(V2); A := Array(1..n1*n2); for i to n1 do for j to n2 do A[(i-1)*n2+j] := map(x->(x-1)*n2+j, A1[i]) union map(x->(i-1)*n2+x, A2[j]); od; od; V := Array(1..n1*n2); for i to n1 do for j to n2 do V[(i-1)*n2+j] := sprintf("%s:%s", convert(V1[i], string), convert(V2[j], string)); od; od; GRAPHLN(D,unweighted,[seq(V[i], i=1..n1*n2)],A,GRAPH_TABLE_NAME(),0); end proc; TensorProduct := proc(G1::GRAPHLN,G2::GRAPHLN) local m,n,V1,V2,i,j,k,l,G,vp,M,V,D; if nargs>2 then return TensorProduct(TensorProduct(G1,G2),args[3..nargs]) fi; m := NumberOfVertices(G1); n := NumberOfVertices(G2); V1 := Vertices(G1); V2 := Vertices(G2); D := IsDirected(G1) or IsDirected(G2); V := [seq( [seq( cat("",V2[n-j+1],":",V1[i]), j=1..n)], i=1..m )]; G := Graph(m*n,D,map(op,V)); for i to m do for j to n do for k to m do for l to n do if i <> k and j <> l and HasEdge(G1,{V1[i],V1[k]}) and HasEdge(G2,{V2[j],V2[l]}) then AddEdge(G,{V[i,j],V[k,l]}); fi; od od od od; vp := Array(1 .. m*n); M := 1.0/max(n,m); vp := [seq( seq( [M*i,M*j], j=1..n ), i=1..m )]; SetVertexPositions(G,vp,"draw-pos-fixed"); G; end: GetDefaultVPos := proc(G::GRAPHLN) local vp; vp := GraphInfo:-GetVPos(G, VP_DEFAULT); if nops(vp) = 0 then vp := GraphInfo:-GetVPos(G, VP_FIXED); fi; vp; end proc; ############################################# # BEGIN --- Mahdi, 24/Oct/2005 ############################################# ############################################## ##PROCEDURE(doti) IsNetwork ##ALIAS GraphTheory[IsNetwork] ##CALLINGSEQ ##- IsNetwork('G', 's', 't') ##- IsNetwork('G') ## ##PARAMETERS ##- 'G' : directed graph ##- 's' : vertex ##- 't' : vertex ## ##DESCRIPTION ## ##- A network is a connected directed graph with at least one vertex with ## indegree 0 (the source) and at least one vertex with outdegree 0 (the sink). ## Note under this definition a network may have an internal cycle. ## ##- `IsNetwork`('G','s','t') outputs `true` if the directed graph 'G' is a network with 's' as ## the source and 't' as the sink, and `false` otherwise. ## ##- `IsNetwork`('G') tests if a directed graph is a network. ## The output will be a sequence of two sets of vertices, sources and sinks, ## of all possible sources and sinks. If these sets are both empty then 'G' ## is implicitly not a network. ## ##EXAMPLES ##> with(GraphTheory): ##> N := Digraph({[1,2],[1,3],[2,4],[3,4]}); ##> IsNetwork(N); ##< {1}, {4} ##> IsNetwork(N, 1, 4); ##< true ##> IsNetwork(N, 1, 2); ##< false ##> DrawNetwork(N); ## ##SEEALSO ##- "Digraph" ##- "DrawNetwork" ##- "MaxFlow" ##- "RandomGraphs[RandomNetwork]" ## ##XREFMAP ##- "Digraph" : Help:GraphTheory[Digraph] ##- "DrawNetwork" : Help:GraphTheory[DrawNetwork] ##- "MaxFlow" : Help:GraphTheory[MaxFlow] #---------ver. 23, modified by Mahdi #---------ver. 24, redefined by MBM IsNetwork := proc(G::GRAPHLN) local ad, S, T, i, n, Tb, SS, TT, V; if not nargs in {1,3} then error "Invalid number of arguments." fi; if getdir(G) = undirected then if nargs=3 then return false else return {}, {} fi; fi; if not IsConnected(G) then if nargs=3 then return false else return {}, {} fi; fi; V := vlist(G); ad := listn(G); n := nops(V); if nargs = 3 then Tb := GraphInfo:-LabelToInteger(G); S := Tb[args[2]]; if not type(S,integer) then error "%1 is not a vertex in the graph",args[2]; fi; T := Tb[args[3]]; if not type(T,integer) then error "%1 is not a vertex in the graph",args[2]; fi; if ad[T] <> {} then return false; fi; for i from 1 to n do if member(S , ad[i]) then return false; fi; od; return true; fi; TT := {}; SS := {seq(i,i=1..n)}; for i from 1 to n do if ad[i] = {} then TT := TT union {i}; fi; SS := SS minus ad[i]; od; if SS = {} or TT = {} then return {}, {}; fi; S := {seq( V[i], i=SS )}; T := {seq( V[i], i=TT )}; return S,T; end proc; ############################################## ##PROCEDURE(doti) DrawNetwork ##ALIAS GraphTheory[DrawNetwork] ##CALLINGSEQ ##- DrawNetwork('G') ##- DrawNetwork('G', 'st') ##- DrawNetwrok('G', 'S', 'T') ##- DrawNetwork('G', 'S', 'T', 'st') ## ##PARAMETERS ##- 'G' : graph ##- 'st' : (optional) '`horizontal`', '`vertical`' ##- 'S' : (optional) vertex ##- 'T' : (optional) vertex ## ##RETURNS ## returns a PLOT data structure ## ##SYNOPSIS ##- `DrawNetwork` displays the vertices, arcs and vertex labels of a network. ## A network is a directed graph with at least one vertex with indegree ## 0 (the source) and at least on vertex with outdegree 0 (the sink). ##- If the user specifies 'S' and 'T', the graph will be displayed with 'S' as the ## main source and 'T' as the main sink. ##- The network can be displayed either horizontally or vertically. ##- Remaining options are passed on to the "DrawGraph" command. ## ##EXAMPLES ##> with(GraphTheory): ##> N := Digraph({[1,2],[1,3],[2,4],[3,4]}); ##> DrawNetwork(N); ##> DrawNetwork(N, 'horizontal'); ##> G := Digraph({[1,3],[2,3],[3,4],[3,5]}): ##> IsNetwork(G); ##< {1,2}, {4,5} ##> DrawNetwork(G, 2, 5); ## ##SEEALSO ##- "Digraph" ##- "IsNetwork" ##- "MaxFlow" ##- "RandomGraphs[RandomNetwork]" ## ##XREFMAP ##- "Digraph" : Help:GraphTheory[Digraph] ##- "IsNetwork" : Help:GraphTheory[IsNetwork] ##- "MaxFlow" : Help:GraphTheory[MaxFlow] #---------ver. 23, modified by Mahdi DrawNetwork := proc() GraphDrawing:-DrawNetwork(args) end; ############################################ ##PROCEDURE(doti) TreeHeight ##ALIAS GraphTheory[TreeHeight] ##CALLINGSEQ ##- TreeHeight('T', 'r') ## ##PARAMETERS ##- 'T' : a tree ##- 'r' : a vertex ## ##DESCRIPTION ##- `TreeHeight' returns the height of the tree 'T' with the vertex 'r' as root. ## In other words it returns the maximum distance of the vertices of 'T' from 'r'. ## ##EXAMPLES ##> with(GraphTheory): ##> T := Graph({{1,2},{2,3},{2,4},{4,5}}); ##> TreeHeight(T, 1); ##< 3 ##> TreeHeight(T, 4); ##< 2 ##> DrawGraph(T); ## ##SEEALSO ##- "Diameter" ##- "IsTree" ##- "SpanningTree" ## ##XREFMAP ##- "Diameter" : Help:GraphTheory[Diameter] ##- "IsTree" : Help:GraphTheory[IsTree] ##- "SpanningTree" : Help:GraphTheory[SpanningTree] #---------ver. 23, modified by MG TreeHeight := proc(t::GRAPHLN, r::VERTEXTYPE) local ad, SubTreeHeight; if not IsTree(t) then error "first argument is expected to be a tree."; fi; if not type(GraphInfo:-LabelToInteger(t)[r], integer) then error "%1 is not a vertex of the tree."; fi; ad := listn(t); SubTreeHeight := proc(t, v, p) local children, h, w; children := `minus`(ad[v], {p}); if nops(children) = 0 then return 0 else h := 0; for w in children do h := max(h, SubTreeHeight(t, w, v)) end do; end if; return h + 1; end proc;; return SubTreeHeight(t, r, 0); end proc; ############################################# # END --- Mahdi, 24/Oct/2005 ############################################# ############################################ ##PROCEDURE(doti) IsIntegerGraph ##ALIAS GraphTheory[IsIntegerGraph] ##CALLINGSEQ ##- IsIntegerGraph('G') ## ##PARAMETERS ##- 'G' : a graph ## ##DESCRIPTION ##- `IsIntegerGraph' returns `true` if its argument 'G' is an integer graph, namely if ## the spectrum of 'G' consists of only integer numbers, and `false` otherwise. ## ##EXAMPLES ##> with(GraphTheory): ##> K3 := CompleteGraph(3); ##> IsIntegerGraph(K3); ##< true ##> factor(CharacteristicPolynomial(K3,x)); ##< (x-2)*(x+1)^2 ##> P3 := PathGraph(3); ##> IsIntegerGraph(P3); ##< false ##> factor(CharacteristicPolynomial(P3,x)); ##< x*(x^2-2) ##> H := SpecialGraphs:-LeviGraph(); ##> IsIntegerGraph(H); ##< true ##> factor(CharacteristicPolynomial(H,x)); ## ##SEEALSO ##- "CharacteristicPolynomial" ##- "GraphSpectrum" ## ##XREFMAP ##- "CharacteristicPolynomial" : Help:GraphTheory[CharacteristicPolynomial] ##- "GraphSpectrum" : Help:GraphTheory[GraphSpectrum] #---------ver. 23, modified by MG IsIntegerGraph := proc(G::GRAPHLN) local spec; spec := map(x->x[1], GraphSpectrum(G, 'exact')); evalb(type(spec, list(integer))); end proc; ############################################## SetVPos := proc() GraphInfo:-SetVPos(args) end proc; GetVPos := proc() GraphInfo:-GetVPos(args) end proc; SetVColor := proc() GraphInfo:-SetVColor(args) end proc; GetVColor := proc() GraphInfo:-GetVColor(args) end proc; SetLPos := proc() GraphInfo:-SetLPos(args) end proc; GetLPos := proc() GraphInfo:-GetLPos(args) end proc; SetEdgesColor := proc() GraphInfo:-SetEdgesColor(args) end proc; GetEdgesColor := proc() GraphInfo:-GetEdgesColor(args) end proc; SetEdgesThickness := proc() GraphInfo:-SetEdgesThickness(args) end proc; GetEdgesThickness := proc() GraphInfo:-GetEdgesThickness(args) end proc; ############################################## ##PROCEDURE(doti) GraphAttributes ##TITLE GetGraphAttribute ##TITLE GetVertexAttribute ##TITLE GetEdgeAttribute ##TITLE SetGraphAttribute ##TITLE SetVertexAttribute ##TITLE SetEdgeAttribute ##TITLE ListGraphAttributes ##TITLE ListVertexAttributes ##TITLE ListEdgeAttributes ##TITLE DiscardGraphAttribute ##TITLE DiscardVertexAttribute ##TITLE DiscardEdgeAttribute ##ALIAS GraphTheory[GraphAttributes], GraphTheory[Attributes] ##ALIAS GraphTheory[SetGraphAttribute], GraphTheory[GetGraphAttribute], GraphTheory[DiscardGraphAttribute] ##ALIAS GraphTheory[SetVertexAttribute], GraphTheory[GetVertexAttribute], GraphTheory[DiscardVertexAttribute], ##ALIAS GraphTheory[SetEdgeAttribute], GraphTheory [GetEdgeAttribute], GraphTheory[DiscardEdgeAttribute] ##ALIAS GraphTheory[ListGraphAttributes], GraphTheory[ListVertexAttributes], GraphTheory[ListEdgeAttributes] ##CALLINGSEQ ##- SetGraphAttribute('G', 'attr') ##- SetVertexAttribute('G', 'v', 'attr') ##- SetEdgeAttribute('G', 'e', 'attr') ##- GetGraphAttribute('G', 'tag') ##- GetVertexAttribute('G', 'v', 'tag') ##- GetEdgeAttribute('G', 'e', 'tag') ##- DiscardGraphAttribute('G', 'tag') ##- DiscardVertexAttribute('G', 'v', 'tag') ##- DiscardEdgeAttribute('G', 'e', 'tag') ##- ListGraphAttributes('G') ##- ListVertexAttributes('G', 'v') ##- ListEdgeAttributes('G', 'e') ## ##PARAMETERS ##- 'G' : graph ##- 'v' : vertex ##- 'e' : edge/arc ##- 'attr' : equation or list of equations ##- 'tag' : (optional) simple type or list ## ##DESCRIPTION ##- ~SetVertexAttribute(G,v,attr)~ is used to store arbitrary information in the form ## of 'tag'=`value` for vertex 'v' in a graph 'G'. These equations are called attributes. ## The argument attr can be a single attribute to be assigned to 'v' or a list of ## attributes. Note that for a fixed vertex, tags must be unique. ## If the vertex already has an attribute with the given tag, the ## command reassigns the value of that tag to the new value provided by attr. ## ##- ~GetVertexAttribute(G,v,tag)~ is used to retrieve all or some of the attributes of ## vertex 'v'. If 'tag' is a single tag, then the value corresponding to that tag ## is returned. If no attribute with the specified tag is defined for 'v' the command ## returns `FAIL`. The argument 'tag' can also be a list of tags in which case a list ## of values is returned. ## ##- ~DiscardVertexAttribute(G,v,tag)~ is used to discard all or some of the attributes ## of the vertex 'v' in the graph 'G'. ## If the optional argument 'tag' is not present, all attributes of 'v' are discarded. ## If a single tag or a list of tags is specified then the attributes corresponding to ## those tags are discarded. If an attribute with the given tag is not found, the command ## does nothing. ## ##- ~ListVertexAttributes(G,v)~ is used to list all attributes for vertex 'v' in the ## graph 'G'. It outputs a list, possibly empty, of the tags used for the ## attributes in 'G'. ## ##- ~SetGraphAttribute~, ~GetGraphAttribute~, ~DiscardGraphAttribute~, ~ListGraphAttributes~ ## are similar to their vertex analogues and are used to manage attributes of a graph rather ## than a particular vertex in a graph. ## ##- ~SetEdgeAttribute~, ~GetEdgeAttribute~, ~DiscardEdgeAttribute~, ~ListEdgeAttributes~ ## are similar to their vertex analogues but are used to manage attributes of the edges ## of a graph instead of a vertex in a graph. ## ##EXAMPLES ##> with(GraphTheory): ##> T := SpecialGraphs:-CompleteBinaryTree(3); ##> [SetVertexAttribute(T, 1, "label"="root")]; ##> [SetEdgeAttribute(T, {9,10}, ["message"="i am an edge!", "cost"=12.4])]; ##> GetVertexAttribute(T, 1, ["label", "message"]); ##< ["root", FAIL] ##> GetEdgeAttribute(T, {9,10}); ##< ["message" = "i am an edge!", "cost" = 12.4] ##> DiscardVertexAttribute(T, 1); ##> DiscardEdgeAttribute(T, {9,10}, "message"); ## ##SEEALSO ##- "CopyGraph" ##- "Graph" ## ##XREFMAP ##- "CopyGraph" : Help:GraphTheory[CopyGraph] ##- "Graph" : Help:GraphTheory[Graph] #---------ver. 23, modified by MG SetGraphAttribute := proc(G::GRAPHLN, Q::{equation, list(equation)}) local queue; queue := `if`(type(Q, list), Q, [Q]); GraphInfo:-SetAttrib(G, [0], [queue]); end proc; ############################################## SetVertexAttribute := proc(G::GRAPHLN, v::VERTEXTYPE, Q::{equation, list(equation)}) local obj, queue; obj := GraphInfo:-LabelToInteger(G)[v]; if not type(obj, integer) then error "invalid vertex %1", v; fi; queue := `if`(type(Q, list), Q, [Q]); GraphInfo:-SetAttrib(G, [obj], [queue]); end proc; ############################################## SetEdgeAttribute := proc(G::GRAPHLN, e::EDGETYPE, Q::{equation, list(equation)}) local obj, queue; obj := map(v->GraphInfo:-LabelToInteger(G)[v], e ); if not type([op(obj)], [integer, integer]) or not member(obj[2], listn(G)[obj[1]]) or getdir(G)=directed and type(obj,set) or getdir(G)=undirected and type(obj,list) then error "invalid edge %1", e; fi; queue := `if`(type(Q, list), Q, [Q]); GraphInfo:-SetAttrib(G, [obj], [queue]); end proc; ############################################## ListGraphAttributes := proc(G::GRAPHLN) local A: A := GraphInfo:-GetAttrib(G,[0]); if not type(A, [list(`=`)]) then error "should not happen" fi; map( lhs, A[1] ); end: ############################################## ListVertexAttributes := proc(G::GRAPHLN,v::VERTEXTYPE) local A,i; i := GraphInfo:-LabelToInteger(G)[v]; if not type(i, integer) then error "invalid vertex %1", v; fi; A := GraphInfo:-GetAttrib(G,[i]); if not type(A, [list(`=`)]) then error "should not happen" fi; map( lhs, A[1] ); end: ############################################## ListEdgeAttributes := proc(G::GRAPHLN,edge::EDGETYPE) local A,e,L,i,j; e := `if`(type(edge[1],VERTEXTYPE), edge, edge[1]); if IsDirected(G) then HasArc(G,e); else HasEdge(G,e); fi; # check that it is a valid edge L := GraphInfo:-LabelToInteger(G); i,j := L[e[1]],L[e[2]]; if not type([i,j],[integer,integer]) then error "invalid edge %1", e; fi; A := GraphInfo:-GetAttrib(G, [[i,j]]); if not type(A, [list(`=`)]) then error "should not happen" fi; map( lhs, A[1] ); end: ############################################## GetGraphAttribute := proc(G::GRAPHLN, Q) local queue, result; if nargs=1 then op( GraphInfo:-GetAttrib(G, [0]) ); else queue := `if`(type(Q, list), Q, [Q]); result := op( GraphInfo:-GetAttrib(G, [0], [queue]) ); `if`(type(Q, list), result, op(result)); fi; end proc; ############################################## GetVertexAttribute := proc(G::GRAPHLN, v::VERTEXTYPE, Q) local obj, queue, result; obj := GraphInfo:-LabelToInteger(G)[v]; if not type(obj, integer) then error "invalid vertex %1", v; fi; if nargs=2 or nargs=3 and args[3] = 'notest' then op( GraphInfo:-GetAttrib(G, [obj]) ); else queue := `if`(type(Q, list), Q, [Q]); result := op( GraphInfo:-GetAttrib(G, [obj], [queue]) ); `if`(type(Q, list), result, op(result)); fi; end proc; ############################################## GetEdgeAttribute := proc(G::GRAPHLN, e::EDGETYPE, Q) local obj, queue, result; obj := map(v->GraphInfo:-LabelToInteger(G)[v], `if`(type(e[1], VERTEXTYPE), e, e[1]) ); if not type([op(obj)], [integer, integer]) or not member(obj[2], listn(G)[obj[1]]) or getdir(G)=directed and type(obj,set) or getdir(G)=undirected and type(obj,list) then error "invalid edge %1", e; fi; if nargs=2 then op( GraphInfo:-GetAttrib(G, [obj]) ); else queue := `if`(type(Q, list), Q, [Q]); result := op( GraphInfo:-GetAttrib(G, [obj], [queue]) ); `if`(type(Q, list), result, op(result)); fi; end proc; ############################################## DiscardGraphAttribute := proc(G::GRAPHLN, Q) local queue; if nargs=1 then GraphInfo:-DiscardAttrib(G, [0]); #printf("Discarded all attributes of the graph.\n"); else queue := `if`(type(Q, list), Q, [Q]); GraphInfo:-DiscardAttrib(G, [0], [queue]); #printf("Discarded the attribute(s) %a of the graph.\n", queue); fi; end proc; ############################################## DiscardVertexAttribute := proc(G::GRAPHLN, v::VERTEXTYPE, Q) local obj, queue; obj := GraphInfo:-LabelToInteger(G)[v]; if not type(obj, integer) then error "invalid vertex %1", v; fi; if nargs=2 then GraphInfo:-DiscardAttrib(G, [obj]); #printf("Discarded all attributes of the vertex %a.\n", v); else queue := `if`(type(Q, list), Q, [Q]); GraphInfo:-DiscardAttrib(G, [obj], [queue]); #printf("Discarded the attribute(s) %a of the vertex %a.\n", queue, v); fi; end proc; ############################################## DiscardEdgeAttribute := proc(G::GRAPHLN, e::EDGETYPE, Q) local obj, queue; obj := map(v->GraphInfo:-LabelToInteger(G)[v], `if`(type(e[1], VERTEXTYPE), e, e[1]) ); if not type([op(obj)], [integer, integer]) or not member(obj[2], listn(G)[obj[1]]) or getdir(G)=directed and type(obj,set) or getdir(G)=undirected and type(obj,list) then error "invalid edge %1", e; fi; if nargs=2 then GraphInfo:-DiscardAttrib(G, [obj]); #printf("Discarded all attributes of the edge %a.\n", e); else queue := `if`(type(Q, list), Q, [Q]); GraphInfo:-DiscardAttrib(G, [obj], [queue]); #printf("Discarded the attribute(s) %a of the edge %a.\n", queue, e); fi; end proc; ############################################## ##PROCEDURE(doti) PermuteVertices ##TITLE PermuteVertices ##TITLE IsomorphicCopy ##ALIAS GraphTheory[PermuteVertices], GraphTheory[IsomorphicCopy] ##CALLINGSEQ ##- PermuteVertices('G', 'sigma') ##- IsomorphicCopy('G', 'sigma') ## ##PARAMETERS ##- 'G' : graph ##- 'sigma' : (optional) a (permuted) list of the vertices of 'G' ## ##DESCRIPTION ##- The command `PermuteVertices`('G','sigma') returns a new graph ~H~ with ## ~Vertices(H)~ = 'sigma'. The list of neighbors data structure is reordered ## according to sigma so that the adjacency matrix of ~H~ will be different ## in general. Attribute information, including vertex position information ## is also permuted according to sigma so that ~DrawGraph(H)~ will look ## identical to ~DrawGraph(G)~. ## ##- The command `IsomorphicCopy`('G','sigma') returns a new graph ~H~ where the list ## of neighbors data structure is reordered according to sigma but the ## vertex labels of ~H~ are the same as 'G'. ## It also discards all attributes from 'G' so that if ~H~ is drawn, ## it will not be obvious that ~H~ is isomorhic to 'G'. ## ##- The command `PermuteVertices`('G') chooses a random permutation sigma ## of the vertices of 'G' then returns ~H = PermuteVertices(G,sigma)~. ## Hence ~Vertices(H)~ is the permutation used. ## ##- The command `IsomorphicCopy`('G') chooses a random permutation sigma ## of the vertices of 'G' and returns `IsomorphicCopy`('G','sigma'). ## ##EXAMPLES ##> with(GraphTheory): ##> G := PathGraph(5); ##> Vertices(G), Neighbors(G); ##> H := PermuteVertices(G,[3,5,1,2,4]); ##> Vertices(H); ##< [3, 5, 1, 2, 4] ##> Neighbors(H); ##< [[2, 4], [4], [2], [3, 1], [3, 5]] ##> H := IsomorphicCopy(G,[3,5,1,2,4]); ##> Vertices(H), Neighbors(H); ### [1, 2, 3, 4, 5], [[2, 4], [4], [2], [3, 1], [3, 5]] ##> H := PermuteVertices(G); # a random permutation ##> sigma := Vertices(H); ##> P := SpecialGraphs:-PrismGraph(3,3); ##> H := IsomorphicCopy(P,[4,1,2,6,5,3]); ##> DrawGraph(P); ##> DrawGraph(H,style=spring); ## ##SEEALSO ##- "GraphInfo[ApplyPermutation]" ##- "GraphCopy" ##- "RelabelVertices" ##- "Vertices" ## ##XREFMAP ##- "GraphCopy" : Help:GraphTheory[GraphCopy] ##- "RelabelVertices" : Help:GraphTheory[RelabelVertices] ##- "Vertices" : Help:GraphTheory[Vertices] #---------ver. 23, modified by MG #---------ver. 25, IsomorphicCopy added by MBM IsomorphicCopy := proc(G::GRAPHLN,V::list(VERTEXTYPE)) local P; P := PermuteVertices(args); subsop(3=Vertices(G),5=GRAPH_TABLE_NAME(),P); end: PermuteVertices := proc(G::GRAPHLN, W::list(VERTEXTYPE)) local V,n,A,U,B,i,u; V := Vertices(G); n := nops(V); if nargs=1 then # do a random permutation A := Array(1..n); U := rand(1..10^12); B := Array(0..n-1,[$1..n]); for i from n by -1 to 1 do u := U() mod i; A[i] := V[B[u]]; B[u] := B[i-1]; od; A := [seq(A[i],i=1..n)]; return PermuteVertices(G,A); else if nops(W) <> n or {op(W)} <> {op(V)} then error "2nd argument is expected to be a permutation of the vertices of the graph"; else return InducedSubgraph(G,W); fi; fi; end proc; ############################################## ##PROCEDURE(doti) WeightMatrix ##ALIAS GraphTheory[WeightMatrix] ##CALLINGSEQ ##- WeightMatrix('G', 'cp') ## ##PARAMETERS ##- 'G' : weighted graph ##- 'cp' : (optional) symbol or equation ## ##DESCRIPTION ##- `WeightMatrix' returns the matrix of edge weights of a weighted graph. ## The optional argument 'cp' is used to control whether the weight matrix of ## the graph or a copy of it should be returned. The argument 'cp' can be either ## the symbol copy or an equation of the form ~copy=true~ or ~copy=false~. If the argument ## is missing the command returns a copy of the weight matrix of the graph ## by default. ## ##EXAMPLES ##> with(GraphTheory): ##> G := Graph({[{1,2},2],[{2,3},1]}); ### G := Graph 64: an undirected weighted graph with 3 vertices and 2 edge(s) ##> WeightMatrix(G); ##<(verification="LinearAlgebra:-Equal") Matrix([[0,2,0],[2,0,1],[0,1,0]], storage=sparse) ### ### [0 2 0] ### [ ] ### [2 0 1] ### [ ] ### [0 1 0] ## ##SEEALSO ##- "GetEdgeWeight" ##- "IsWeighted" ##- "MakeWeighted" ##- "SetEdgeWeight" ## ##XREFMAP ##- "GetEdgeWeight" : Help:GraphTheory[GetEdgeWeight] ##- "IsWeighted" : Help:GraphTheory[IsWeighted] ##- "MakeWeighted" : Help:GraphTheory[MakeWeighted] ##- "SetEdgeWeight" : Help:GraphTheory[SetEdgeWeight] #---------ver. 23, modified by MG #---------ver. 24, modified by MBM WeightMatrix := proc(G::GRAPHLN) local cp; if nargs > 1 then if args[2] = 'copy' then cp := true; elif type(args[2], equation) and lhs(args[2])='copy' and type(rhs(args[2]), boolean) then cp := rhs(args[2]); else error "invalid argument %1", args[2]; fi; else cp := true; fi; if getwt(G)=unweighted then error "1st argument must be a weighted graph."; elif cp then `if`(cp, copy(eweight(G)), eweight(G)); fi; end proc; ############################################## ##PROCEDURE(doti) SetEdgeWeight ##TITLE SetEdgeWeight ##TITLE GetEdgeWeight ##ALIAS GraphTheory[SetEdgeWeight], GraphTheory[GetEdgeWeight] ##CALLINGSEQ ##- SetEdgeWeight('G', 'e') ##- GetEdgeWeight('G', 'e') ## ##PARAMETERS ##- 'G' : weighted graph ##- 'e' : edge/arc ## ##DESCRIPTION ##- `SetEdgeWeight' is used to change the weight of an edge of a weighted graph. ## It returns the old weight of the edge. ## ##- `GetEdgeWeight' is used to get the weight of an edge of a weighted graph. ## ##EXAMPLES ##> with(GraphTheory): ##> G := MakeWeighted( CompleteGraph(4) ); ##> GetEdgeWeight(G,{1,2}); ##< 1 ##> SetEdgeWeight(G,{1,2},3); ##< 1 ##> GetEdgeWeight(G,{1,2}); ##< 3 ##>(notest) for e in Edges(CycleGraph(4)) do SetEdgeWeight(G, e, 2); od; ##>(notest) WeightMatrix(G); ###(verification="LinearAlgebra:-Equal") Matrix([[0, 2, 1, 2], [2, 0, 2, 1], [1, 2, 0, 2], [2, 1, 2, 0]]) ## ##SEEALSO ##- "IsWeighted" ##- "MakeWeighted" ##- "WeightMatrix" ## ##XREFMAP ##- "IsWeighted" : Help:GraphTheory[IsWeighted] ##- "MakeWeighted" : Help:GraphTheory[MakeWeighted] ##- "WeightMatrix" : Help:GraphTheory[WeightMatrix] #---------ver. 23, modified by MG GetEdgeWeight := proc(G::GRAPHLN, e::EDGETYPE) local L, i, j, ie; if getwt(G)=unweighted then error "1st argument must be a weighted graph."; else L := GraphInfo:-LabelToInteger(G); ie := map(x->L[x], e); if not type([op(ie)], [integer, integer]) then error "%1 is not an edge of the graph.", e; else i, j := op(ie); return eweight(G)[i,j]; fi; fi; end proc; ############################################## SetEdgeWeight := proc(G::GRAPHLN, e::EDGETYPE, wt::numeric) local L, i, j, msg, oldwt, ie; if getwt(G)=unweighted then error "1st argument must be a weighted graph."; else L := GraphInfo:-LabelToInteger(G); ie := map(x->L[x], e); if not type([op(ie)], [integer, integer]) then msg := `if`(getdir(G)='directed', "`AddArc`.", "`AddEdge`."); error "%1 is not an edge/arc of the graph. Use "||msg, e; else i, j := op(ie); oldwt := eweight(G)[i,j]; eweight(G)[i,j] := wt; oldwt; fi; fi; end proc; ############################################## ############################################## end module: # GraphTheory #savelib(`GRAPHLN/number`,'GRAPHLN','GraphTheory','`type/GRAPHLN`','`print/GRAPHLN`'); read "VPv26.txt": read "SIv26.txt": read "RGv26.txt": read "SGv26.txt": read "GDv26.txt": read "CMv26.txt"; with(GraphTheory):