Skip to content

Instantly share code, notes, and snippets.

/graphtheory
Created Oct 22, 2014

Embed
What would you like to do?
Graph theory mathematica
Framed[Manipulate[
If[showGraph === 0,
Which[
disp === reg,
Which[
addGraph == 0,
GraphPlot[GraphData[name], PlotStyle -> color,
VertexLabeling -> True],
addGraph == 1,
GraphPlot[
Operation[GraphData[name], GraphData[name2]], PlotStyle -> color,
VertexLabeling -> True]
],
disp === graphComp,
Which[
addGraph == 0,
GraphPlot[GraphComplement[GraphData[name]], PlotStyle -> color,
VertexLabeling -> True],
addGraph == 1,
GraphPlot[GraphComplement[
Operation[GraphData[name], GraphData[name2]]],
PlotStyle -> color,
VertexLabeling -> True]
],
disp === threeD,
Which[
addGraph == 0,
GraphPlot3D[GraphData[name], PlotStyle -> color,
VertexLabeling -> True],
addGraph == 1,
GraphPlot3D[
Operation[GraphData[name], GraphData[name2]], PlotStyle -> color,
VertexLabeling -> True]
],
disp === layered,
Which[
addGraph == 0,
LayeredGraphPlot[GraphData[name], PlotStyle -> color,
VertexLabeling -> True],
addGraph == 1,
LayeredGraphPlot[
Operation[GraphData[name], GraphData[name2]], PlotStyle -> color,
VertexLabeling -> True]
]
],
(*Which[
disp===reg||disp===threeD||disp===layered,
Which[
addGraph\[Equal]0,
MatrixForm[AdjacencyMatrix[GraphData[name]]],
addGraph\[Equal]1,
MatrixForm[AdjacencyMatrix[
Operation[GraphData[name],GraphData[name2]]]]
],
disp===graphComp,
Which[
addGraph\[Equal]0,
MatrixForm[AdjacencyMatrix[GraphComplement[GraphData[name]]]],
addGraph\[Equal]1,
MatrixForm[AdjacencyMatrix[GraphComplement[
Operation[GraphData[name],GraphData[name2]]]]]
]
]*)
Which[
disp === reg || disp === threeD || disp === layered,
Which[
addGraph == 0,
Grid[{{Graphics[
Table[Text[Style["Adjacency matrix", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
Text[
MatrixForm[AdjacencyMatrix[GraphData[name]]]
]
, Bold, 15], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["Graph order", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
VertexCount[GraphData[name]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Graph size", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
EdgeCount[GraphData[name]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Connected components", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {170, 30}],
Graphics[Table[Text[Style[
HighlightGraph[GraphData[name],
ConnectedComponents[GraphData[name]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["2-Cuts", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
HighlightGraph[GraphData[name],
Map[Subgraph[GraphData[name], #] &,
Last[FindMinimumCut[GraphData[name]]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}}, Frame -> All]
,
addGraph == 1,
Grid[{{Graphics[
Table[Text[Style["Adjacency matrix", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
Text[
MatrixForm[
AdjacencyMatrix[
Operation[GraphData[name], GraphData[name2]]]]
]
, Bold, 15], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["Graph order", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
VertexCount[Operation[GraphData[name], GraphData[name2]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Graph size", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
EdgeCount[Operation[GraphData[name], GraphData[name2]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Connected components", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {170, 30}],
Graphics[Table[Text[Style[
HighlightGraph[
Operation[GraphData[name], GraphData[name2]],
ConnectedComponents[
Operation[GraphData[name], GraphData[name2]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["2-Cuts", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
HighlightGraph[
Operation[GraphData[name], GraphData[name2]],
Map[Subgraph[
Operation[GraphData[name], GraphData[name2]], #] &,
Last[FindMinimumCut[
Operation[GraphData[name], GraphData[name2]]]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}}, Frame -> All]
],
disp === graphComp,
Which[
addGraph == 0,
Grid[{{Graphics[
Table[Text[Style["Adjacency matrix", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
Text[
MatrixForm[
AdjacencyMatrix[GraphComplement[GraphData[name]]]]
]
, Bold, 15], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[
Text[Style["Graph order", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
VertexCount[GraphComplement[GraphData[name]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Graph size", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
EdgeCount[GraphComplement[GraphData[name]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Connected components", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {170, 30}],
Graphics[Table[Text[Style[
HighlightGraph[GraphComplement[GraphData[name]],
ConnectedComponents[GraphComplement[GraphData[name]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["2-Cuts", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
HighlightGraph[GraphComplement[GraphData[name]],
Map[Subgraph[GraphComplement[GraphData[name]], #] &,
Last[FindMinimumCut[GraphComplement[GraphData[name]]]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}}, Frame -> All],
addGraph == 1,
Grid[{{Graphics[
Table[Text[Style["Adjacency matrix", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
Text[
MatrixForm[
AdjacencyMatrix[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]]]]
]
, Bold, 15], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["Graph order", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
VertexCount[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Graph size", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
EdgeCount[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}],
ImageSize -> 30]
}, {Graphics[
Table[Text[Style["Connected components", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {170, 30}],
Graphics[Table[Text[Style[
HighlightGraph[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]],
ConnectedComponents[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}, {Graphics[
Table[Text[Style["2-Cuts", 15], {1, 1},
Automatic, {1, 0}], {1}], ImageSize -> {120, 30}],
Graphics[Table[Text[Style[
HighlightGraph[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]],
Map[Subgraph[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]], #] &,
Last[FindMinimumCut[
GraphComplement[
Operation[GraphData[name], GraphData[name2]]]]]]]
, Bold, 20], {1, 1}, Automatic, {1, 0}], {1}]]
}}, Frame -> All]
]
]
(*up to here*)
],
Style["Basic Graph Manipulations", 25],
Style["Graphs", 16, Bold],
{{name, {4, 2}, "Graph 1"}, GraphData[;; 6]},
{{addGraph, 0, "Add another graph?"}, {0, 1}, Checkbox},
{{name2, {4, 3}, "Graph 2"}, GraphData[;; 6]},
"",
Delimiter,
"",
Style["Operations and Display", 16, Bold],
{{Operation, GraphUnion, "Graph Operation"}, {GraphUnion,
GraphIntersection, GraphDifference}, RadioButton},
{{disp, reg, "Graph Display"}, {reg, graphComp, threeD, layered},
RadioButton},
{{color, Black, "Edge colour"}, ColorSetter},
"",
Delimiter,
"",
Style["Paths and Other", 16, Bold],
{{vertex1, 1, "Vertex 1"},
VertexList[Operation[GraphData[name], GraphData[name2]]],
PopupMenu}, {{vertex2, 1, "Vertex 2"},
VertexList[Operation[GraphData[name], GraphData[name2]]],
PopupMenu},
{{showGraph, 0, "Display graph information"}, {0, 1}, Checkbox},
Paneled -> False
],
FrameMargins -> 50,
Background -> White,
BaseStyle -> {FontColor -> GrayLevel[0]}
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.