Tag Info

New answers tagged

1

AdjacencyGraph[{{0, 1, 0, 1}, {0, 0, 1, 1}, {1, 0, 0, 1}, {1, 1, 1, 0}}, VertexLabels -> "Name"] If you wish to input the matrix interactively: Print["number of vertexes"]; n = Input[]; a = Table[Input[], {i, 1, n}]; AdjacencyGraph[a, VertexLabels -> "Name"] Then if, when prompted, you input $3$ for the number of vertexes, you'll be ...


0

This seems bugged still in 10.0.0.0. I have no idea if it has been fixed in newer versions. If you are forced to live with the buggy function, here's a brute-force method that should work correctly (but is only usable for small graphs as it generates all subsets of vertices). g = Graph[{2 <-> 4, 4 <-> 5, 5 <-> 6, 4 <-> 6, 3 <-> ...


1

First, let us find all cycles in the graph. Then, we will filter out the ones that contain chords; this we can detect by checking if the $n$-vertex induced subgraph is isomorphic to a cycle of length $n$ or not. Let us use your graph as an example: g = Graph[{1 <-> 2, 1 <-> 3, 2 <-> 4, 4 <-> 5, 5 <-> 6, 4 <-> 6, 6 ...


1

First, observe a maximal independent set (note the term maximal, not maximum) is also a dominating set in a graph. A maximal independent set of a graph is equivalent to a maximal clique of its complement. This suggests a straightforward algorithm: MinimumDominatingSet[g_] := First@MinimalBy[FindClique[GraphComplement[g], Infinity, All], Length]; In a ...


2

No. Not Natively. gephiexports = {"CSV", "GDF", "GEXF", "GraphML", "Pajek", "XLS","PDF", "SVG"}; Intersection[gephiexports, $ExportFormats] (* {"CSV", "GraphML", "Pajek","PDF", "SVG", "XLS"} *) GEXF is an XML based format so you may be able to crib a parser in Mathematica if you really want to. Update Gephi's website is somewhat contradictory on ...


0

car = Graphics[{Scale[{RGBColor[0.25, 0.63, 0.85], Polygon[... Epilog -> {{Dashed, Line[{{x, 42}, {x, y}}], Line[{{20, y}, {x, y}}]}, {AbsolutePointSize[32], Inset[car, {x, y}]}}


0

You can do this with the following code: points = {1, 2, 4, 6, 3, 8, 5, 7}; edges = {1 <-> 2, 1 <-> 4, 1 <-> 6, 3 <-> 4, 3 <-> 6, 3 <-> 8, 5 <-> 6, 5 <-> 8, 5 <-> 2, 7 <-> 8, 7 <-> 2, 7 <-> 4}; tmp=Table[FindIndependentEdgeSet[Graph[i, edges]], {i,Permutations[points]}]// ...


2

Just supply vertices when you define graph: With[{coords = Most@With[{n = 23, \[Theta] = LambertW[1]}, N@(Table[{{Re[E^(I \[Theta])], -Im[E^(I \[Theta])]}, {Im[ E^(I \[Theta])], Re[E^(I \[Theta])]}}.{Re[ E^(I (1 + 2 \[Pi] ii/n))], Im[E^(I (1 + 2 \[Pi] ii/n))]}, {ii, Join[{n}, Range[n]]}])]}, ...


2

The vertex coordinates are applied to the vertexes in the order they are given, including the target nodes. Therefore 3 ends up before 2 and takes its position. A way to correct your layout: coords = Most@ With[{n = 23, θ = LambertW[1]}, N@(Table[{{Re[E^(I θ)], -Im[E^(I θ)]}, {Im[E^(I θ)], Re[E^(I θ)]}}.{Re[E^(I (1 + 2 π ii/n))], ...


3

You can use Graph[DirectedEdge @@@ RandomSample /@ List @@@ EdgeList@CompleteGraph[n]] Let's break it down: EdgeList gives you the edge list List @@@ is used to convert each directed edge a <-> b to a list of pairs {a, b}. See also Apply. RandomSample[{a,b}] returns a and b in random order. See also Map. Then we convert them back to directed ...


0

Transforming the adjacency matrix is a viable solution. Let m be an n*n two-dimensional adjacency matrix for the complete graph (ones at every off-diagonal element, zeroes on the diagonal). This snippet of code should work: Do[Do[{m[[i,j]],m[[j,i]]}=RandomChoice[{{0,1},{1,0}}],{i,1,j-1}],{j,2,n}] The two nested Do functions cycle through all matrix ...


4

You can compute the chromatic index of a graph by first observing it is equivalent to the chromatic number of the line graph of the graph. This immediately suggests straightforward algorithms: ChromaticNumber[g_] := MinValue[{z, z > 0 && ChromaticPolynomial[g, z] > 0}, z, Integers]; ChromaticIndex[g_] := ChromaticNumber[LineGraph[g]]; Notice ...


1

Just for fun, I have just used brute force but not as elegantly as Karsten 7 and I am too time poor to cull labeling that are just reflections etc. The graph layout just for visualization out of laziness but isomorphic to graph. g = {1 <-> 2, 1 <-> 3, 2 <-> 3, 4 <-> 2, 4 <-> 3, 2 <-> 5, 5 <-> 6, 4 <-> 6, 6 ...


3

A simple brute-force solution for the interpretation of this problem given in the comment by rasher: fun := Abs@Flatten@ Differences[{{#1, #2}, {#1, #3}, {#2, #3}, {#2, #4}, {#2, #6},{#2, #5}, {#3, #4}, {#3, #6}, {#3, #7}, {#6, #5}, {#6, #7}, {#4, #6}} /. {{4, 5} -> {0, 2}, {5, 4} -> {0, 2}}, {0, 1}] & Select[Permutations[Range@7], ...


2

vlabels = Join[{1 -> Placed[Style[Subscript["S", ToString@1], 18], Center]}, # -> Placed[{Style[Subscript["S", ToString@#], 18], Style[Subscript["y", ToString@#], 14]}, {Center, Above}] & /@ Range[2, 5]]; elF = Property[#, {EdgeStyle -> Directive[Opacity[1], Arrowheads[Large],Blue], EdgeLabels -> ...



Top 50 recent answers are included