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: listint := proc(v) option inline; [$1..v]; 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( 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" ): ################################################################################# ##PACKAGE(help) SpecialGraphs ##DATE August 2006 ## ##DESCRIPTION ## ##- The `SpecialGraphs` package collects routines for generating ## well-known graphs that are named in the literature, such as ## the "PetersenGraph". ## ##- The commands for generating "complete graphs", "paths", and "cycles" ## on _n_ vertices are not in the `SpecialGraphs` package, they are ## part of the main "GraphTheory" package. Follow the hyperlinks in ## the previous sentence to reach the help pages for the respective ## commands. ## ##SECTION List of SpecialGraphs ## ##- The following is a list of SpecialGraphs that can be generated. ## ##-(lead=indent) "AntiPrismGraph" ##-(lead=indent) "ClebschGraph" ##-(lead=indent) "CompleteBinaryTree" ##-(lead=indent) "CompleteKaryTree" ##-(lead=indent) "DesarguesGraph" ##-(lead=indent) "DodecahedronGraph" ##-(lead=indent) "DoubleStarSnark" ##-(lead=indent) "DyckGraph" ##-(lead=indent) "FlowerSnark" ##-(lead=indent) "FosterGraph" ##-(lead=indent) "GeneralizedPetersenGraph" ##-(lead=indent) "GoldbergSnark" ##-(lead=indent) "GridGraph" ##-(lead=indent) "GrinbergGraph" ##-(lead=indent) "GrotzschGraph" ##-(lead=indent) "HeawoodGraph" ##-(lead=indent) "HerschelGraph" ##-(lead=indent) "HyperCubeGraph" ##-(lead=indent) "IcosahedronGraph" ##-(lead=indent) "KneserGraph" ##-(lead=indent) "LCFGraph" ##-(lead=indent) "LeviGraph" ##-(lead=indent) "MobiusKantorGraph" ##-(lead=indent) "OctahedronGraph" ##-(lead=indent) "OddGraph" ##-(lead=indent) "PappusGraph" ##-(lead=indent) "PayleyGraph" ##-(lead=indent) "PetersenGraph" ##-(lead=indent) "PrismGraph" ##-(lead=indent) "ShrikhandeGraph" ##-(lead=indent) "SoccerBallGraph" ##-(lead=indent) "StarGraph" ##-(lead=indent) "SzekeresSnark" ##-(lead=indent) "TetrahedronGraph" ##-(lead=indent) "ThetaGraph" ##-(lead=indent) "TorusGridGraph" ##-(lead=indent) "WebGraph" ##-(lead=indent) "WheelGraph" ## ##SEEALSO ##- "CompleteGraph" ##- "CycleGraph" ##- "GraphTheory" ##- "RandomGraphs" ##- "PathGraph" ## ##XREFMAP ##- "RandomGraphs" : Help:GraphTheory[RandomGraphs] ##- "complete graphs" : Help:GraphTheory[CompleteGraph] ##- "CompleteGraph" : Help:GraphTheory[CompleteGraph] ##- "paths" : Help:GraphTheory[CycleGraph] ##- "PathGraph" : Help:GraphTheory[PathGraph] ##- "cycles" : Help:GraphTheory[PathGraph] ##- "CycleGraph" : Help:GraphTheory[CycleGraph] ##- "AntiPrismGraph" : Help:SpecialGraphs[AntiPrismGraph] ##- "ClebschGraph" : Help:SpecialGraphs[ClebschGraph] ##- "CompleteBinaryTree" : Help:SpecialGraphs[CompleteBinaryTree] ##- "CompleteKaryTree" : Help:SpecialGraphs[CompleteKaryTree] ##- "DesarguesGraph" : Help:SpecialGraphs[DesarguesGraph] ##- "DodecahedronGraph" : Help:SpecialGraphs[DodecahedronGraph] ##- "DoubleStarSnark" : Help:SpecialGraphs[DoubleStarSnark] ##- "DyckGraph" : Help:SpecialGraphs[DyckGraph] ##- "FlowerSnark" : Help:SpecialGraphs[FlowerSnark] ##- "FosterGraph" : Help:SpecialGraphs[FosterGraph] ##- "GeneralizedPetersenGraph" : Help:SpecialGraphs[GeneralizedPetersenGraph] ##- "GoldbergSnark" : Help:SpecialGraphs[GoldbergSnark] ##- "GridGraph" : Help:SpecialGraphs[GridGraph] ##- "GrinbergGraph" : Help:SpecialGraphs[GrinbergGraph] ##- "GrotzschGraph" : Help:SpecialGraphs[GrotzschGraph] ##- "HeawoodGraph" : Help:SpecialGraphs[HeawoodGraph] ##- "HerschelGraph" : Help:SpecialGraphs[HerschelGraph] ##- "HyperCubeGraph" : Help:SpecialGraphs[HyperCubeGraph] ##- "IcosahedronGraph" : Help:SpecialGraphs[IcosahedronGraph] ##- "KneserGraph" : Help:SpecialGraphs[KneserGraph] ##- "LCFGraph" : Help:SpecialGraphs[LCFGraph] ##- "LeviGraph" : Help:SpecialGraphs[LeviGraph] ##- "MobiusKantorGraph" : Help:SpecialGraphs[MobiusKantorGraph] ##- "OctahedronGraph" : Help:SpecialGraphs[OctahedronGraph] ##- "OddGraph" : Help:SpecialGraphs[OddGraph] ##- "PappusGraph" : Help:SpecialGraphs[PappusGraph] ##- "PayleyGraph" : Help:SpecialGraphs[PayleyGraph] ##- "PetersenGraph" : Help:SpecialGraphs[PetersenGraph] ##- "PrismGraph" : Help:SpecialGraphs[PrismGraph] ##- "ShrikhandeGraph" : Help:SpecialGraphs[ShrikhandeGraph] ##- "SoccerBallGraph" : Help:SpecialGraphs[SoccerBallGraph] ##- "StarGraph" : Help:SpecialGraphs[StarGraph] ##- "SzekeresSnark" : Help:SpecialGraphs[SzekeresSnark] ##- "TetrahedronGraph" : Help:SpecialGraphs[TetrahedronGraph] ##- "ThetaGraph" : Help:SpecialGraphs[ThetaGraph] ##- "TorusGridGraph" : Help:SpecialGraphs[TorusGridGraph] ##- "WebGraph" : Help:SpecialGraphs[WebGraph] ##- "WheelGraph" : Help:SpecialGraphs[WheelGraph] SpecialGraphs := module() export AntiPrismGraph, ClebschGraph, CompleteBinaryTree, CompleteKaryTree, DesarguesGraph, DodecahedronGraph, DoubleStarSnark, DyckGraph, FlowerSnark, FosterGraph, GeneralizedPetersenGraph, GoldbergSnark, GridGraph, GrinbergGraph, GrotzschGraph, HeawoodGraph, HerschelGraph, HypercubeGraph, HyperCubeGraph, IcosahedronGraph, KneserGraph, LCFGraph, LeviGraph, MobiusKantorGraph, OctahedronGraph, OddGraph, PappusGraph, PayleyGraph, PetersenGraph, PrismGraph, ShrikhandeGraph, SoccerBallGraph, StarGraph, SzekeresSnark, TetrahedronGraph, ThetaGraph, TorusGridGraph, WebGraph, WheelGraph; local BinTup, GreyCode; option package; ################################ GreyCode := proc(n::nonnegint) local G, i; if n=0 then return [[]] fi; if n=1 then return [[0],[1]] fi; G := GreyCode(n-1); [seq( [op(G[i]),0], i=1..nops(G) ), seq( [op(G[-i]),1], i=1..nops(G) )]; 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; ################################ use GraphTheory in ############################################ ##PROCEDURE(doti) SpecialGraphs[ClebschGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- ClebschGraph() ##- ClebschGraph('V') ## ##PARAMETERS ##- 'V' : set or list of size 16 (optional) ## ##DESCRIPTION ##- `ClebschGraph` will create the clebsch graph graph on 16 vertices. ## The clebsch graph is a non-planar, triangle-free, and 5-regular graph with chromatic number 4. ## As an option, one may input the labels of the vertices as a list of size 16. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> C := ClebschGraph(); ##> IsPlanar(C); ##< false ##> IsRegular(C); ##< true ##> ChromaticNumber(C); ##< 4 ##> DrawGraph(C); #---------ver. 23, modified by MG ClebschGraph := proc() local C, T, V, ph, i,j, n, vp, A; if nargs = 0 then #V := [seq(i,i=1..16)]; V := ["0101", "1000", "1101", "0011", "1011", "0110", "0100", "1111", "0111", "1100", "1010", "1001", "1110", "0010", "0001", "0000"]; elif nargs = 1 then if type(args[1],{set(VERTEXTYPE),list(VERTEXTYPE)}) and nops({op(args[1])})=16 then V := [op(args[1])]; else error "1st argument is expected to be a set or list of size 16 distinct labels."; end if; else error "expecting at most 1 argument" end if; A := Array([{3, 7, 9, 11, 15}, {9, 10, 11, 12, 16}, {1, 8, 10, 12, 14}, {5, 9, 10, 14, 15}, {4, 7, 8, 11, 12}, {7, 9, 12, 13, 14}, {1, 5, 6, 10, 16}, {3, 5, 9, 13, 16}, {1, 2, 4, 6, 8}, {2, 3, 4, 7, 13}, {1, 2, 5, 13, 14}, {2, 3, 5, 6, 15}, {6, 8, 10, 11, 15}, {3, 4, 6, 11, 16}, {1, 4, 12, 13, 16}, {2, 7, 8, 14, 15}]); C:=Graph(undirected, unweighted, V, A); #-------- for Drawing ---------- GraphInfo:-SetVPos(C, VP_FIXED, [[.5, 1.0], [.6939691332, .7669756080], [.9755282580, .6545084970], [.3478309574, .5494427190], [.5940456403, .3705572809], [.2061073739, 0.9549150280e-1], [.8138486503, .3980243918], [.50, .17], [0.2447174185e-1, .6545084970], [.6521690426, .5494427190], [.50, .66], [.7938926260, 0.9549150280e-1], [.4059543596, .3705572809], [.3060308668, .7669756080], [.1861513496, .3980243918], [.5, .5]]); return C; end; ############################################ ##PROCEDURE(doti) SpecialGraphs[CompleteBinaryTree] ##TITLE SpecialGraphsCompleteBinaryTree] ##TITLE SpecialGraphsCompleteKaryTree] ##ALIAS SpecialGraphs[CompleteBinaryTree], SpecialGraphs[CompleteKaryTree] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- CompleteBinaryTree('n') ##- CompleteKaryTree('k','n') ## ##PARAMETERS ##- 'k' : positive integer indicating the degree of the root ##- 'n' : positive integer indicating the depth of the tree ## ##DESCRIPTION ##- `CompleteBinaryTree`('n') constructs the complete binary tree with depth 'n'. ## ##- `CompleteKaryTree`('k','n') constructs the complete k-ary tree with depth 'n' for a given 'k'. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> G := CompleteBinaryTree(2); ##> Edges(G); ##< {{2, 3}, {2, 4}, {5, 6}, {1, 2}, {5, 7}, {1, 5}} ##> DrawGraph(G); ##> H := CompleteKaryTree(3, 2); ##> Edges(H); ##< {{2,3},{2,4},{2,5},{10,13},{1,10},{1,2},{6,8},{10,12},{10,11},{1,6},{6,7},{6,9}} ##> DrawGraph(H); #---------ver. 23, modified by MG CompleteBinaryTree := proc(n::nonnegint) local G, H; if n = 0 then Graph(1) else H := CompleteBinaryTree(n-1); G := GraphInfo:-StandardGraph(DisjointUnion(Graph(1), H, H)); AddEdge(G, {{1,2}, {1,2^n+1}}); G end if; end; ############################################## #---------ver. 23, modified by MG CompleteKaryTree := proc(K::posint, n::nonnegint) local G, H, a, i; if n = 0 then Graph(1) else H := CompleteKaryTree(K, n-1); G := GraphInfo:-StandardGraph(DisjointUnion(Graph(1), H$K)); if K=1 then a := 0; else a := (K^n-1)/(K-1); fi; G := AddEdge(G,{seq({1, 2+i*a},i=0..K-1)}); G end if; end; ############################################# #---------ver. 23, modified by MG DoubleStarSnark := proc(V::list(VERTEXTYPE)) local G, E, vp, r, s, rotate, i, j, x; if nargs <> 0 and nops(convert(V, set))<>30 then error "1st argument is expected to be a list of 30 vertices."; fi; E := {seq({3*i+2,3*i+17}, i=0..4), seq({3*i+1, 3*irem(i+1,5)+3}, i=0..4), seq({15+3*i+1, 15+3*irem(i+2,5)+3}, i=0..4) }; G := Graph([$1..30], Trail($1..15,1), Trail(seq(seq(15+3*irem(2*i,5)+j,j=1..3), i=0..4), 16), E); if nargs <> 0 then G := RelabelVertices(G, V); fi; r, s := .25, .21; vp := Array(1..30); vp[1],vp[2],vp[3] := [-s,1],[0,1],[s,1]; vp[16],vp[17],vp[18] := [-.6*s,.57],[0,.57],[.6*s,.57]; rotate := proc(P) [P[1]*cos(2*Pi/5)+P[2]*sin(2*Pi/5),-P[1]*sin(2*Pi/5)+P[2]*cos(2*Pi/5)]; end; for i to 4 do for j to 3 do vp[3*i+j] := rotate(vp[3*(i-1)+j]); vp[15+3*i+j] := rotate(vp[15+3*(i-1)+j]); od od; GraphInfo:-SetVPos(G, VP_FIXED, [seq(evalf(vp[x]),x=1..30)]); G; end proc; ############################################# #---------ver. 23, modified by MG GoldbergSnark := proc(n::posint) local E, G, vp, i, j, r, s, t, u, rotate; if irem(n,2)=0 or n<3 then error "1st argument must be an odd integer bigger than or equal to 3" fi; E := {seq({i,n+i}, i=1..n), seq({2*n+i, 4*n+i}, i=1..2*n), seq({4*n+2*i-1, 6*n+2*i}, i=1..n), seq({4*n+2*i, 6*n+2*i-1}, i=1..n), seq({n+iquo(i+1,2), 4*n+i}, i=1..2*n)}; G := Graph([$1..8*n], Trail($1..n, 1), Trail($2*n+1..4*n, 2*n+1), Trail($6*n+1..8*n,6*n+1), E); r, s, t := `if`(n<11,n/15,1-3/n), 1-.65/n, 1/n; vp := Array(1..8*n); vp[1] := [0,r]; vp[n+1] := [0, s]; vp[2*n+1], vp[2*n+2] := [-t,1], [t,1]; vp[4*n+1], vp[4*n+2] := [-t,s], [t,s]; vp[6*n+1], vp[6*n+2] := [t,2*s-1], [-t,2*s-1]; rotate := proc(P,n) evalf([P[1]*cos(2*Pi/n)+P[2]*sin(2*Pi/n),-P[1]*sin(2*Pi/n)+P[2]*cos(2*Pi/n)]); end; for j to n-1 do vp[j+1] := rotate(vp[j],n); vp[n+j+1] := rotate(vp[n+j],n); vp[2*n+2*j+1], vp[2*n+2*j+2] := rotate(vp[2*n+2*j-1],n), rotate(vp[2*n+2*j],n); vp[4*n+2*j+1], vp[4*n+2*j+2] := rotate(vp[4*n+2*j-1],n), rotate(vp[4*n+2*j],n); vp[6*n+2*j+1], vp[6*n+2*j+2] := rotate(vp[6*n+2*j-1],n), rotate(vp[6*n+2*j],n); od; GraphInfo:-SetVPos(G, VP_FIXED, [seq(evalf(vp[i]), i=1..8*n)]); G; end proc; ############################################# ##PROCEDURE(doti) SpecialGraphs[SzekeresSnark] ##TITLE SpecialGraphs[SzekeresSnark] ##TITLE SpecialGraphs[DoubleStarSnark] ##ALIAS SpecialGraphs[SzekeresSnark], SpecialGraphs[DoubleStarSnark] ##AUTHOR Mohammad Ghebleh ## ##CALLINGSEQ ##- SzekeresSnark() ##- DoubleStarSnark() ## ##DESCRIPTION ##- A snark is a nontrivial cubic graph with chromatic index 4. ## ##- `SzekeresSnark` will create a snark with 50 vertices. ## ##- `DoubleStarSnark` will create a snark with 30 vertices. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> G := SzekeresSnark(); ##> DrawGraph(G); ##> H := DoubleStarSnark(); ##> DrawGraph(H); SzekeresSnark := proc() local G, E, vp, rotate, centr, i; E := `union`(seq(map(S->map(x->x+10*i, S), {{2,3},{9,10},{2,7},{5,10}}),i=0..4)); E := E union {seq({10*i+10,10*irem(i+1,5)+2}, i=0..4), seq({10*i+4,10*irem(i+2,5)+8}, i=0..4), seq({10*i+1,10*i+6}, i=0..4)}; G := Graph([$1..50], seq(Trail(op(map(x->x+10*i, [1, $3..9, 1]))), i=0..4), E); rotate := proc(P,i) evalf([P[1]*cos(2*i*Pi/5)+P[2]*sin(2*i*Pi/5),-P[1]*sin(2*i*Pi/5)+P[2]*cos(2*i*Pi/5)]); end; centr := [0,.75]; vp := map(x->centr-.25*x, GraphInfo:-GetVPos(CycleGraph(9), VP_FIXED)); vp := [centr,op(vp[6..9]), op(vp[1..5])]; GraphInfo:-SetVPos(G, VP_FIXED, [seq(op(map(x->rotate(x,i), vp)), i=0..4)]); G; end proc; ############################################## HeawoodGraph := proc() local G, E; G := CycleGraph(14); E := {seq({2*i+1, irem(2*i+5, 14)+1}, i=0..6)}; AddEdge(G, E); G; end proc; ############################################# ##PROCEDURE(doti) SpecialGraphs[GeneralizedPetersenGraph] ##AUTHOR Mohammad Ghebleh ## ##CALLINGSEQ ##- GeneralizedPetersenGraph('n', 'k') ## ##PARAMETERS ##- 'n' : positive integer >=3 ##- 'k' : positive integer ## ##DESCRIPTION ##- `GeneralizedPetersenGraph`('n','k') returns the generalized petersen graph with the ## given parameters. The graph consists of two cycles of length 'n' with a perfect ## matching between their vertices. The 'i'\'th vertex of the first cycle is connected ## to the ~ki~\'th vertex on the second cycle. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> P := GeneralizedPetersenGraph(5, 2); ##> DrawGraph(P); ##> P := GeneralizedPetersenGraph(6, 2); ##> DrawGraph(P); #---------ver. 23, modified by MG GeneralizedPetersenGraph := proc(n::posint, k::posint) local G, E, vp, i; if n < 3 then error "1st argument must be greater than 2." elif k >= n/2 then error "2nd argument must be less than half the 1st argument." fi; G := Graph([$1..2*n], Trail($1..n,1), {seq({n+i, n+irem(i+k-1,n)+1}, i=1..n), seq({i,n+i}, i=1..n)}); vp := GraphInfo:-GetVPos(CycleGraph(n), VP_FIXED); vp := [op(vp), op(map(x->.6*x, vp))]; GraphInfo:-SetVPos(G, VP_FIXED, vp); G; end proc; ############################################## ##PROCEDURE(doti) SpecialGraphs[DesarguesGraph] ##TITLE SpecialGraphs[DesarguesGraph] ##TITLE SpecialGraphs[DyckGraph] ##TITLE SpecialGraphs[FosterGraph] ##TITLE SpecialGraphs[GrinbergGraph] ##TITLE SpecialGraphs[GrotzschGraph] ##TITLE SpecialGraphs[HeawoodGraph] ##TITLE SpecialGraphs[HerschelGraph] ##TITLE SpecialGraphs[LeviGraph] ##TITLE SpecialGraphs[MobiusKantorGraph] ##TITLE SpecialGraphs[PappusGraph] ##ALIAS SpecialGraphs[DesarguesGraph], SpecialGraphs[DyckGraph], SpecialGraphs[FosterGraph], SpecialGraphs[GrinbergGraph], SpecialGraphs[GrotzschGraph], SpecialGraphs[HeawoodGraph], SpecialGraphs[HerschelGraph], SpecialGraphs[LeviGraph], SpecialGraphs[MobiusKantorGraph], SpecialGraphs[PappusGraph] ##AUTHOR Mohammad Ghebleh ## ##CALLINGSEQ ##- DesarguesGraph() ##- DyckGraph() ##- FosterGraph() ##- GrinbergGraph() ##- GrotzschGraph() ##- HeawoodGraph() ##- HerschelGraph() ##- LeviGraph() ##- MobiusKantorGraph() ##- PappusGraph() ## ##DESCRIPTION ##- Each of these commands returns the graph it is named after. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> G := GrinbergGraph(); ##> IsPlanar(G); ##< true ##> DegreeSequence(G); ##< [3$46] ##> DrawGraph(G); DesarguesGraph := proc() #alternate drawing: GeneralizedPetersenGraph(10, 3); LCFGraph([-9,5,-5,9],5); end proc; ############################################## MobiusKantorGraph := proc() #alternate drawing: GeneralizedPetersenGraph(8, 3); LCFGraph([5,-5], 8); end proc; ############################################## ##PROCEDURE(doti) SpecialGraphs[PrismGraph] ##TITLE SpecialGraphs[PrismGraph] ##TITLE SpecialGraphs[AntiPrismGraph] ##ALIAS SpecialGraphs[PrismGraph], SpecialGraphs[AntiPrismGraph] ## ##AUTHOR Michael Monagan, Mohammad Ghebleh ## ##CALLINGSEQ ##- PrismGraph('n') ##- AntiPrismGraph('n') ## ##PARAMETERS ##- 'n' : positive integer >=3 ## ##DESCRIPTION ##- `PrismGraph`('n') returns the prism graph with parameter 'n'. Namely it returns the ## Cartesian product of `CycleGraph`('n') and `PathGraph`(2). ## ##- `AntiPrismGraph`('n') returns the antiprism graph with parameter 'n'. ## It is constructed as two cycles on 'n' vertices, with each vertex ## on the inner cycle connected to two adjacent vertices on the ## outer cycle. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> G := PrismGraph(5); ##> DrawGraph(G); ##> H := AntiPrismGraph(5); ##> DrawGraph(H); #---------ver. 23, modified by MG PrismGraph := proc(n::posint) if n < 3 then error "1st argument must be greater than 2." fi; GeneralizedPetersenGraph(n, 1); end proc; ############################################## AntiPrismGraph := proc(n) local i,G,vp,rp,RotateAndShrink; if n < 3 then error "1st argument must be greater than 2." fi; RotateAndShrink := proc(v,n) local t, M, u; t := evalf(Pi/n); M := Matrix( (1-sqrt(1./n))*[[cos(t),sin(t)],[-sin(t),cos(t)]]); u := M.Vector(v); [u[1],u[2]]; end; G := Graph([seq(i,i=0..2*n-1)], Trail(seq(2*i mod 2*n,i=0..n)), # the outer cycle Trail(seq(2*i+1 mod 2*n, i=0..n)), # the inner cycle Trail(seq(i mod 2*n,i=0..2*n))); # zigzag connections vp := GraphInfo:-GetVPos(CycleGraph(n), VP_FIXED); rp := map(RotateAndShrink,vp,n); vp := [seq( op([vp[i],rp[i]]), i=1..n )]; GraphInfo:-SetVPos(G, VP_FIXED, vp); G; end: ############################################## ##PROCEDURE(doti) SpecialGraphs[StarGraph] ##AUTHOR Mohammad Ghebleh ## ##CALLINGSEQ ##- StarGraph('n') ## ##PARAMETERS ##- 'n' : positive integer ## ##DESCRIPTION ##- `StarGraph`('n') returns the star graph with 'n' leaves. Namely it returns the ## complete bipartite graph `CompleteGraph`(1,'n'). ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> G := StarGraph(5); ##> IsTree(G); ##< true ##> DrawGraph(G); #---------ver. 23, modified by MG StarGraph := proc(n::posint) RelabelVertices( CompleteGraph(1, n), [$0..n]); end proc; ############################################## ##PROCEDURE(doti) SpecialGraphs[WebGraph] ##AUTHOR Mohammad Ghebleh ## ##CALLINGSEQ ##- WebGraph('a', 'b') ## ##PARAMETERS ## 'a' : positive integer >=3 ##- 'b' : positive integer ## ##DESCRIPTION ##- `WebGraph`('a','b') returns the web graph with parameters 'a' and 'b'. Namely it returns the ## Cartesian product of `CycleGraph`('a') and `PathGraph`('b'). ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> W := WebGraph(7, 3); ##> DrawGraph(W); #---------ver. 23, modified by MG WebGraph := proc(n::posint, r::posint) local i, j, G, vp; if n < 3 then error "1st argument must be greater than 2." fi; G := Graph(seq(Trail($(j*n+1)..(j*n+n),j*n+1), j=0..r-1), seq(Trail(seq(i+j*n,j=0..r-1)), i=1..n)); vp := GraphInfo:-GetVPos(CycleGraph(n), VP_FIXED); GraphInfo:-SetVPos(G, VP_FIXED, [seq(op(map(x->(1-j*.8/r)*x, vp)), j=0..r-1)]); G; end proc; ############################################## ##PROCEDURE(doti) SpecialGraphs[LCFGraph] ##AUTHOR Mohammad Ghebleh ## ##CALLINGSEQ ##- LCFGraph('jumps', 'exp') ## ##PARAMETERS ##- 'jumps' : list of integers ##- 'exp' : positive integer ## ##DESCRIPTION ##- A graph represented by the LCF notation 'jumps'^'exp'. LCF notation is a convenient notation for the representation of ## cubic Hamiltonian graphs. ## For more information on the format see http://mathworld.wolfram.com/LCFNotation.html ## ##EXAMPLES ##> with(GraphTheory): ## with(SpecialGraphs): ##> G := LCFGraph([3,-3], 4): ##> DrawGraph(G); ##> H := HypercubeGraph(3); ##> DrawGraph(H); #---------ver. 23, modified by MG LCFGraph := proc(jump::list(integer), exponent::posint) local G, e, nJumps, n, E, i, j; e := `if`(nargs=2, exponent, 1); nJumps := nops(jump); n := nJumps*e; E := NULL; for i from 0 to e-1 do for j to nJumps do E := E, {i*nJumps+j, irem(n+i*nJumps+j+jump[j]-1, n)+1}; od; od; G := Graph([$1..n], Trail($1..n,1), {E}); GraphInfo:-SetVPos(G, VP_FIXED, GraphInfo:-GetVPos(CycleGraph(n), VP_FIXED)); G; end proc; ############################################## PappusGraph := proc() LCFGraph([5,7,-7,7,-7,-5], 3); end proc; ############################################## LeviGraph := proc() LCFGraph([-13,-9,7,-7,9,13], 5); end proc; ############################################## DyckGraph := proc() LCFGraph([-13,5,-5,13], 8); end proc; ############################################## FosterGraph := proc() LCFGraph([17,-9,37,-37,9,-17], 15); end proc; ############################################## HerschelGraph := proc() local G; G := Graph([$1..11], Trail(1,2,3,4,1,5,6,2,7,8,3), Trail(5,10,4,9,8), Trail(6,11,9), Trail(7,11,10)); GraphInfo:-SetVPos(G, VP_FIXED, [[-1,0],[0,.75],[1,0],[0,-.75],[-.5,0],[-.25,.25],[.25,.25],[.5,0],[.25,-.25],[-.25,-.25],[0,0]]); G; end proc; ############################################## GrinbergGraph := proc() local G,V; G := Graph([$1..46], {{31, 32}, {1, 3}, {39, 40}, {42, 43}, {35, 44}, {9, 10}, {2, 7}, {1, 2}, {1, 4}, {2, 5}, {3, 6}, {7, 30}, {8, 29}, {15, 39}, {7, 8}, {9, 14}, {10, 13}, {11, 12}, {11, 13}, {3, 10}, {4, 8}, {4, 9}, {5, 6}, {5, 21}, {6, 22}, {19, 22}, {20, 23}, {20, 25}, {21, 24}, {22, 26}, {23, 24}, {16, 46}, {17, 18}, {17, 40}, {18, 45}, {19, 21}, {11, 14}, {12, 15}, {33, 43}, {35, 36}, {35, 43}, {27, 30}, {28, 31}, {28, 33}, {29, 32}, {30, 34}, {40, 41}, {41, 42}, {41, 45}, {34, 44}, {13, 16}, {14, 18}, {15, 16}, {23, 36}, {24, 44}, {25, 26}, {25, 37}, {26, 46}, {27, 28}, {27, 29}, {36, 37}, {37, 38}, {38, 39}, {38, 46}, {31, 42}, {32, 45}, {33, 34}, {19, 20}, {12, 17}}); if nargs>0 then V := args[1]; if type(V,list(VERTEXTYPE)) and nops({op(V)})=46 then G := RelabelVertices(G,V); else error "list of 46 vertices expected: %1", V; fi; fi; GraphInfo:-SetVPos(G, VP_FIXED, [[0., 0.], [0., 1.], [.8660254040, -.5000000000], [-.8660254040, -.5000000000], [.9659258263, 1.258819045], [1.573132185, .2071067814], [-.9659258263, 1.258819045], [-1.573132185, .2071067814], [-.6072063589, -1.465925827], [.6072063589, -1.465925827], [0., -2.931851653], [0., -3.931851653], [.8660254040, -2.431851653], [-.8660254040, -2.431851653], [.9659258263, -4.190670698], [1.573132185, -3.138958435], [-.9659258263, -4.190670698], [-1.573132185, -3.138958435], [2.539058012, 1.465925827], [3.405083416, 1.965925827], [1.673032608, 1.965925827], [2.539058012, .4659258266], [3.146264371, 2.931851653], [1.931851654, 2.931851653], [4.112190197, 1.258819045], [3.504983840, .2071067813], [-2.539058012, 1.465925827], [-3.405083416, 1.965925827], [-2.539058012, .4659258266], [-1.673032608, 1.965925827], [-4.112190197, 1.258819045], [-3.504983840, .2071067813], [-3.146264371, 2.931851653], [-1.931851654, 2.931851653], [0., 5.7], [3.663889374, 4.366453326], [5.613404192, .9897946140], [4.936344801, -2.850000001], [1.949514814, -5.356247940], [-1.949514816, -5.356247939], [-4.936344799, -2.850000005], [-5.613404190, .9897946249], [-3.663889369, 4.366453331], [0., 4.2], [-3.637306697, -2.100000000], [3.637306697, -2.100000000]]); G; end proc; ############################################## GrotzschGraph := proc() Mycielski( CycleGraph(5) ); end proc; ############################################## #---------ver. 23, modified by MG DodecahedronGraph := proc() local ph, i, j, V, T, D, n, vp, A; if nargs = 0 then V := [seq(i,i=1..20)] elif nargs = 1 then if type(args[1],list(VERTEXTYPE)) and nops(args[1])=20 then V := [op(args[1])]; else error "1st argument is expected to be a list of 20 vertices"; end if; else error "expecting at most 1 argument" end if; A := Array([{2,5,6}, {1,3,7}, {2,4,8}, {3,5,9}, {1,4,10}, {1,11,15}, {2,11,12}, {3,12,13}, {4,13,14}, {5,14,15}, {6,7,16}, {7,8,17}, {8,9,18}, {9,10,19}, {6,10,20}, {11,17,20}, {12,16,18}, {13,17,19}, {14,18,20}, {15,16,19} ]); D := Graph(undirected, unweighted, V, A); #-------- for Drawing ---------- GraphInfo:-SetVPos(D, VP_FIXED, [[.4, .8], [.7804226064, .5236067976], [.6351141008, 0.7639320224e-1], [.1648858991, 0.7639320224e-1], [0.1957739348e-1, .5236067976], [.4, .7], [.6853169548, .4927050982], [.5763355756, .1572949017], [.2236644243, .1572949017], [.1146830451, .4927050982], [.5175570504, .5618033988], [.5902113032, .3381966011], [.4, .2], [.2097886967, .3381966011], [.2824429496, .5618033988], [.4587785252, .4809016994], [.4951056516, .3690983006], [.4, .3], [.3048943484, .3690983006], [.3412214748, .4809016994]]); return D; end; ############################################## ##PROCEDURE(doti) SpecialGraphs[FlowerSnark] ##TITLE SpecialGraphs[FlowerSnark] ##TITLE SpecialGraphs[GoldbergSnark] ##ALIAS SpecialGraphs[FlowerSnark], SpecialGraphs[GoldbergSnark] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- FlowerSnark('K') ##- GoldbergSnark('K') ## ##PARAMETERS ##- 'K' : odd positive integer ## ##DESCRIPTION ##- A snark is a nontrivial cubic graph with chromatic index 4. ##- `FlowerSnark` will create the flower snark graphs also known as Isaac's snarks. ## A flower snark with parameter 'K', is a 3-regular graph on ~4*K~ vertices. ## ## `GoldbergSnark`('K') will create the Goldberg snark with parameter 'K'. A Goldberg snark with parameter 'K', ## is a 3-regular graph on ~8*K~ vertices. ## ##EXAMPLES ##> with(GraphTheory): ## with(SpecialGraphs): ##> F := FlowerSnark(5): ##> IsRegular(F); ##> DrawGraph(F); ##> ChromaticIndex(F); ##< 4 ##> CircularChromaticNumber(F); ##< 5/2 ##> H := GoldbergSnark(5); ##> DrawGraph(H); #---------ver. 23, modified by MG FlowerSnark := proc(n::posint) local E, G, vp, i, j; if irem(n,2)=0 or n<3 then error "1st argument must be an odd integer bigger than or equal to 3" fi; E := {seq({i,n+3*i-2}, i=1..n), seq({n+irem(3*n+3*i-4, 3*n)+1, n+irem(3*n+3*i+1, 3*n)+1}, i=1..n)}; G := Graph([$1..4*n], Trail($1..n, 1), Trail($n+1..4*n, n+1), E); vp := Array(1..4*n, [op( 1/3.0 * GraphInfo:-GetVPos(CycleGraph(n), VP_FIXED) ), op(GraphInfo:-GetVPos(CycleGraph(3*n), VP_FIXED))]); if n > 5 then for j to n do vp[n+3*j-2] := .5*vp[j]+.5*vp[n+3*j-2]; od; fi; if n = 3 then for j to n do vp[j] := .3*vp[j]; od; fi; GraphInfo:-SetVPos(G, VP_FIXED, [seq(vp[j], j=1..4*n)]); G; end: ############################################## ##PROCEDURE(doti) SpecialGraphs[GridGraph] ##TITLE SpecialGraphs[GridGraph] ##TITLE SpecialGraphs[TorusGridGraph] ##ALIAS SpecialGraphs[GridGraph], SpecialGraphs[TorusGridGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- GridGraph('m','n') ##- TorusGridGraph('m','n') ## ##PARAMETERS ## 'm', 'n' : positive integers ## ##DESCRIPTION ##- `GridGraph`('m','n') will create the 'm' by 'n' grid graph on ~m*n~ vertices. ## ##- `TorusGridGraph`('m','n') will create the 'm' by 'n' torus grid graph on ~m*n~ vertices. ## ##EXAMPLES ##> with(GraphTheory): ## with(SpecialGraphs): ##> G := GridGraph(5, 3); ##> IsBipartite(G); ##< true ##> DrawGraph(G); ##> H := TorusGridGraph(5, 3): ##> IsBipartite(H); ##< false ##> DrawGraph(H); #---------ver. 23, modified by MG GridGraph := proc(n::posint, m::posint) local N, V, A, imm, G, vp, i, j, M, aux1, aux2, aux; if m=1 then return SpecialGraphs:-PathGraph(n); end if; if n=1 then return SpecialGraphs:-PathGraph(m); end if; N := m*n; #V := [seq(i,i=1..N)]; V := [seq(seq(sprintf("%0d,%0d", aux1, aux2), aux2=1..m), aux1=1..n)]; A := Array(1..N); # four corners A[1], A[m], A[N-m+1], A[N] := {2,m+1}, {m-1,2*m}, {N-m+2,N-2*m+1}, {N-1, N-m}; # top and bottom row for i from 2 to m-1 do A[i] := {i-1, i+1, i+m}; A[N-i+1] := {N-i, N-i+2, N-i+1-m}; end do; #everything else for i from m+1 to N-m do imm := i mod m; if imm = 1 then A[i] := {i-m, i+1, i+m} elif imm = 0 then A[i] := {i-m, i-1, i+m} else A[i] := {i-m, i-1,i+1, i+m}; end if; end do; G := Graph(undirected, unweighted, V, A); vp := Array(1..N); M := 1.0/max(n,m); for i to m do for j to n do vp[(j-1)*m+i] := [M*j,M*i]; od od; GraphInfo:-SetVPos(G, VP_FIXED, [seq(vp[aux], aux=1..N)]); G end; ############################################## ##PROCEDURE(doti) SpecialGraphs[HypercubeGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- HypercubeGraph('n') ## ##PARAMETERS ##- 'n' : positive integer ## ##DESCRIPTION ##- `HypercubeGraph`('n') creates the hypercube graph of dimension 'n' on ~2^n~ vertices. ## The vertex labels are strings of binary vectors of length 'n', and two vertices are ## joined by an edge iff they differ in exactly one coordinate. ## Note, the hypercube graph for 'n'=2 is a square and for 'n'=3 it is a cube. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> H := HypercubeGraph(3); ##> Vertices(H); ##< ["000", "001", "010", "011", "100", "101", "110", "111"] ##> Neighbors( H, "010" ); ##< ["000", "011", "110"] ##> DrawGraph(H); ##- (nolead) Hypercube graphs have Hamiltonian cycles. ##> IsHamiltonian(H,'C'); ##< true ##> C; ##< ["000", "100", "110", "010", "011", "111", "101", "001", "000"] ##> HighlightTrail(H,C,red); ##> DrawGraph(H); ## #---------ver. 23, modified by MG #---------ver. 26, modified by MBM, added hamiltonian cycles HypercubeGraph := proc(n::nonnegint) local Q, V, L, Gra, v, w, i, Nbr, A, k, j, fmt, Vt, C; V := BinTup(n); L := table([seq(V[k]=k,k=1..2^n)]); A := Array(1..2^n); for j to 2^n do v := V[j]; A[j] := {seq( L[subsop(i=v[i]+1 mod 2,v)], i=1..n )}; end do; fmt := cat(seq("%d", i=1..n)); Vt := [seq( sprintf(fmt, op(V[i])) , i=1..2^n)]; Q := Graph( undirected, unweighted, Vt, A ); if n=1 then GraphInfo:-SetVPos(Q, VP_FIXED, [[0,0],[1,0]]); elif n=2 then GraphInfo:-SetVPos(Q, VP_FIXED, [[0,0],[1,0],[0,1],[1,1]]); elif n=3 then GraphInfo:-SetVPos(Q, VP_FIXED, [[0,0],[1,0],[0,1],[1,1],[.3,.3],[.7,.3],[.3,.7],[.7,.7]]); fi; # Compute a grey code for the vertices. This will be a Hamiltonian cycle C C := GreyCode(n); C := [seq( L[C[i]], i=1..nops(C) )]; SetGraphAttribute(Q,"hamiltonian_cycles"=[C]); Q; end; ############################################## #---------ver. 23, modified by MG IcosahedronGraph := proc() local II, T, V, vp, n, i, A; if nargs = 0 then V := [seq(i,i=1..12)] elif nargs = 1 then if type(args[1], list(VERTEXTYPE)) and nops(args[1])=12 then V := [op(args[1])]; else error "1st argument is expected to be a list of size 12"; end if; else error "expecting at most 1 argument" end if; A := Array([{2,3,4,5,9},{1,3,5,6,7},{1,2,7,8,9},{1,5,9,10,11}, {1,2,4,6,10},{2,5,7,10,12},{2,3,6,8,12},{3,7,9,11,12}, {1,3,4,8,11},{4,5,6,11,12},{4,8,9,10,12},{6,7,8,10,11}]); II:= Graph(undirected, unweighted, V, A); #-------- for Drawing ---------- GraphInfo:-SetVPos(II, VP_FIXED, [[.5, 1.0], [.9330127020, .2500000000], [0.6698729800e-1, .2500000000], [.50, .65], [.6299038106, .5750000000], [.6299038106, .4250000000], [.50, .35], [.3700961894, .4250000000], [.3700961894, .5750000000], [.5433012702, .5250000000], [.4566987298, .5250000000], [.50, .45]]); return II; end; ############################################## ##PROCEDURE(doti) SpecialGraphs[KneserGraph] ##TITLE SpecialGraphs[KneserGraph] ##TITLE SpecialGraphs[OddGraph] ##ALIAS SpecialGraphs[KneserGraph], SpecialGraphs[OddGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- KneserGraph('n','k') ##- OddGraph('d') ## ##PARAMETERS ##- 'n', 'k', 'd' : positive integers ## ##DESCRIPTION ##- `KneserGraph`('n','k') will return the Kneser graph with parameters 'n', 'k'. ##- `OddGraph`('d') returns a Kneser graph with parameters ~n=2*d+1~, ~k=d~. ## ##EXAMPLES ##> with(GraphTheory): ## with(SpecialGraphs): ##> P := KneserGraph(5, 2); ##> NumberOfVertices(P); ##< 10 ##> NumberOfEdges(P); ##< 15 ##> ChromaticNumber(P); ##< 3 ##> DrawGraph(P); #---------ver. 23, modified by MG #---------ver. 24, modified by MBM and MG KneserGraph := proc(n::posint, k::nonnegint) local r, V, R, N, i, X, T, A, G; if k > n then return Graph(0); end if; if n=5 and k=2 then G := Graph([$1..10], Trail(1,2,3,4,5,6,7,8,9,1), {{10,1},{10,4},{10,7},{2,6},{3,8},{5,9}}); # The Kneser graph on 5,2 is the Petesen graph. # So this drawing is a different way to draw the Petersen graph. GraphInfo:-SetVPos(G,VP_FIXED, [[0., 1.], [.64278761, .76604444], [.98480775, .17364818], [.86602540, -.50000000], [.34202014, -.93969262], [-.34202014, -.93969262], [-.86602540, -.50000000], [-.98480775, .17364818], [-.64278761, .76604444], [0, 0]]); G := RelabelVertices(G,["{1,5}","{3,4}","{2,5}","{1,4}","{3,5}", "{1,2}","{4,5}","{1,3}","{2,4}","{2,3}"]); return G; fi; V := map(x->{op(x)}, combinat[choose](n,k)); N := nops(V); T := table(): for i to N do T[V[i]] := i; end do; R := convert(combinat[choose]({$1..n-k}, k), list); A := Array(1..N); for i to N do X := {$1..n} minus V[i]; A[i] := {seq( T[map(y->X[y], r)] , r=R)}; end do; V := map(x->StringTools:-Remove(StringTools:-IsSpace, convert(x, string)), V); G := Graph(undirected, unweighted, V, A); G; end: OddGraph := proc(n::posint) KneserGraph(2*n+1,n) end: ############################################# OctahedronGraph := proc(V::list(VERTEXTYPE)) local O, T, v1, vp, n, v2, i; if nargs = 0 then O:=CompleteGraph(2,2,2) elif nargs = 1 then O:=RelabelVertices(CompleteGraph(2,2,2), V) else error "expecting at most 1 argument" end if; #-------- for Drawing ---------- GraphInfo:-SetVPos(O, VP_FIXED, [[.5, 1.0], [.50, .35], [.6698729800e-1, .2500000000], [.6299038106, .5750000000], [.3700961894, .5750000000], [.9330127020, .2500000000]]); return O; end; ############################################## ##PROCEDURE(doti) SpecialGraphs[PayleyGraph] ##AUTHOR Michael Monagan ## ##CALLINGSEQ ##- PayleyGraph('p') ##- PayleyGraph('p','k') ##- PayleyGraph('p','k','m') ## ##PARAMETERS ##- 'p' : prime integer ##- 'k' : positive integer ##- 'm' : irreducible univariate polynomial of degree 'k' over ~GF(p)~ ## ##DESCRIPTION ##- If the input is `PayleyGraph`('p') then the output is an undirected ## unweighted simple graph 'G' on 'p' vertices labelled ~0,1,...,p-1~ where the ## edge ~{i,j}~, with ~i with(GraphTheory): ##> with(SpecialGraphs): ##> P := PayleyGraph(5); ### P := Graph 1: an undirected unweighted graph with 5 vertices and 5 edge(s) ##> E := Edges(P); ##< {{2, 3}, {0, 1}, {0, 4}, {1, 2}, {3, 4}} ##> P := PayleyGraph(2, 2); ### P := Graph 2: an undirected unweighted graph with 4 vertices and 6 edge(s) ##> E := Edges(P); ##< {{2, 3}, {1, 3}, {0, 1}, {1, 2}, {0, 2}, {0, 3}} ##> P := PayleyGraph(3, 2, y^2+1); ### P := Graph 3: an undirected unweighted graph with 9 vertices and 18 edge(s) ##> E := Edges(P); #---------ver. 23, modified by MG PayleyGraph := proc(p::prime,k::posint,m::polynom) local i,j,QR,q,GFq,z,V,A; if nargs=1 or nargs=2 and k=1 then QR := { seq( i^2 mod p, i=1..p-1 ) } ; V := [seq( i, i=0..p-1 )]; A := Matrix(p,p,shape=symmetric); for i from 1 to p do for j from 1 to p do if member(j-i,QR) then A[i,j] := 1 end if; end do; end do; Graph(V,A); else GFq := GF(args); # Let GF do the type checking on m q := p^k; QR := { seq( GFq[`^`]( GFq['input'](i), 2 ), i=0..q-1 ) }; V := [seq( i, i=0..q-1 )]; A := Matrix(q,q,shape=symmetric); for i from 1 to q do for j from i+1 to q do z := GFq[`-`](GFq[input](i-1),GFq[input](j-1)); if member(z,QR) then A[i,j] := 1 end if; end do; end do; Graph(V,A); end if; end: ############################################## ##PROCEDURE(doti) SpecialGraphs[PetersenGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- PetersenGraph() ##- PetersenGraph('V') ## ##PARAMETERS ##- 'V' : (optional) list of vertex labels ## ##DESCRIPTION ##- `PetersenGraph` will create the petersen graph on 10 vertices. ## As an option, one may input the labels of the vertices as a set or list of size 10. ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> P := PetersenGraph(); ##> DegreeSequence(P); ##< [3$10] ##> DrawGraph(P); ##SEEALSO ##- "GeneralizedPetersenGraph" ##XREFMAP ##- "GeneralizedPetersenGraph" : Help:SpecialGraphs[GeneralizedPetersenGraph] #---------ver. 23, modified by MG PetersenGraph := proc(S::list(VERTEXTYPE)) local V, i, Cyc, Pete, n, vp, T; #Cyc := CycleGraph(5); #Pete := RelabelVertices(DisjointUnion(Cyc,Cyc), [$1..10]); #Pete := AddEdge( Pete, {seq({ i+1 , 6 + (3*i mod 5) },i=0..4)} ); Pete := Graph([$1..10], {{2, 3}, {1, 5}, {1, 6}, {3, 4}, {3, 7}, {2, 9}, {4, 5}, {5, 8}, {4, 10}, {6, 7}, {6, 10}, {8, 9}, {9, 10}, {1, 2}, {7, 8}}); if nargs = 1 then Pete := RelabelVertices(Pete, S); end if; if nargs > 1 then error "expecting at most 1 argument" end if; #-------- for Drawing ---------- GraphInfo:-SetVPos(Pete, VP_FIXED, [[0., 1.], [0.9510565163, 0.3090169944], [0.5877852522, -0.8090169944], [-0.5877852527, -0.8090169941], [-0.9510565163, 0.3090169944], [0., 0.6], [0.3526711513, -0.4854101966], [-0.5706339098, 0.1854101966], [0.5706339098, 0.1854101966], [-0.3526711516, -0.4854101965]]); return Pete; end; ############################################## ##PROCEDURE(doti) SpecialGraphs[ShrikhandeGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- ShrikhandeGraph() ##- ShrikhandeGraph('V') ## ##PARAMETERS ##- 'V' : set or list of size 16 (optional) ## ##DESCRIPTION ##- `ShrikhandeGraph` will create the shrikhande graph graph on 16 vertices. ## The shrikhande graph is a non-planar 6-regular graph with chromatic number 4 and clique number 3. ## As an option, one may input the labels of the vertices as a set or list of size 16. ## ##EXAMPLES ##> with(GraphTheory): ## with(SpecialGraphs): ##> G := ShrikhandeGraph(): ##> ChromaticNumber(G, 'c'); ##< 4 ##> c; ##< [[1, 2, 5, 6], [4, 7, 9, 14], [3, 8, 10, 13], [11, 12, 15, 16]] ##> IsPlanar(G); ##< false #---------ver. 23, modified by MG ShrikhandeGraph := proc() local i, V; if nargs = 0 then V := [seq(i,i=1..16)] elif nargs = 1 then if type(args[1],list(VERTEXTYPE)) and nops({op(args[1])})=16 then V := [op(args[1])]; else error "1st argument is expected to be a list of size 16"; end if; else error "expecting at most 1 argument" end if; Graph(undirected, unweighted, V, Array([ {7, 8, 10, 12, 14, 15}, {3, 4, 10, 11, 14, 16}, {2, 4, 6, 7, 15, 16}, {2, 3, 6, 8, 11, 12}, {7, 8, 9, 11, 13, 16}, {3, 4, 9, 12, 13, 15}, {1, 3, 5, 8, 15, 16}, {1, 4, 5, 7, 11, 12}, {5, 6, 10, 12, 13, 16}, {1, 2, 9, 12, 14, 16}, {2, 4, 5, 8, 13, 14}, {1, 4, 6, 8, 9, 10}, {5, 6, 9, 11, 14, 15}, {1, 2, 10, 11, 13, 15}, {1, 3, 6, 7, 13, 14}, {2, 3, 5, 7, 9, 10} ])); end; ############################################## ##PROCEDURE(doti) SpecialGraphs[SoccerBallGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- SoccerBallGraph() ##- SoccerBallGraph('V') ## ##PARAMETERS ##- 'V' : set or list of size 60 (optional) ## ##DESCRIPTION ##- `SoccerBallGraph` will create the so called soccer ball graph graph on 60 vertices. ## The soccer ball graph is a planar 3-regular graph with no triangles. ## As an option, one may input the labels of the vertices as a set or list of size 60. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> SB := SoccerBallGraph(); ##> IsPlanar(SB, 'F'); ##< true ##> nops(F); ##< 32 ##> DrawGraph(SB,style=spring); ##> DrawGraph(SB,style=spring,dimension=3); #---------ver. 23, modified by MG SoccerBallGraph := proc() local i, V, G, HC, vp; if nargs = 0 then V := [seq(i,i=1..60)] elif nargs = 1 then if type(args[1],list(VERTEXTYPE)) and nops(args[1])=60 then V := [op(args[1])]; else error "1st argument is expected to be a set or list of size 60"; end if; else error "expecting at most 1 argument" end if; G := Graph(undirected, unweighted, V, Array([{2, 5, 6}, {1, 3, 11}, {2, 4, 16}, {3, 5, 21}, {1, 4, 26}, {1, 7, 10}, {6, 8, 30}, {7, 9, 49}, {8, 10, 53}, {6, 9, 12}, {2, 12, 15}, {10, 11, 13}, {12, 14, 54}, {13, 15, 58}, {11, 14, 17}, {3, 17, 20}, {15, 16, 18}, {17, 19, 59}, {18, 20, 38}, {16, 19, 22}, {4, 22, 25}, {20, 21, 23}, {22, 24, 39}, {23, 25, 43}, {21, 24, 27}, {5, 27, 30}, {25, 26, 28}, {27, 29, 44}, {28, 30, 48}, {7, 26, 29}, {32, 35, 36}, {31, 33, 41}, {32, 34, 46}, {33, 35, 51}, {31, 34, 56}, {31, 37, 40}, {36, 38, 60}, {19, 37, 39}, {23, 38, 40}, {36, 39, 42}, {32, 42, 45}, {40, 41, 43}, {24, 42, 44}, {28, 43, 45}, {41, 44, 47}, {33, 47, 50}, {45, 46, 48}, {29, 47, 49}, {8, 48, 50}, {46, 49, 52}, {34, 52, 55}, {50, 51, 53}, {9, 52, 54}, {13, 53, 55}, {51, 54, 57}, {35, 57, 60}, {55, 56, 58}, {14, 57, 59}, {18, 58, 60}, {37, 56, 59}])); # This Hamiltonian cycle was found by MG on June 21st, 2006, # by looking for a 3-coloring of the graph. HC := [1,5,26,27,25,24,43,42,40,36,31,35,56,57,58,14,15,17,16, 20,19,18,59,60,37,38,39,23,22,21,4,3,2,11,12,13,54,55, 51,34,33,32,41,45,44,28,29,30,7,8,49,48,47,46,50,52,53,9,10,6,1]; SetGraphAttribute(G,"hamiltonian_cycles"=[HC]); vp := [[.1925920496,.6701949175], [.2010144636,.7372485558], [0.0942319327, .6319911454], [.1186210720, .4841246846], [.1514294006, .5433515199], [.2778629040, .7041578445], [.3006423172, .6277030074], [.3920175932, .6486900208], [.4402690592, .7291181803], [.3745898538, .7745003942], [.3668598220, .8578967160], [.4333446096, .8449116402], [.5667429483, .8450102742], [.6331250273, .8579262398], [.5000133347, .9265869532], [0.245459840e-1, .6548871358], [.5000000000, 1.000000000], [.9753842112, .6546764229], [.7937544373, 0.0955558029], [.2057613309, 0.0957796362], [.1819909566, .2891336302], [.2491147003, .1551569628], [.3972956856, .1324903100], [.3511022937, .1818676533], [.2432987405, .2603790138], [.2004085972, .4657056934], [.2370751162, .3518481995], [.3169197645, .3498845911], [.3252496746, .4432698456], [.2636563162, .5140122777], [.7627071909, .3517754318], [.6829724304, .3498033472], [.6747421936, .4432325466], [.7363231024, .5139477218], [.7996722238, .4655325955], [.7566463468, .2602276938], [.8179278897, .2889567156], [.7505764422, .1550528990], [.6024078147, .1324312151], [.6486567485, .1818011740], [.5862140285, .2795604486], [.5596932234, .2043473072], [.4401002756, .2043689508], [.4136215266, .2795831418], [.4999277187, .3162835606], [.5789545499, .4743342561], [.4999947455, .4169849760], [.4210388860, .4743431842], [.4512020746, .5671791694], [.5488097440, .5671584144], [.6994107670, .6276582311], [.6080138874, .6486327706], [.5597850890, .7291087856], [.6254413438, .7744133804], [.7221836618, .7040991633], [.8486463191, .5432083117], [.8074232275, .6701138590], [.7990369176, .7373046578], [.9054955400, .6319239843], [.8813237436, .4839984616]]; #vp := [ #[.5, 1.000000000], [0.244344877e-1, .6545592747], #[.2060031081, 0.955105550e-1], [.7937196841, 0.953827324e-1], #[.9755245584, .6543283110], [.5000638323, .9266235534], #[.6332576383, .8577799394], [.5668670557, .8451303075], #[.4333165569, .8450688409], [.3668227466, .8578826051], #[0.941964212e-1, .6318941609], [.2008414204, .7372973852], #[.1924575310, .6701580898], [.1511836168, .5431701272], #[.1184564860, .4839418136], [.2490524356, .1547591684], #[.1818295854, .2888301620], [.2431063712, .2600987339], #[.3510887298, .1816094628], [.3973422369, .1321535474], #[.7507798962, .1546941178], [.6024617216, .1321450596], #[.6488177754, .1814746359], [.7566326644, .2600814438], #[.8180642614, .2886904626], [.9058308118, .6317323496], #[.8813795506, .4838790264], [.8488198108, .5430463580], #[.8076187824, .6700883334], [.7992668564, .7372668560], #[.4999746947, .4169544139], [.5789741572, .4743141706], #[.5488493815, .5671811740], [.4511936530, .5671996503], #[.4210081136, .4743505912], [.4999651850, .3161749620], #[.4136358117, .2794628398], [.4400833844, .2041795001], #[.5597549340, .2041656737], [.5862809732, .2793947236], #[.6748243300, .4431509083], [.6830574690, .3496934536], #[.7628529927, .3515882214], [.7998110338, .4654006772], #[.7364400604, .5138851861], [.6080676160, .6486939043], #[.6995190773, .6276342330], [.7222960908, .7040262364], #[.6255598966, .7745015122], [.5598560221, .7291682657], #[.3919880884, .6487309548], [.4402357031, .7291897809], #[.3745811298, .7745061060], [.2777369467, .7041687731], #[.3005205243, .6277287246], [.3251750550, .4432231580], #[.2635722134, .5139935802], [.2001582380, .4655385549], #[.2371178240, .3517218208], [.3168833450, .3497813636]]; GraphInfo:-SetVPos(G, VP_FIXED, vp); G; end; ############################################## ##PROCEDURE(doti) SpecialGraphs[TetrahedronGraph] ##TITLE SpecialGraphs[TetrahedronGraph] ##TITLE SpecialGraphs[OctahedronGraph] ##TITLE SpecialGraphs[DodecahedronGraph] ##TITLE SpecialGraphs[IcosahedronGraph] ##ALIAS SpecialGraphs[TetrahedronGraph], SpecialGraphs[OctahedronGraph], SpecialGraphs[DodecahedronGraph], SpecialGraphs[IcosahedronGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- TetrahedronGraph() ##- TetrahedronGraph('V1') ## ##- OctahedronGraph() ##- OctahedronGraph('V2') ## ##- DodecahedronGraph() ##- DodecahedronGraph('V3') ## ##- IcosahedronGraph() ##- IcosahedronGraph('V4') ## ## ##PARAMETERS ##- 'V1' : set or list of size 4 (optional) ##- 'V2' : list of size 6 (optional) ##- 'V3' : set or list of size 20 (optional) ##- 'V4' : (optional) list of 12 vertex labels ## ##DESCRIPTION ##- `TetrahedronGraph` will create the tetrahedron graph (the complete graph) on 4 vertices. ## As an option, one may input the labels of the vertices as a set or list of size 4. ## ##- `OctahedronGraph` will create the octahedron graph on 6 vertices. ## As an option, one may input the labels of the vertices as a set or list of size 6. ## ##- `DodecahedronGraph` will create the dodecahedron graph graph on 20 vertices. ## A dodecahedron is a 3-regular and 12-faced planar graph. ## As an option, one may input the labels of the vertices as a set or list of size 20. ## ##- `IcosahedronGraph` will create the icosahedron graph graph on 12 vertices. ## An icosahedron is a 5-regular and 20-faced planar graph. ## As an option, one may input the labels of the vertices as a set or list of size 12. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> T := TetrahedronGraph(); ##> DrawGraph(T); ##> G := OctahedronGraph(); ##> IsPlanar(G); ##< true ##> DrawGraph(G); ##> H := DodecahedronGraph(): ##> Neighborhood(H, 19); ##< [14, 18, 20] ##> IsPlanar(H, 'F'); ##< true ##> nops(F); ##< 12 ##> DrawGraph(H); ##> K := IcosahedronGraph(): ##> IsPlanar(K, 'F'); ##< true ##> map(nops, F); ##< [3$20] ##> DrawGraph(K); #---------ver. 23, modified by MG TetrahedronGraph := proc() local G; if nargs = 0 then G := CompleteGraph(4) elif nargs = 1 then if type(args[1],list(VERTEXTYPE)) and nops({op(args[1])})=4 then G := CompleteGraph(args[1]); else error "1st argument is expected to be a list of four vertices"; end if; else error "expecting at most 1 argument" end if; G; end; ############################################## ##PROCEDURE(doti) SpecialGraphs[WheelGraph] ##AUTHOR Mahdad Khatirinejad ## ##CALLINGSEQ ##- WheelGraph('n') ## ##PARAMETERS ##- 'n' : positive integer ## ##DESCRIPTION ##- `WheelGraph`('n') will create the wheel graph on ~n+1~ vertices. ## ##EXAMPLES ##> with(GraphTheory): ##> with(SpecialGraphs): ##> W := WheelGraph(5); ##> Edges(W); ##< {{2, 3}, {1, 2}, {0, 3}, {0, 1}, {1, 5}, {4, 5}, {3, 4}, {0, 5}, {0, 4}, {0, 2}} ##> DrawGraph(W); #---------ver. 23, modified by MG WheelGraph := proc(N::posint) local i, G, vp; if N<3 then error "1st argument is expected to be greater than or equal to 3." fi; G := Graph( undirected, unweighted, [$0..N], Array([{seq(i+1,i=1..N)},seq({1, irem(i,N)+2, irem(N+i-2,N)+2}, i=1..N)])); vp := GraphInfo:-GetVPos(CycleGraph(N), VP_FIXED); vp := [[0,0],op(vp)]; GraphInfo:-SetVPos(G, VP_FIXED, vp); G; end; ############################################## #---------ver. 23, modified by MG TorusGridGraph := proc(m::posint, n::posint) local G, vp, i, j; if m<3 or n<3 then error "the arguments must be integers greater than 2." fi; G := CartesianProduct(CycleGraph(m), CycleGraph(n)); vp := Array(1..m*n); for i from 0 to m-1 do for j from 0 to n-1 do vp[n*i+j+1] := [i,j]; if i>0 and i0 and j with(GraphTheory): ##> with(SpecialGraphs): ##> G := ThetaGraph(3, 4, 3); ##> DegreeSequence(G); ##< [3,3,2$7] ##> DrawGraph(G); ##> CircularChromaticNumber(G); ##< 7/3 #---------ver. 23, modified by MG ThetaGraph := proc() local r, s, t, T, i; t := nargs; r := [args]; if t = 0 then error "at least one argument is needed."; elif map(type, r, posint)=[true$t] then if numboccur(r, 1) > 1 then WARNING("only one of the arguments can be 1, extra 1s are discrded."); fi; s := 2; T := NULL; for i to t do T := T, Trail(1, $s+1..s+r[i]-1, 2); s := s+r[i]-1; od; Graph([$1..s], T); else error "all arguments must be positive integers." fi; end proc; end use; end module: # SpecialGraphs #savelib('SpecialGraphs');