Un premier graphe dans Mathematica

Un graphe donné par une liste d’arcs, on utilise ESC-d-e-ESC pour directed edge
On fournit la liste des arcs, on peut ajouter des options supplémentaires (par exemple, d’affichage)
On peut aussi commencer en donnant la liste des sommets

grSlide10=Graph[{"a"\[DirectedEdge]"b","a"\[DirectedEdge]"e","b"\[DirectedEdge]"b","b"\[DirectedEdge]"c","c"\[DirectedEdge]"c","c"\[DirectedEdge]"d","c"\[DirectedEdge]"e","d"\[DirectedEdge]"a","e"\[DirectedEdge]"a","e"\[DirectedEdge]"d"},VertexLabels->"Name"]

On peut aussi utiliser des “wrappers” pour ajouter un style ou un label, ...

grSlide10=Graph[{"a"\[DirectedEdge]"b",Labeled["a"\[DirectedEdge]"e","arc"],Style["b"\[DirectedEdge]"b",Red],"b"\[DirectedEdge]"c","c"\[DirectedEdge]"c","c"\[DirectedEdge]"d","c"\[DirectedEdge]"e","d"\[DirectedEdge]"a","e"\[DirectedEdge]"a","e"\[DirectedEdge]"d"},VertexLabels->"Name"]

Voici ce que Mathematica conserve en “interne”, on remarque qu’il maintient 
la liste des sommets, la liste des arcs et toutes les informations supplémentaires

FullForm[grSlide10]

grSlide10

Affichage du graphe grSlide10 défini ci-avant, avec certaines options; par défaut les sommets sont étiquetés à partir de 1

GraphPlot[grSlide10,PlotStyle->{Dashed,Blue},VertexLabeling->True,MultiedgeStyle->.2,SelfLoopStyle->True]

VertexList[grSlide10]

Pour faire apparaître les labels des sommets, une fonction “compliquée” pour le rendu des sommets

