New answers tagged

0

GraphData[5] returns a list of specifications of graphs with 5 vertices. Apply GraphData again to such a specification to get an actual graph. For example, GraphData[{"Wheel", 5}] where {"Wheel", 5} is the last element from GraphData[5]. The GraphData documentation page has many such examples.


0

This is not a BUG. I think I've got an explanation for this problem: First thing first, Let's first check our documentation: It said that when setting EdgeCost to Automatic cost per unit flow on an edge is taken to be 1. Thus we can know that the calculation of Cost is given by multiplying EdgeCost with EdgeFlow and finally sum them up!!! Thus for the ...


0

Came across this question while looking for something else, but it looks like the graph functions in Mathematica 10 and higher can do this trivially now: m = ({{0, 1, 1, 1}, {1, 0, 1, 1}, {1, 1, 0, 1}, {1, 1, 1, 0}}); g = AdjacencyGraph[m]; FindGraphIsomorphism[g, g, All]; % // Length (* 24 *) %%[[5]] // Normal (* {1 -> 1, 2 -> 4, 3 -> 2, 4 -> 3}...


5

Here's a solution using your example file. Import as RawJSON because this gives us much easier to manipulate associations. json = Import[ "https://raw.githubusercontent.com/d3/d3-plugins/master/graph/data/miserables.json", "RawJSON"] After inspecting the format manually, it's easy to extract vertices: vertices = json[["nodes", All, "name"]] Links ...


0

Since the @nikie say this is #P-complete.So I enumerate it to get all of the minimal or maximal perfect maching.Of course,we can get the all possible Perfect Matching or Near-Perfect Matching as this topic by the same method.But the maximal and minimum match is more useful to us.So I post it as a example.Maybe more pretty solution can do this.I'll glad to ...


3

Property name Refers to Stored as Default ------------------------------------------------------------- VertexWeight vertices list 1 VertexCapacity vertices list 1 VertexSize vertices rules VertexShape vertices rules VertexShapeFunction vertices ...


0

Just carry Wjx's code for this problem.Maybe more beauty solution can do this. l = VertexList@neargraph; coor = PropertyValue[{neargraph, #}, VertexCoordinates] & /@ l; g = Graph[Range@Length@l, EdgeList@neargraph /. Thread[l -> Range@Length@l], VertexCoordinates -> coor]; cc = ConnectedComponents@g; pts = Map[{#, PropertyValue[{g, #}, ...


3

