Tag Info

New answers tagged

0

Changing ImageSize with one number changes both the height and width of the figure. In order to preserve the height across differen datasets (which is in retrospect one aspect I want) I have found a reasonable solution that involves setting the Y aspect of ImageSize to a fixed value and the X aspect to a value based on the number of nodes at the bottom of ...


3

facGraph[nn_] := With[{aa = Select[Subsets[Prime@Range@PrimePi@Floor@Sqrt@nn], Times @@ # <= nn &]}, ShowLabeledGraph[ HasseDiagram[ MakeGraph[aa, (SubsetQ[#2, #1] && (#1 != #2)) &, VertexLabel -> "Name"]], Map[Style[#, 10, Black] &, Times @@@ aa], PlotRange -> All, EdgeColor -> ...


1

Either calculate correct / specific coordinates to effect a desired spacing, or use ImageSize option, e.g. GraphPlot[graphNodes["Lys"], VertexLabeling -> True, VertexCoordinateRules -> nodeCoordinates["Lys"], ImageSize -> 550]


5

You can use EdgeShapeFunction: styles={Red, Directive[Dashed, Blue], Orange, Directive[Purple, Dashing[.01]], Green, Green}; i = 1; Graph[{a -> b, a -> b, a -> b, a -> b, a -> e, e -> b}, EdgeShapeFunction -> ({Arrowheads[Large],Thick,styles[[i++]],Arrow@#} &), VertexLabels->"Name"] If you have at most two edges ...


4

The below approach seems to work efficiently. First, generate a list q of vertex degrees that are each at least 2.0. You can make the graphs more complex by changing the RandomInteger[{2, 5}], below, to RandomInteger[{2, 6}] or whatever, so long as you don't make the degree greater than the number of nodes - 1 (which would force a self-loop). From the ...


0

It's a bug. I have reported it to WRI. The case ID is 3345230. And the Wolfram Technical Support has confirmed it as "a known issue", but no workaround is given.


5

AdjacencyMatrix >> Details: VertexList >> Details: So, unless you provide a vertex list as the first argument of Graph, VertexList[g] is populated with vertices in the order they appear in the edge list, i.e., {1, 3, 2, 4, 5, 6}. Using Range[6] as the first argument in Graph: g1 = Graph[Range[6], {1 \[UndirectedEdge] 3, 2 \[UndirectedEdge] 4, 3 ...


2

Needs["Combinatorica`"] a = CompleteGraph[7, 2]; An alternative, more convenient, Combinatorica function is DeleteVertices, which takes a list of vertices to be deleted. The function DeleteVertex takes a single vertex as the second argument, not a list of vertices. Thus, If you have to use DeleteVertex, you need to use Fold: delete vertex 3 in ...


4

CompleteGraph[a,b] set GraphLayout to be "MultipartiteLayout". a = CompleteGraph[{7, 2}]; a // Options {GraphLayout -> {"MultipartiteLayout", "VertexPartition" -> {7, 2}}} and this layout carried over to new graph. a = VertexDelete[a, {3, 4}]; a // Options {GraphLayout -> {"MultipartiteLayout", "VertexPartition" -> {7, 2}}} You could do what ...


2

A bit inelegant, but it works: Graph[VertexDelete[a, {3, 4}], DeleteCases[EdgeList[a], (3 | 4) <-> _ | _ <-> (3 | 4)], VertexLabels -> "Name", VertexCoordinates -> Drop[AbsoluteOptions[a, VertexCoordinates][[1, 2]], {3, 4}]]


2

Update: A more convenient way than the original post is to generate a seperate graph with only the new edges and combine the GraphicsGroupBoxes of the two graphs: ClearAll[graphAddF] graphAddF = RawBoxes[With[{gg2 = Cases[ToBoxes[#2], GraphicsGroupBox[x_] :> x[[1]], {0, Infinity}][[1]]}, Replace[ToBoxes[#], GraphicsGroupBox[{x_, y_}] :> ...


3

Update: The edge shape function "CurvedArc" has an option "Curvature" that controls the shape of the BezierCurve it produces. Examples: Graph[{1 -> 2, 2 -> 3, 1->3}, VertexCoordinates -> {{0, 0}, {1, 1}, {2, 2}}, VertexLabels -> Placed["Name", Center], VertexSize -> Medium, EdgeShapeFunction -> GraphElementData[{"CurvedArc", ...


1

THIS WORKS: $\hspace{3cm}$ Although... I can't get it so that it stops exiting the dynamic window when the message changes, and I think the logic might not be robust. bound = {{2, -1}, {2, 5}, {1, 0}, {3, 0}, {0, 1}, {4, 1}, {0, 2}, {4, 2}, {-1, 3}, {5, 3}, {-1, 4}, {5, 4}, {-1, 5}, {5, 5}, {0, 6}, {1, 6}, {3, 6}, {4, 6}} DynamicModule[{pos1 = ...


3

Just delete all the extraneous edgeweight and plotting functions because a shortest path is not well defined if you have negative weights: g = Graph[v, e] FindShortestPath[g, 44, 76] (* {44, 48, 52, 56, 60, 68, 76} *) Using Method->"BellmanFord" should work, but will not if there are negative cycles. Perhaps your graph has such cycles: ...


3

You problem is MatrixForm. It is hiding the fact that the output of AdjacencyMatrix is actually a SparseArray object. When you copy the pretty-printed output of MatrixForm and modify it, you are actually NOT modifying the underlying SparseArray object that stores the matrix. When you feed that apparently modified output back into GraphPlot, the definition ...


6

Based on the definition from the Wikipedia article, this should give you the resistance distance matrix of the graph g: With[{Γ = PseudoInverse[KirchhoffMatrix[g]]}, Outer[Plus, Diagonal[Γ], Diagonal[Γ]] - Γ - Transpose[Γ] ]


2

You can still use the old functions from Combinatorica, either to tide you over while you figure out the new ones, or as a semi-permanent solution. WRI has also provided a handy guide to transitioning from that package to the new built-in functions: "Upgrading from Combinatorica" For example, in the case of the obsolete code you mentioned: << ...


6

You might find it easier to use Rotate inside of Graphics rather than outside. To do this, you will need to "convert" the Graph to Graphics (I use Show) and then use MapAt to apply Rotate inside of Graphics. g = CompleteGraph[30, DirectedEdges -> True, EdgeStyle -> RGBColor[0, 0, 1], PlotRange -> 1.1*{{-1, 1}, {-1, 1}}, ...


2

I am assuming that it would be acceptable to turn the graph into an image first, then rotate / animate that image. This can be done at arbitrary resolution through appropriate options for Image. Here I am just using the image size you originally specified for the graph object. An option to ImageRotate comes in handy here: the size of its output can be set ...


3

Create all possible pairs of vertices (and their reverse) and calculate the maximum of their minimum graph distance. Sounds horrible? Looks even more scary in code justConnectedQ[g_?GraphQ] := Max[Min[GraphDistance[g, #1, #2] & @@@ {#, Reverse[#]}] & /@ Subsets[VertexList[g], {2}]] < Infinity justConnectedQ@Graph@{a -> b, c -> b} ...


5

Not super-elegant, but: justConnectedQ = Max @ MapThread[Min, {#, Transpose[#]}, 2] < Infinity & @* GraphDistanceMatrix


2

Using CompleteGraph as suggested by @Guesswhoitis in the comments and EdgeDelete: opts = {VertexLabels -> Placed["Name", Center], BaseStyle -> Thick, ImageSize -> 300, VertexSize -> {"Scaled", .1}, VertexLabelStyle -> Large}; k72 = CompleteGraph[{7, 2}, opts]; deletededges = {5 \[UndirectedEdge] 9, 2 \[UndirectedEdge] 8}; k72b = ...


2

Is it acceptable for your problem to change the costs associated to traversing the edges? If it is, then you can set the costs to: costs = { 1, 1, 1, 1, 10, 10, 10, 1, 10, 10, 10, 1, 1, 10, 10, 10, 1, 10, 10, 10, 1, 1, 1, 1 }; (* The following is your original code: *) g = Graph[{0 -> 11, 0 -> 12, 0 -> 13, 11 -> 21, 11 -> ...


2

I've implemented the algorithm given in the paper Algorithms for Enumerating All Perfect, Maximum and Maximal Matchings in Bipartite Graphs. This algorithm takes as input a directed bipartite graph and should give a list of all perfect matchings as output. EnumPerfectMatchings[G_] := EnumPerfectMatchingsIter[G, FindIndependentEdgeSet[G]] ...


1

The idea is to just to find one path at a time and remove those vertices from the graph and find the next one, by restring the flow. Not sure if this is still a minimum cost flow in the end. Also using source and targets for assignment, usually you need to set the cost of from the sources and targets to 0. It seems the FindMiniumCost only solves the ...


1

ClearAll[vcontractF] vcontractF = Module[{g = #, v = #2, vc = VertexContract@##, el = EdgeList@#, ew = PropertyValue[#, EdgeWeight], sel = IncidenceList@##, ew2}, ew2 = Rule@@@ (DeleteCases[Transpose[{el, ew}],{Alternatives@@Rest[sel], _}]/. {First@sel, _}:>{First@sel, Plus@@ew[[EdgeIndex[g, #]&/@sel]]}); SetProperty[vc, EdgeWeight -> ...


4

Version 9.0.1.0 (Windows 8 64-bit) In version 9.0.1.0 (Windows 8 64-bit), both PropertyValue and SetProperty work as expected: x = Graph[{1, 2, 3, 4}, {1 <-> 2, 3 <-> 2, 3 <-> 4, 1 <-> 4}, EdgeWeight -> {1, 10, 30, 60}, VertexLabels -> "Name", EdgeLabels -> "EdgeWeight", ImagePadding -> 20] PropertyValue ...


1

I haven't found a "natural" way, but this is probably more compact and eliminates all "intermediate" nodes at once. To remove just one vertex you could modify the function below so that it receives your node0_ as the toRemove variable without calculating it. wam = WeightedAdjacencyMatrix; straight[h_] := Module[{toRemove, wgt, edgs, newWAM}, ...


2

Here's my "one-liner" for graphs with undirected edges. FixedPoint[ IncidenceGraph[ Transpose[ Transpose[ Normal[IncidenceMatrix[#]] /. {0 ..., 1, 0 ...} -> Unevaluated[Sequence[]]] /. {0 ..., 1, 0 ...} -> Unevaluated[Sequence[]]]] &, graph]


7

Update: It turns out that the built-in function KCoreComponents does exactly what you need: KCoreComponents[g , k] gives the k-core components of the underlying simple graph of g. A k-core component is a maximal weakly connected subgraph in which all vertices have degree at least k. kccF[g_, o: OptionsPattern[Graph]] := Subgraph[g, ...


7

ClearAll[RemoveDeadEnds]; RemoveDeadEnds[g_Graph] := FixedPoint[ Function[g2, Subgraph[g2, Select[VertexList@g2, VertexDegree[g2, #] > 1 &]]], g] {#, RemoveDeadEnds@#} &@ Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 4 <-> 5, 3 <-> 6, 6 <-> 1}]


0

This method is based on the original article. First we need to convert list of spring connectivity (spring) into a graph: g = Graph[Apply[UndirectedEdge, spring, 1], VertexCoordinates -> mass]; Then Kirchhoff (Laplacian/admittance/discrete Laplacian) matrix should be found using KirchhoffMatrix: m = KirchhoffMatrix[g] // Normal; We also need to ...


3

Use AdjacencyGraph: myMatrix = {{0, 0, 1, 1, 1, 1, 0, 1}, {1, 0, 0, 1, 0, 0, 1, 0}, {1, 1, 1, 1, 0, 0, 0, 1}, {1, 0, 1, 0, 1, 0, 1, 0}, {0, 1, 0, 1, 1, 0, 1, 1}, {0, 1, 1, 0, 1, 0, 0, 1}, {0, 0, 0, 1, 1, 1, 1, 0}, {1, 1, 0, 0, 0, 0, 0, 1}}; AdjacencyGraph[myMatrix, ...


3

There is the somewhat hidden built-in graph-method of "EdgeLayout" that can be exploited for this purpose (see Details under GraphLayout): AdjacencyGraph[Range@8, Table[Boole[j > i], {i, 8}, {j, 8}], DirectedEdges -> True, VertexLabels -> "Name", GraphLayout -> { "EdgeLayout" -> {"DividedEdgeBundling", "CoulombConstant" ...


3

g1 = RandomGraph[{30, 50}]; g2 = RandomGraph[{30, 45}]; EditDistance[EdgeList[g1], EdgeList[g2]] (* 49 *)



Top 50 recent answers are included