GraphPlot[grSlide10,PlotStyle->{Dashed,Blue},VertexRenderingFunction->({White,EdgeForm[Black],Disk[#,.1],Red,Text[VertexList[grSlide10][[#2]],#1]}&),MultiedgeStyle->.2,SelfLoopStyle->True]

EdgeList[grSlide10]

VertexDegree[grSlide10]

VertexOutDegree[grSlide10]

VertexInDegree[grSlide10]

TableForm[{VertexList[grSlide10],VertexOutDegree[grSlide10],VertexInDegree[grSlide10],VertexDegree[grSlide10]}]

TeXForm[%]

{VertexList[grSlide10],VertexOutDegree[grSlide10],VertexInDegree[grSlide10],VertexDegree[grSlide10]}//TableForm

Ne pas hésiter à utiliser l’aide

?Edge*

HandShaking Formula... D’abord la somme des demi-degrés sortants

Apply[Plus,VertexOutDegree[grSlide10]]

Apply[Plus,VertexOutDegree[grSlide10]]==Apply[Plus,VertexInDegree[grSlide10]]

Le degré total est la somme du demi-degré entrant et du demi-degré sortant

VertexOutDegree[grSlide10]+VertexInDegree[grSlide10]==VertexDegree[grSlide10]

Pour n' avoir que les arcs d’origine “b”

EdgeList[grSlide10,"b"\[DirectedEdge]_]

Pour avoir les successeurs de “b”

EdgeList[grSlide10,"b"\[DirectedEdge]_]/.(x_ \[DirectedEdge]y_->y)

En général les fonctions en Q font référence à une question

SimpleGraphQ[grSlide10]

DirectedGraphQ[grSlide10]

HamiltonianGraphQ[grSlide10]

Un exemple (diviseurs jusqu’à dix)

Divisors[10]

Map[#\[DirectedEdge]10&,Divisors[10]]

Table[Map[#\[DirectedEdge]j&,Divisors[j]],{j,2,10}]

Flatten[%]

d=Graph[%]

VertexList[d]

FullForm[d]

d=VertexDelete[d,1]

VertexList[d]

EdgeList[d]

Pour avoir le label des sommets correct (maintenant que le premier sommet est 2 et non 1)
et on n’affiche pas les boucles (SelfLoopStyle)

GraphPlot[d,VertexRenderingFunction->({EdgeForm[Blue],Pink,Disk[#1,0.2],Black,Text[VertexList[d][[#2]],#1]}&)]

Si on automatise dans une fonction

grapheDiviseurs[n_]:=VertexDelete[Graph[Flatten[Table[Map[#\[DirectedEdge]j&,Divisors[j]],{j,2,n}]],GraphLayout->"SpringEmbedding"],1]

Table[
GraphPlot[grapheDiviseurs[j],VertexRenderingFunction->({EdgeForm[Blue],Pink,Disk[#1,0.2],Black,Text[VertexList[grapheDiviseurs[j]][[#2]],#1]}&)],
{j,8,16}]

Un exemple “complexe” et aléatoire

?RandomInteger

g=Graph[Map[RandomInteger[#]\[DirectedEdge]#+1&,Range[0,1000]]];

Shallow[EdgeList[g]]

GraphPlot[g,Method->"SpringElectricalEmbedding"]

GraphPlot[g,Method->{"SpringElectricalEmbedding","RepulsiveForcePower"->-2}]

GraphPlot[g,Method->{"SpringElectricalEmbedding","InferentialDistance"->.5}]

Un graphe non orienté

petersen=GraphData["PetersenGraph"]

VertexDegree[petersen]

EdgeList[petersen]

test=GraphData["RhombicTriacontahedralGraph"]

Handshaking formula dans le cas non orienté

VertexDegree[test]

Apply[Plus,%]

EdgeCount[test]

GraphData[{"TorusGrid", {8, 8}}]

Length[GraphData["R*"]]

Map[GraphPlot[GraphData[#]]&,GraphData["R*"]]

Graphes de Cayley

PermutationGroup[{Cycles[{{1,2,3}}],Cycles[{{1,2}}]}]

elem=GroupElements[%]

TableForm[elem]

grCayley=CayleyGraph[PermutationGroup[{Cycles[{{1,2,3}}],Cycles[{{1,2}}]}],VertexLabels->Placed["Name",Center],VertexSize->0.4]

GraphPlot[grCayley,PlotStyle->{Dashed,Blue},VertexRenderingFunction->({White,EdgeForm[Black],Disk[#,.1],Red,Text[t[[#2]],#1]}&),MultiedgeStyle->.2,SelfLoopStyle->True]

PermutationGroup[{Cycles[{{1,5,4}}],Cycles[{{3,4}}]}]

GroupElements[%]

CayleyGraph[PermutationGroup[{Cycles[{{1,5,4}}],Cycles[{{3,4}}]}],VertexLabels->Placed["Name",Center],VertexSize->0.4]

Coloriage de sommets

cube=GraphData["CubicalGraph"]

FindIndependentVertexSet[cube]

FindIndependentVertexSet[cube,Infinity,All]

HighlightGraph[cube,{1,4,6,7},GraphHighlightStyle->"Thick"]

ChromaticPolynomial[cube,x]

Plot[%,{x,0,4}]

On cherche la première valeur non nulle, ici i=2, donc 2 couleurs

Table[ChromaticPolynomial[cube][i],{i,1,4}]

Pour le dual du cube

dual=Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]4,1\[UndirectedEdge]5,2\[UndirectedEdge]3,2\[UndirectedEdge]5,2\[UndirectedEdge]6,3\[UndirectedEdge]4,3\[UndirectedEdge]6,4\[UndirectedEdge]5,4\[UndirectedEdge]6,5\[UndirectedEdge]6}]

VertexDegree[dual]

Table[ChromaticPolynomial[dual][i],{i,1,4}]

Construction d’un graphe de De Bruijn

On se limite ici à deux “lettres” 0 et 1, le seul paramètre k est la longueur des mots considérés

sommets[k_]:=Tuples[{0,1},k]

Map[Labeled[#\[DirectedEdge]Append[Drop[#,1],0],0]&,sommets[3]]

Pour alléger la présentation, les sommets sont donnés par leur “valeur” en base 2

FromDigits[{1,1,0},2]

deBruijn[k_]:=Graph[Union[Map[Labeled[#\[DirectedEdge]Append[Drop[#,1],0],0]&,sommets[k]],Map[Labeled[#\[DirectedEdge]Append[Drop[#,1],1],1]&,sommets[k]]],
VertexLabels->Map[#->FromDigits[#,2]&,sommets[k]],
GraphLayout->"SpringElectricalEmbedding"];

deBruijn[3]

Table[deBruijn[j],{j,1,5}]

Trouver un circuit hamiltonien (passant par chaque sommet)

FindHamiltonianCycle[deBruijn[3]]

Garder uniquement le label, on va donc trouver un mot de de Bruijn

First[%]/.(x_\[DirectedEdge]y_->Last[y])

Ne pas oublier que l’on a un mot circulaire

DeleteDuplicates[Partition[%,3,1]]//TableForm

HighlightGraph[deBruijn[4],
FindHamiltonianCycle[deBruijn[4]]]

Balade sur un échiquier

moves={{1,2},{1,-2},{2,1},{2,-1},{-1,2},{-1,-2},{-2,1},{-2,-1}}

construit[{x_,y_}]:=Select[Map[#+{x,y}&,moves],0<#[[1]]<9&&0<#[[2]]<9&]

construit[{5,8}]

Map[{5,8}\[UndirectedEdge]#&,construit[{5,8}]]

On a la présence de “doubles arêtes” que l’on doit supprimer, par exemple
{1,1}<->{2,3} et {2,3}<->{1,1}

DeleteDuplicates[Flatten[Table[Map[{i,j}\[UndirectedEdge]#&,construit[{i,j}]],{i,1,8},{j,1,8}]//DeleteDuplicates]/.(x_\[UndirectedEdge]y_/;First[y]<First[x]->y\[UndirectedEdge]x)]

mvtCavalier=Graph[%]

FindHamiltonianCycle[mvtCavalier]

HighlightGraph[mvtCavalier,FindHamiltonianCycle[mvtCavalier],
GraphHighlightStyle->"Thick"]