Tag Info

Hot answers tagged

10

Update: obviously incorrect statements are removed. I think WM doesn't include DualGraph-function because it is usually multigraph and non unique. As far as I have read in Wikipedia a dual graph $G^*$ depends on planar embedding of $G$. If you ask for a some dual graph for a given graph, then here is my brute force heuristic algorithm. It is based on ...


7

It seems that the following doesn't work on v9. It does work on v8 and v10. Here is what I propose based on this: rule = {0 -> 1, 1 -> 2, 2 -> 3, 0 -> 1, 1 -> 4, 4 -> 5, 0 -> 2, 2 -> 4, 4 -> 6, 0 -> 3, 3 -> 7, 7 -> 9, 0 -> 6, 6 -> 8, 8 -> 9, 1 -> 2, 2 -> 7, 7 -> 8, 1 -> 3, 3 -> 6, ...


7

An alternative method to WReach's method is to use SparseArray`ExpressionToTree which produces the same output without string wrappers: expr = a[b[c, d[e][f], g], h]; ett = SparseArray`ExpressionToTree[expr] (* {{a,0,a[b[c,d[e][f],g],h]}->{b,1,b[c,d[e][f],g]}, {b,1,b[c,d[e][f],g]}->{c,2,c}, {b,1,b[c,d[e][f],g]}->{d[e],3,d[e][f]}, ...


7

Here is a direct approach w/o the graphics/graph functions. Algorithm: create an array with every '1' changed to a unique number (pad zeros around array to avoid dealing with edge issues ) loop over nonzero entries. If any of the four neighbors (on further thought you may only need to look left & down) swap indices to match - this is a global ...


7

Not nearly as clean as @rm -rf's solution, but here is another image processing solution. Once again m is taken to be the matrix above. mc=MorphologicalComponents@m; Max@Tally[Join @@ mc][[2 ;;, 2]] (*27*) If one wishes to vizualize the exact path: p1=ArrayPlot[mc /. Rule @@@ Rest[Tally[Join@@mc]], Mesh -> All]; (* paths color-coded by length *) ...


6

You can find the code for the function in the file Combinatorica.m: nb = NotebookOpen[ToFileName[{$InstallationDirectory, "AddOns", "Packages", "Combinatorica"}, "Combinatorica.m"]]; NotebookFind[nb, "ListGraphs[n_Integer?Positive, m_Integer]"]


6

