Hot answers tagged

18

Here is a solution I can think of. Idea is to take the FullPolygon of a given country and then triangulate the region. Once that is done take the underlying Graph and do a FindShortestPath. Result will not be too bad. fullPoly = CountryData["Vietnam", "FullPolygon"]; pts = Flatten[fullPoly[[1, 1]], 1]; line = Polygon[Range[##]] & @@@ Partition[{1}~Join~ ...


17

Edit: getting rid of FilledCurve to speed things up. Here's something fun: g = Normal @ Show @ CommunityGraphPlot[ ExampleData[{"NetworkGraph", "DolphinSocialNetwork"}] ]; dist = Normalize[#] (2./Pi ArcTan[Norm[5 #]]) &; DynamicModule[{drag,pts,prims} , pts = Union@Cases[g, {_?NumericQ, _?NumericQ}, \[Infinity]]; prims = ( First[g] ...


17

You can do this using Show and PlotRange which can be used in combination with graphs. To determine the full PlotRange of the original Graph you could use AbsoluteOptions to determine the values of the VertexCoordinates of the graph. The function CoordinateBoundingBox, introduced in V10.1, is helpful here: SeedRandom[1110]; g = RandomGraph[{70, 200}] ...


8

Normal[# /. a : Arrow[{__List}, Except[_List]] :> Thread @ a] gives a quick fix for these examples.


7

Quick summary The IGraph/M package has several functions to help with this (IGRewireEdges). The rewired network will not have the small world property unless the starting grid connects at least second neighbours as well. IGraph/M has a function to generate such a starting grid (IGMakeLattice). Easiest is to use IGraph/M! While this can be implemented ...


7

i = RemoveAlphaChannel@Import@"http://i.stack.imgur.com/k8KCQ.png"; cs = ColorSeparate@i; vxs = Binarize@ImageSubtract[cs[[1]], cs[[2]]]; vxPos = ComponentMeasurements[vxs, "Centroid"][[All, 2]]; rad = ComponentMeasurements[vxs, "EquivalentDiskRadius"][[All, 2]] // Mean // Ceiling; graph = SelectComponents[ColorNegate@Binarize@i, "Area", ...


6

You can also use FindHamiltonianCycle. To convert Hamiltonian path problem to Hamiltonian cycle problem, just add one vertex and connect it to all other vertices. After that just run FindHamiltonianCycle[g, All] For example, countHamiltonianPaths[g_] := Length[ FindHamiltonianCycle[ AdjacencyGraph[PadRight[AdjacencyMatrix[g], (VertexCount[g] + ...


6

No, this is not a bug in VertexDelete. Some background first: TreePlot, along with GraphPlot, is an old function that predates the introduction of Graph objects. Consider it deprecated that is only kept for backwards compatibility. The proper way to display vertex labels for a Graph object is g = CompleteKaryTree[5, DirectedEdges -> True, ...


4

Set a graph with properties: g = Graph[{Property[1, "Custom" -> {3700, "h1"}], Property[2, "Custom" -> {3700, "h2"}], Property[3, "Custom" -> {3700, "h2"}]}, {1 <-> 2, 2 <-> 3, 3 <-> 1}]; Define labels: labels = # -> Placed[ToString[PropertyValue[{g, #}, "Custom"], InputForm], StatusArea] & /@ ...


3

Check GraphData. Get a list of names with this command: Intersection[ GraphData["Planar"], GraphData["Traceable"] ] Apply GraphData to a name to get the graph.


3

For example (Partial order here is vertex reachability) SeedRandom@42; << Combinatorica` g = System`RandomGraph[{9, 7}, VertexLabels -> "Name"]; g1 = System`Graph[VertexList@g, DirectedEdge @@@ EdgeList@g]; ShowGraph[ HasseDiagram[ MakeGraph[VertexList[g1], GraphDistance[g1, #1, #2] =!= Infinity &]], VertexNumber -> ...


2

framedWithColor[color_] := Function[{position, label}, {Text[Framed[label, Background -> color], position]} ]; TreeForm[ {{1, 2}, {3, 4}}, VertexRenderingFunction -> framedWithColor[Pink] ]


2

There is no bug. Vertices 11 and 12 were indeed deleted from a. a = CompleteKaryTree[5, DirectedEdges -> True]; VertexList@a {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31} c = VertexDelete[a, {11, 12}]; VertexList@c {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 13, 14, 15, 16, 17, 18, ...


2

This is the same basic algorithm but in my own style. It runs only about twice as fast as yours, but hopefully it will be of interest anyway. The recursive function count maintains the current vertex, the adjacency list $a$ and a counter $i$. At each call the current vertex is removed from the adjacency list and the function recursively scanned over the ...


2

A possible solution: RandomBipartiteGraph[m_, n_, e_] := Graph[Range[m + n], RandomSample[Flatten@Table[i <-> j, {i, m}, {j, m + 1, m + n}], e]] But I wonder if I can do it with some of Mathematica built-in graph generator functions? Also, this is very slow if $m$ or $n$ are large. I am generating the list of all posible edges, which is a big ...


2

This is not an answer, but an extended comment. Dr.belisarius' answer, given in comment to the question, looks promising, but it can produce loops, Is this admissible? SeedRandom[1]; With[{g = GridGraph[{20, 20}]}, EdgeAdd[ EdgeDelete[g, #], Thread[UndirectedEdge[#[[All, 1]], RandomChoice[VertexList @ g, Length @ #]]]]& @ Pick[ ...


2

If you need to do computation on the graph, and/or your graph is very large- working with a SparseArray and an AdjacencyGraph may prove the most beneficial. Here is a random list which can resemble your data: randomVals = Table[{RandomInteger[10], RandomInteger[20]}, 100]; Now we obtain a list of all the values in the list: keys = ...


1

Here is my fast entry: randomBipartiteGraph[m_, n_, e_] := Module[{edges, mat}, edges = ConstantArray[1, e] ~Join~ ConstantArray[0, m*n - e]; mat = Partition[RandomSample[edges], m]; AdjacencyGraph@ArrayFlatten[ {{0, Transpose[mat]}, {mat, 0}} ] ] Graph[randomBipartiteGraph[10, 20, 80], GraphLayout -> "BipartiteEmbedding"] Here ...


1

This might be deprecated functionality, but it used to work: << GraphUtilities` GraphEdit[]


1

This is a bit extra as there is the sidebar having the commented urls linked but they may get deleted if the comments deleted so gathering all useful material in comments below. Relevant topics Generating graphs interactively with GUI in Mathematica How to add new nodes to an existing graph with fixed (coordinates) nodes? Dupes Possible to manipulate ...



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