The following code will help: cc = ConnectedComponents@g; pts = Map[{#, PropertyValue[{g, #}, VertexCoordinates]} &, cc, {2}]; pre = First@MinimalBy[#, Last] & /@ Apply[{#1[[1]] <-> #2[[1]], Norm[#1[[2]] - #2[[2]]]} &, Tuples /@ Subsets[pts, {2}], {2}]; spt = EdgeList@ FindSpanningTree[ CompleteGraph[Length@cc, EdgeWeight -...


1

A summary of good pointers provided in comments: Szabolcs mentioned that "I never used SystemModeler, but I had the impression that it is specifically for problems that can be formulated as a set of ordinary differential equations (or differential-algebraic equations), with time as a variable. I don't think it is designed for combinatorial problems. Maybe ...


4

CommunityGraphPlot[g] will find community based on FindGraphCommunities[g] So that CommunityGraphPlot[g] is the same as CommunityGraphPlot[g, FindGraphCommunities[g]] You could put labels like the following to show # of members: n = 10; q = n*(n - 1)/2; g = CompleteGraph[n, EdgeWeight -> RandomReal[{0, 1}, {q}]]; com = ...


3

WOW! I made it! Code first~ Graphics2Graph[g_] := Module[{cd = If[FreeQ[g, Line], DirectedEdge @@@ (Extract[g, Position[g, Arrow[___]]] /. Arrow[x_, ___] :> {First@x, Last@x}), UndirectedEdge @@@ Extract[g, Position[g, Line[_]]][[1, 1]]]}, Graph[cd, VertexCoordinates -> Extract[Extract[g, Position[g, ...


0

I made it with a non-perferct solution,but actually I don't content with it.I hope to get a general methond to do this rather than customized for every Graphics. For g1 pos = Cases[Normal[g1], _Arrow, Infinity][[All, 1]]; rule = MapIndexed[Rule[#, First[#2]] &, DeleteDuplicates@Catenate[pos]]; Graph[UndirectedEdge @@@ (pos /. rule), ...


10

You are almost there but Graphs are not mutable so: DynamicModule[{graph}, Dynamic[graph] , Initialization :> ( graph = Graph[ {1 -> 3, 2 -> 3, 3 -> 6, 4 -> 6, 1 -> 5, 5 -> 4, 6 -> 2}, VertexLabels -> "Name", VertexShapeFunction -> ( EventHandler[ Disk[#1, .1], "MouseClicked" :> (graph = ...


2

You could use Property, e.g. sims = MapIndexed[Property[#2[[1]], VertexShape -> #1] &, simpsons] g = {1 -> 2, 2 -> 4, 2 -> 5, 2 -> 6, 3 -> 4, 3 -> 5, 3 -> 6}; Graph[sims, g, VertexSize -> 0.6] I am posting image of code to see effect:


1

Okay, I knew I was on to something but I didn't quite pull it together the first time. Here is a second attempt, still probably not as clean as it should be, and not entirely general, but I think at least delivering on the promise of a recursive solution. rls = {1 -> 2, 1 -> 4, 1 -> 5, 2 -> 3, 3 -> 4, 3 -> 5, 4 -> 5}; asc = GroupBy[...


7

This is a bug. The length of each association returned should be VertexCount[g1], but it isn't. Length /@ FindGraphIsomorphism[g1, g2, All] (* {10, 6, 8, 6, 8, 6, 9, 9, 9, 9, 6, 8, 8, 10, 8, 10, 10, 9, \ 9, 10, 9, 10, 9, 10, 10, 9, 9, 10, 8, 10, 10, 9, 10, 8, 9, 10, 9, 10, \ 9, 10, 10, 9, 8, 10, 9, 10, 8, 10, 10, 10, 10, 9, 8, 9, 10, 10, 6, 9, \ 10, 9, 8, ...


2

I think this is a bug of FindGraphIsomorphism.And you should give a report to Wolfram.This is what my thinking about it. IsomorphicGraphQ[VertexReplace[g1, Normal[#]], g1] & /@ isos // Counts <|True -> 64, False -> 56|> But I still think there are work-around to find the isomorphic graph.This is my solution. Find the permutation group all ...


3

input = {13 -> 7, 7 -> 0, 0 -> 16, 16 -> 2, 2 -> 15, 10 -> 5, 5 -> 12, 12 -> 18, 18 -> 15, 17 -> 18, 15 -> 6, 6 -> 8, 8 -> 4, 9 -> 8, 4 -> 19, 19 -> 11, 11 -> 1, 1 -> 20, 20 -> 3, 3 -> 4, 14 -> 19}; g = Graph[input, VertexLabels -> "Name"]; EdgeList[g, _?(ContainsOnly[ Function[...


2

options={VertexLabels -> Placed["Name",Center], VertexShapeFunction->"Square", VertexSize->.8, VertexStyle->Orange}; g1= Graph[Range[0,20], input, ##&@@options] junctions = VertexList[g1,_?((VertexOutDegree[g1, #] >= 2||VertexInDegree[g1, #] >= 2)&)]; sources = VertexList[g1, _?(VertexInDegree[g1,#] == 0 &)]; ...


6

Method 1 input = {13 -> 7, 7 -> 0, 0 -> 16, 16 -> 2, 2 -> 15, 10 -> 5, 5 -> 12, 12 -> 18, 18 -> 15, 17 -> 18, 15 -> 6, 6 -> 8, 8 -> 4, 9 -> 8, 4 -> 19, 19 -> 11, 11 -> 1, 1 -> 20, 20 -> 3, 3 -> 4, 14 -> 19}; g = Graph[input, VertexLabels -> "Name"] edge = IncidenceList[g, ...


7

Okay - never contributed before so I hope I don't screw up this answer. This will, I believe, do what you're looking for. It just finds all the "junctions" and then repeatedly contracts the nodes of degree 2 around each such junction until they're all gone. reduce[g,v] removes the degree 2 vertices around vertex v and reduce[g] applies that to all the ...


1

Delete all vertices of degree = 2: g = RandomGraph[{20,30}, VertexLabels-> "Name"]; myVertexDegrees = VertexDegree[g, #] & /@ VertexList[g]; vertexestoremove = Flatten@Position[myVertexDegrees, 2]; mygraph = VertexDelete[g, vertexestoremove]; Graph[mygraph, VertexLabels -> "Name"]


3

g1 = Graph[{Dog -> Apple, Apple -> Screwdriver}, VertexLabels -> "Name", GraphLayout -> "CircularEmbedding", ImagePadding -> 40] g2 = GraphComplement[UndirectedGraph[g1], VertexLabels -> "Name", ImagePadding -> 40, VertexCoordinates -> GraphEmbedding[g1]] Using GraphPlot GraphPlot[AdjacencyMatrix[g2], ...



Top 50 recent answers are included