Hot answers tagged

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 = ...


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, ...


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 ...


6

The RegionDifference and RegionMeasure functions can be parlayed into a function that looks at whether a given line segment lies inside a given region of a plane. Basically, you use RegionDifference to find a representation of the part of each line segment that lies outside the polygon, and then use RegionMeasure to calculate its length. If the result is ...


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, ...


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 ...


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

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


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 -...


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, ...


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[...


3

This code is not as pretty as Michael Seifert's, but I think it runs a bit faster. Essentially, when looking at any two vertices, we first decide whether the line connecting them is part of the polygon boundary. If so, that is an edge to the graph. If not, we look at the length of the line that is inside the polygon, and if it is equal to the total length ...


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], ...


2

SeedRandom[5] pts = RandomReal[1, {6, 2}]; pts = pts[[FindShortestTour[pts][[2]]]]; am = RandomChoice[{.7, .3} -> {0, 1}, {6, 6}]; AdjacencyGraph using the polygon vertices as vertex coordinates: Labeled[AdjacencyGraph[am, VertexCoordinates -> pts, DirectedEdges -> False, Vertexlabels->"Name", Prolog -> {Yellow, ...


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 ...


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 &)]; ...


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

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 ...


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"]


1

Here's an example where the adjacency matrix shows a link from pt[[1]] to pt[[4]] and from pt[[2]] to pt[[3]]: pts = {{0, 0}, {0, 1}, {1, 1}, {1, 0}}; adMat = {{0, 0, 0, 1}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 1, 0, 0}}; myfig = Graphics[ {{Opacity[0.2], Yellow, Polygon[pts]}, {Red, PointSize[0.02], Point[pts]}, Line@({pts[[#1]], pts[[#2]...


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[...



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