New answers tagged

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


5

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, VertexList[g, ...


5

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


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


1

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


0

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


5

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


2

If you don't want to import the graph into some other application, but simply save it for later use, I've found that just saving the graph in .m format preserves everything just fine: Export["graph.m", graph] This is the only approach I've found that preserves property lists, labels, everything.


1

Get vertex names: Pick[VertexList[g], VertexDegree[g], n] Get vertex indices: Pick[Range@VertexCount[g], VertexDegree[g], n]


2

As mentioned by JM in his comment, here's how you would find the vertex index of vertices of degree 5 in the following graph: g = GraphData[{"Fan", {4, 4}}]; VertexDegree[g] (* {5, 6, 6, 5, 4, 4, 4, 4} *) Flatten@Position[VertexDegree[g], 5] (* {1, 4} *) The Flatten is there to provide the output format you indicated, ...


5

Are you looking for something like the following? How big are your graphs? First graph from the question pinds = Permutations[Range[3], {3}]; MatrixPlot /@ Union[a1[[#, #]] & /@ pinds] AdjacencyGraph[#, VertexLabels -> "Name"] & /@ Union[a1[[#, #]] & /@ pinds] Larger "seed" graph Here is another example: graphRules = {1 <-> ...


3

@AntonAntonov's answer with the TriesWithFrequencies.m package is more elegant and useful, but here is a brute force approach without any extra packages. (Note: This approach finds all simple paths including dead ends, see comments for more details. Edited to process more general graphs with more than 10 vertices.) The main challenge is that the final ...


3

How i can generate and visualize tree graph, showing me all simple paths (and deadlocks) from vertice A to vertice B? This answer has a brute force solution and I have not tested it extensively. At least the visualization of the result tree graph should be useful. Creating the graph graphRules = {1 <-> 2, 1 <-> 4, 1 <-> 5, 2 ...


2

ClearAll[f] f = With[{g = #, vl = VertexList[#], pvl = Permute[ VertexList[#], GraphAutomorphismGroup[#]]}, SetProperty[VertexReplace[g,Thread[vl->#]], VertexLabels -> "Name"]& /@ pvl]&; g = Graph[{1 -> 2, 2 -> 3, 3 -> 1, 4 -> 1, 1 -> 5, 5 -> 4}, VertexLabels -> "Name"] Row[f @ g} Row[f @ ...


5

Let's take the example from the CommunityGraphPlot documentation, g = ExampleData[{"NetworkGraph", "DolphinSocialNetwork"}] CommunityGraphPlot@g At first I thought I would try to replicate what CommunityGraphPlot is doing, using the information from FindGraphCommunities HighlightGraph[g, Map[Subgraph[g, #] &, FindGraphCommunities@g]] But that ...


2

The issue here is that for IncidenceMatrix The vertices $v_i$ are assumed to be in the order given by VertexList[g] and the edges $e_j$ are assumed to be in the order given by EdgeList[g]. So let's look at the order of the vertices in your graph, g = Graph[{1 \[DirectedEdge] 2, 2 -> 4, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 4, 4 \[DirectedEdge] ...


5

As @Szabolcs suggested I have created my own shortest path finder, based on Dijkstra's algorithm, which allows me to use an EdgeWeightFunction. It's pretty much a translation of the pseudocode on the wiki and I include it below. First I'll demonstrate its use. Example Use The code to generate the two graphs, g1 and g2 in my post above: edges = {1 -> 2, ...


6

We can reproduce the problem in a simpler example: g = Graph[{{1}, {2}}, {{1} <-> {2}}] HighlightGraph[g, {{1}, {2}}] HighlightGraph invokes the function GraphComputation`GraphHighlightDump`vertexEdgeExtract to get the list of vertices and edges to be highlighted. For the example above, this function returns {1,2} as the list of vertices to be ...


6

This is clearly a bug, which appears when the the vertex names are lists. You should report it to Wolfram Support: http://support.wolfram.com/ I can reproduce it with version 10.4.1. Proof that lists as vertex names are reasonable: some functions return such graphs. Example: pts = RandomInteger[{1, 5}, {10, 2}]; g = NearestNeighborGraph[pts] ...


5

As I mentioned in the comment, what you probably need is SetOptions. For example, SetOptions[CycleGraph, VertexLabels -> "Name"]; CycleGraph[5] To make this work automatically, either add it to init.m, or (more portable) make the first cell above an InitializationCell. Of course, you can do the same SetOptions for other commands too, not just ...


5

g = ℱ["FlowGraph"]; SetProperty[RemoveProperty[g, DeleteCases[PropertyList[g], GraphLayout]], GraphStyle -> "SmallNetwork"] What is happening: GraphStyle >> Details says: Direct settings of any of Graph options override base settings provided by GraphStyle. And, as can be seen using PropertyList[ℱ["FlowGraph"]] ...


5

SeedRandom[5] g = RandomGraph[{6, 10}] vd = Thread[VertexList@g -> Normalize[VertexDegree@g, Total]]; g2 = SetProperty[g, VertexSize -> vd]


9

You just need to wrap First around ConnectedComponents because the later sorts components by number of vertexes: SeedRandom[1]; g = RandomGraph[{200, 130}]; HighlightGraph[g, Subgraph[g, First[ConnectedComponents[g]]]]


8

Alternatively, one can use AbsoluteOptions[] to extract the coordinates: g = RandomGraph[{20, 40}]; coords = VertexCoordinates /. AbsoluteOptions[g, VertexCoordinates]; You can verify that coords === GraphEmbedding[g] gives True.


4

Slightly more cumbersome alternative to your sp (hopefully little less tedious to use): ClearAll[mapF] mapF[pr1_ -> pr2_][g_] := SetProperty[g, pr1 -> Cases[Options@g, Rule[a_, {___, Rule[pr2, v_], ___}] :> Rule[a, v], Infinity]]; mapF[r : (_ -> _) ..][g_] := Fold[mapF[#2][#] &, g, {r}]; g3 = g // mapF[VertexLabels -> "name"] g4 ...


1

Oddly, technical support at $Mathematica$ was unable to reproduce the issue, though @Xavier and I were both able. They asked me to try a clean start, but the crash still occurred. I've sent my SystemInformation[], and this issue is being tracked under CASE:3588559. The technician's last comments: I have filed a report with our developers which includes ...


2

Yes, there is EdgeQ: g = Graph[{1 -> 2, 2 -> 3, 3 -> 1}, VertexShapeFunction -> "Name"] {EdgeQ[g, 1 -> 2], EdgeQ[g, DirectedEdge[1, 2]], EdgeQ[g, 1 <-> 2], EdgeQ[g, UndirectedEdge[1, 2]], EdgeQ[g, 2 -> 1], EdgeQ[g, DirectedEdge[2, 1]]} {True, True, False, False, False, False} If you need a function that takes a list of ...


1

plot = Plot[x Sin[1/x], {x, -1/2, 1/2}, PlotStyle -> {Red}, ImageSize -> {500}, Frame -> True, Axes -> None] smallplot = Plot[x Sin[1/x], {x, -1/10, 1/10}, PlotRange -> {{-0.02, 0.02}, {-0.02, 0.02}} , PlotStyle -> {Red}, Frame -> True, Axes -> None] Now you can combine these plot ...


3

You can use GraphDistance to do that: g = Graph[{1 <-> 2, 2 <-> 3, 3 <-> 1, 1 <-> 4}]; GraphDistance[g, 2, 3] GraphDistance[g, 2, 4] (* 1 *) (* 2 *)



Top 50 recent answers are included