Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
415 views
in Technique[技术] by (71.8m points)

wolfram mathematica - tips for creating Graph diagrams

I'd like to programmatically create diagrams like this
(source: yaroslavvb.com)

I imagine I should use GraphPlot with VertexCoordinateRules, VertexRenderingFunction and EdgeRenderingFunction for the graphs. What should I use for colored beveled backgrounds?

Edit Using mainly Simon's ideas, here's a simplified "less robust" version I ended up using

Needs["GraphUtilities`"];
GraphPlotHighlight[edges_, verts_, color_] := Module[{},
  vpos = Position[VertexList[edges], Alternatives @@ verts];
  coords = Extract[GraphCoordinates[edges], vpos];
  (* add .002 because end-cap disappears when segments are almost colinear *)  
  AppendTo[coords, First[coords] + .002];
  Show[Graphics[{color, CapForm["Round"], JoinForm["Round"], 
     Thickness[.2], Line[coords], Polygon[coords]}],
   GraphPlot[edges], ImageSize -> 150]
  ]

SetOptions[GraphPlot, 
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .15], 
      Black, Text[#2, #1]} &), 
  EdgeRenderingFunction -> ({Black, Line[#]} &)];
edges = GraphData[{"Grid", {3, 3}}, "EdgeRules"];
colors = {LightBlue, LightGreen, LightRed, LightMagenta};
vsets = {{8, 5, 2}, {7, 5, 8}, {9, 6, 3}, {8, 1, 2}};
MapThread[GraphPlotHighlight[edges, #1, #2] &, {vsets, colors}]


(source: yaroslavvb.com)

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Generalising Samsdram's answer a bit, I get

GraphPlotHighlight[edges:{((_->_)|{_->_,_})..},hl:{___}:{},opts:OptionsPattern[]]:=Module[{verts,coords,g,sub},
  verts=Flatten[edges/.Rule->List]//.{a___,b_,c___,b_,d___}:>{a,b,c,d};
  g=GraphPlot[edges,FilterRules[{opts}, Options[GraphPlot]]];
  coords=VertexCoordinateRules/.Cases[g,HoldPattern[VertexCoordinateRules->_],2];
  sub=Flatten[Position[verts,_?(MemberQ[hl,#]&)]];
  coords=coords[[sub]];     
  Show[Graphics[{OptionValue[HighlightColor],CapForm["Round"],JoinForm["Round"],Thickness[OptionValue[HighlightThickness]],Line[AppendTo[coords,First[coords]]],Polygon[coords]}],g]
]
Protect[HighlightColor,HighlightThickness];
Options[GraphPlotHighlight]=Join[Options[GraphPlot],{HighlightColor->LightBlue,HighlightThickness->.15}];

Some of the code above could be made a little more robust, but it works:

GraphPlotHighlight[{b->c,a->b,c->a,e->c},{b,c,e},VertexLabeling->True,HighlightColor->LightRed,HighlightThickness->.1,VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .06], 
Black, Text[#2, #1]} &)]

Mathematica graphics


EDIT #1: A cleaned up version of this code can be found at http://gist.github.com/663438

EDIT #2: As discussed in the comments below, the pattern that my edges must match is a list of edge rules with optional labels. This is slightly less general than what is used by the GraphPlot function (and by the version in the above gist) where the edge rules are also allowed to be wrapped in a Tooltip.

To find the exact pattern used by GraphPlot I repeatedly used Unprotect[fn];ClearAttributes[fn,ReadProtected];Information[fn] where fn is the object of interest until I found that it used the following (cleaned up) function:

Network`GraphPlot`RuleListGraphQ[x_] := 
  ListQ[x] && Length[x] > 0 && 
    And@@Map[Head[#1] === Rule 
         || (ListQ[#1] && Length[#1] == 2 && Head[#1[[1]]] === Rule) 
         || (Head[#1] === Tooltip && Length[#1] == 2 && Head[#1[[1]]] === Rule)&, 
      x, {1}]

I think that my edges:{((_ -> _) | (List|Tooltip)[_ -> _, _])..} pattern is equivalent and more concise...


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...