Создание графика с краями разных цветов в Mathematica

Question

Я хочу создать график (теорию графика), где определенные края имеют другой цвет к другим краям, который будет использоваться для выделения пути на графике из одной вершины к другому.

Вот несколько примеров, которые имеют разные цветные края http://demonstrations.wolfram.com/agraphteoryinterpretationofthesumofthefirstnitegers/ и http://demonstrations.wolfram.com/ramsey336/. Анкет Я посмотрел на исходный код для этих решений, но эти решения кажутся сложными. Мне нужен простой пример для работы. Я считаю, что мне нужно использовать edgerenderingfunction как один из вариантов для GraphPlot.

Дополнительно под Edgerenderingfunction Документация в «Больше информации» в части, в которой говорится:

Это выглядит полезно, но, к сожалению, нет кодированных примеров для попытки.

Принимая это в буквальном смысле, я пробовал что -то вроде

GraphPlot [{1 -> 2, 2 -> 3, 3 -> 4, 4 -> 1, 2 -> 4, 4 -> 5, 4 -> 6}, VertexLabeling -> True,
Edgerenderingfunction -> g [{1, 2}, {1, 2}, красный]

Но это не будет работать. Это займет что-то более умное, чем это.

Answer 1

Вот пример, который иллюстрирует, как автоматизировать выделение определенного пути через график.

Вот глупый график, указанный списком краевых правил:

edges = Table[i -> Mod[1 + i^2, 10], {i, 0, 9}];
GraphPlot[edges, VertexLabeling -> True]

Вот путь через график, который мы хотели бы выделить.

path = {0, 1, 2, 5, 6, 7, 0};

Давайте разделим путь на края, учитывая тот факт, что мы хотим выделить край, независимо от его ориентации.

edgesToHighlight = Partition[path, 2, 1];
edgesToHighlight = Join[edgesToHighlight,
    Reverse /@ edgesToHighlight];

Мы пишем EdgeRenderingFunction Это делает преимущество в одном из двух стилей, в зависимости от нет, есть ли это в нашем списке или нет.

erf[pts_, edge_, ___] := If[MemberQ[edgesToHighlight, edge],
    {Thick, Black, Arrow[pts, 0.1]}, {Darker[Red], Line[pts]}];

Наконец, мы отображаем результат.

GraphPlot[edges, EdgeRenderingFunction -> erf,
    VertexLabeling -> True]

Answer 2

GraphPlot[
 {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 1, 2 -> 4, 4 -> 5, 4 -> 6}, 
 VertexLabeling -> True, 
 EdgeRenderingFunction -> (
    {If[#2 == {1, 2}, Red, Black], 
     Line[#1]}
  &)
]

Функция рендеринга представляет собой функцию обратного вызова, которая занимает 3 аргумента. 1-й - список координат линии, 2-й - вершины края, а 3-й - это метка края.

В Mathematica вы можете создать анонимную функцию с (f[#1,#2,#3,...] &).