Tag Info

Hot answers tagged

11

Although this is hardly a debilitating bug I wondered what else might be affected so I decided to trace this further. I found that the bug affects TreeForm by way of TreePlot. Here is a reduced example of the call that originates in the exhibit above: TreePlot[{1 -> 2, 1 -> 3, 1 -> 4}, Top, 1, "VertexNames" -> {List, HoldForm["foo"], ...


9

Here is a linear programming surrogate that seems to do tolerably well. I'll show the code for your example but with a different cost function. I use 0-1 variables v[j,k] to indicate vertex j gets item k. edges = {{1, 2}, {2, 3}, {1, 4}, {2, 5}, {4, 5}, {3, 6}, {5, 6}, {4, 7}, {7, 8}, {5, 8}, {6, 9}, {8, 9}}; klpairs = With[{pairs = ...


9

A simple workaround is to re-build the graph object by cycling it through some other representation. Here are two possible solutions: rebuildGraph[g_] := Uncompress@Compress[g] (* solution 1 *) rebuildGraph[g_] := Graph[VertexList[g], EdgeList[g]] (* solution 2 destroys properties but it's fine for isomorphism testing purposes *) isomorphicGraphQ[g1_, ...


9

img=Import["http://i.stack.imgur.com/uBeKs.png"] mg = MorphologicalGraph[img] vdF = With[{gr = #}, VertexDelete[gr, _?(VertexDegree[gr, #] <= 1 &)]] &; Nest[vdF, mg, 2]


7

I've never played with Graphs much in Mathematica. Call it laziness, whatever, but I just never had a need. So, what better time to learn? Here's how I approached it. First we define a function that uses VertexContract to "rewire" the graph at every degree 2 vertices. Since this will be iterative, we only want it to act when the graph still contains a ...


4

On my system (OS X 10.10.4) it doesn't even display correctly on-screen. This means that rasterization doesn't help. I can confirm the problem in 10.0.2, 10.1.0 and 10.2.0. The problem doesn't exist in 9.0.1. We can trace back this problem to a BezierCurve bug. gr = Show@Graph[{1 <-> 1, 1 <-> 2}, EdgeShapeFunction -> "Line", ...


4

Admittedly the implementation below is not as simple or efficient as I wished. Some of the visualizations are a bit messy, but I think it works correctly. Basically it tracks the planar graph boundary and tries to add new edges in regularity-admitting locations. Regular planar tilings are trivially present, but this code also generates Platonic graphs ...


3

Selecting the subgraph containing a specific node: Subgraph[ Graph[edgelist], VertexComponent[Graph[UndirectedEdge @@@ edgelist], {"A"}] ]


3

u = UndirectedEdge @@@ edgelist; g = First@SortBy[ConnectedComponents@Graph@u, -Length@# &] Subgraph[Graph@edgelist, g]


3

I did some experimentation on Metropolis-Hastings algorithm for stochastic minimization of the cost function: ClearAll@mhGraphPairwiseMinimize; (* minimize sum of per-edge costs (computed as pairwise vertex item distances) by assigning items to vertices in a graph, using a Metropolis-Hastings algorithm. higher alpha makes random walk penalize ...


3

wam = WeightedAdjacencyMatrix@SomeGraph; erf = ({ColorData[{"TemperatureMap", "Reverse"}][Rescale[wam[[Sequence @@ #2]], {Min@wam, Max@wam}]], Line[#1]} &); PlotOfSomeGraph = GraphPlot[ SomeGraph, VertexCoordinateRules -> ...


3

The following works on v9 and makes use of the Orderless attribute, which for unknown reasons isn't attached to UndirectedEdge by default reduceG[g_Graph] := Module[{t, el, newEl, ue, p}, SetAttributes[ue, Orderless]; NestWhile[( t = VertexList[#][[p[[1, 1]]]]; el = ue @@@ EdgeList[#]; newEl = el /. {x___, ue[t, a_], y___, ue[t, b_], ...


3

If I understand your question correctly, you want the thickness of the edge to depend on the vertex the edge is directed towards? If so, then you will need to use EdgeShapeFunction: data = {{0, 1, 0}, {0, 0, 2}, {3, 0, 0}}; AdjacencyGraph[data, VertexLabels -> "Name", EdgeShapeFunction -> ({ Thickness[Last[#2]*0.01], ...


2

Say: effect = Total[A] Then you can, for example, extend your TableForm like this: TableForm[ Map[ {#, countLoopsWithVar[cycles, #], effect[[#]]} &, Range[14] ], TableHeadings -> { None, {"variable nr.", "feedbackloops AW", "effect"}} ] The others ones can be done just like this. It may not be the best way to do this, ...


1

If those edges are directed, then you haven't got any cycles involving s or t. To specify undirected edges use \[UndirectedEdge], which shows up on SE as <->. edgeList = {s <-> 1, s <-> 2, 1 <-> 3, 2 <-> 1, 2 <-> 4, 3 <-> 2, 3 <-> t, 4 <-> 3, 4 <-> t}; G = Graph[edgeList, VertexLabels -> ...


1

edgelist = {s -> 1, s -> 2, 1 -> 3, 2 -> 1, 2 -> 4, 3 -> 2, 3 -> t, 4 -> 3, 4 -> t}; MemberQ[edgelist, 1 -> 2] (* False *) MemberQ[edgelist, 2 -> 1] (* True *)


1

You can also set EdgeStyle to do this (using Graph): Graph[SomeGraph, EdgeStyle -> Thread[EdgeList[ SomeGraph] -> (Directive[Opacity[0.5], ColorData[{"TemperatureMap", "Reverse"}][#]] & /@ Rescale[PropertyValue[SomeGraph, EdgeWeight]])], GraphStyle -> "ThickEdge", VertexCoordinates -> TheCoordinates]


1

For your example the following works. edges = {0 -> 4, 1 -> 5, 2 -> 6, 3 -> 7, 4 -> 10, 5 -> 11, 6 -> 12, 7 -> 14}; Count[edges, Rule[u_, v_] /; v - u == 6] 3 Now let's verify that I am actually counting the right edges. Cases[edges, Rule[u_, v_] /; v - u == 6] {4 -> 10, 5 -> 11, 6 -> 12}


1

Needs["Combinatorica`"] g = ListGraphs[5]; Grid[{ShowGraph@#, Length@Automorphisms@#} & /@ g, Frame -> All]


1

I believe you want this: Module[{count}, count[__] = 0; # -> #2 <> ToString[++count[##]] & @@@ rules ] {"A2" -> "BO1", "A2" -> "BO2", "A2" -> "BO3", "A2" -> "BO4", "A2" -> "BO5", "A2" -> "BO6", "A2" -> "BO7", "A2" -> "BO8", "A2" -> "BO9", "A2" -> "BO10", "A2" -> "BO11", "A2" -> "BO12", "A2" -> ...



Only top voted, non community-wiki answers of a minimum length are eligible