The reason for this behaviour is that as soon as the cursor gets away from a particular vertex marker it leaves the associated EventHandler. Here's a work-around, let's associate the event handler with the whole Graph. We just need to take care of updating the proper pos. DynamicModule[{ind = 1, pos1 = {1, 0}/2, pos2 = {1, 1}/2, pos3 = {-1, 0}/2}, ...


5

Look up HighlightGraph. HighlightGraph[ CompleteGraph[5], EdgeList@CycleGraph[5] ] (This solution is based on the accidental fact that CompleteGraph and CycleGraph name and connect the vertices in the same order, i.e. 1--2--3--4--5--1)


5

Mathematica 10 now supports multigraphs, so you can simply use FindEulerianCycle. Here's an example run in Wolfram Cloud using a free account:


4

You could convert your graph to directed graph by doubling your edge and give directions (opposite each other): g = Graph[{1 <-> 2, 1 <-> 3, 2 <-> 3, 2 <-> 4, 3 <-> 4}]; dg = DirectedGraph[g] path = FindEulerianCycle[dg][[1]] {1 [DirectedEdge] 2, 2 [DirectedEdge] 1, 1 [DirectedEdge] 3, 3 [DirectedEdge] 2, 2 ...


4

Using Daniel Lichtblau's prim algorithm code : (* fake some points *) n = 10; pts = RandomReal[{0, 50}, {n, 2}]; tree = Prim[pts]; Graph[Range@n, UndirectedEdge @@@ tree[[2]], VertexCoordinates -> pts, VertexLabels -> "Name", ImageSize -> 500] Here's your points from your update (I left out labels - image needs to be large so they don't ...


4

Although kguler posted an answer using a nice internal function that does this (almost) directly I find this kind of expression manipulation interesting in itself so I'm going to see what can be done without it. expr = a[b[c, d[e][f], g], h]; edges = Reap[Replace[expr, h_[___, c_[___] | c_?AtomQ, ___] /; Sow[h -> c] :> 1, {0, -1}]][[2, 1]]; ...


4

This is an interesting question and I await better answers than mine which is just some musings: Some functions to visualize and decide if an edge labeling is harmonious: hlab[list_] := Graph[UndirectedEdge @@@ list, EdgeLabels -> Thread[UndirectedEdge @@@ list -> (Mod[Total@#, Length@list] & /@ list)], EdgeLabelStyle -> ...


4

The term incidence matrix has caused confusion on this site before, so I think it's time to clear this up. There's no standard, generally agreed upon definition of incidence matrix. It's a loose term for a matrix that describes the relationship (connections) between two different classes of objects. What these objects are can vary. When you see the term ...


4

As an addendum to @ubpdqn's answer, this is an attempt to tackle the problem in a slightly less brute-force way. The idea is to make use of the symmetry of the graph in question. In the end we'll obtain all the harmonious labelings that are not related to each other via the symmetry of the graph. Note that this approach is only less brute-force for graphs ...


3

Sorry, but your matrices aren't valid incidence matrices. From the IncidenceMatrix help page: For an undirected graph, an entry $a_{ij}$ of the incidence matrix is given by: 0 if vertex $v_i$ is not incident to edge $e_j$ 1 if vertex $v_i$ is incident to edge $e_j$ 2 if vertex $v_i$ is incident to edge $e_j$ and a self-loop In ...


3

blocks = {{0, 1, 2, 3}, {0, 1, 4, 5}, {0, 2, 4, 6}, {0, 3, 7, 8}, {0, 5, 7, 9}, {0, 6, 8, 9}, {1, 2, 7, 8}, {1, 3, 6, 9}, {1, 4, 7, 9}, {1, 5, 6, 8}, {2, 3, 5, 9}, {2, 4, 8, 9}, {2, 5, 6, 7}, {3, 4, 5, 8}, {3, 4, 6, 7}}; edglst = {0 -> 1, 1 -> 2, 2 -> 3, 0 -> 1, 1 -> 4, 4 -> 5, 0 -> 2, 2 ...


3

I post this for illustrative purposes based on the title of the question (which is somewhat ambiguous). I agree as Szabolcs advice re: looking at documentation, which is good. Here are some motivating examples: Your example: another way (exploiting Szabolcs observation): cg = CompleteGraph[6]; el = EdgeList[cg]; path = EdgeList[CycleGraph[6]]; ...


3

Using the undocumented function SparseArray`ExpressionToTree expr = 1 + Sin[x^2]; ett = SparseArray`ExpressionToTree[expr]; (* {{Plus,0,1+Sin[x^2]}->{1,1,1}, {Plus,0,1+Sin[x^2]}->{Sin,2,Sin[x^2]}, {Sin,2,Sin[x^2]}->{Power,3,x^2}, {Power,3,x^2}->{x,4,x}, {Power,3,x^2}->{2,5,2}}*) edges = ett[[All, All, 1]]; (* ...


3

Kuba's answer is brilliant, but it has a rather ugly bit in it with a lot of unnecessary fooling around with Hold and ReleaseHold in order to make assignment to variables. As is so often the case with Mathematica, this fooling around with variables can be eliminated by working with a list, so I have reworked Kuba's answer to keep the vertex coordinates in a ...


3

There are already several really good answers. I simply want to point out that this can be cast as using Graph in a way that is explicitly quite efficient. The steps are as follows. (1) Make positions corresponding to 1 into vertices. (2) Find immediate neighbors and make all pairs into edges. (3) Create a Graph object with the above data and ...


3

The test matrices are matrices but not incidence matrices. The rows represent the vertices and each column represents an edge. Consequently each column must have only 2 non-zero entries or a single entry of 2 for self loops. This is not the case for any of the matrices or their transposes. To check for yourself, try yourself, e.g.: mat = ...


3

The answer why it is not valid incidence matrix is given by the above answers. To verify if your matrix is valid, use the following command m = {{1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0}, {1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1}, {0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0}, {0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 0, ...


2

I have no idea why Export is slow. The graph g = RandomGraph[DegreeGraphDistribution[Table[8, {10000}]]]; has 10k vertices, and 40k edges. On my machine, Timing[Export["g.col", g]] requires 10.822373 seconds. I wrote a very quick & naive function for writing the same graph to a file: WriteGraph[g_, filename_] := Module[{}, L = EdgeList[g]; ...


2

Instead of trying to hide them, I recommend removing them. comps = Flatten@DeleteCases[ConnectedComponents[g], {_}] (* {1, 2, 3, 4} *) Subgraph[g, comps]


2

One way to approach this problem is through Tutte's spring embedding theorem. Pick one face as outer, embed the remaining graph in the planar region inside using Tutte's theorem, and then lift into 3D. Note that there is in general a continuum of polyhedra all of which realize the same polyhedral graph. This paper offers a new and simpler proof of Tutte's ...


2

In Mathematica 10, we can use Graph3D: Graph3D@RandomGraph[{20, 50}]


1

Version 10 supports graphs with mixed directed and undirected edges. g = CayleyGraph[DihedralGroup[4]] newEdges = Flatten[ GatherBy[EdgeList[g], Sort] /. {{a_ \[DirectedEdge] b_, _} :> {a <-> b}} ] e = GroupBy[newEdges, Head] g2 = Graph[newEdges, EdgeStyle -> Catenate[Thread /@ {e[UndirectedEdge] -> Red, e[DirectedEdge] -> Blue}]] ...


1

You can use the new FindPath function that comes with Mathematica 10. A simple example: g = CompleteGraph[4]; FindPath[g, 1, 2, Infinity, All] (* Output: {{1,2},{1,4,2},{1,3,2},{1,4,3,2},{1,3,4,2}} *) The function also accepts parameters, so you can find a path (or all paths) of specific length. See the docs for more.


1

It looks like you want to make an edge rendering function: http://reference.wolfram.com/mathematica/ref/EdgeRenderingFunction.html



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