Tag Info

New answers tagged

3

No, the CelluluarAutomaton command works is specifically designed to model cellular automata on grids. It's certainly feasible to roll your own, though. Your example using GraphPlot3D I generated the following graph using your code. rules = {1 -> 5, 1 -> 1, 1 -> 8, 1 -> 6, 1 -> 2, 2 -> 5, 2 -> 2, 2 -> 7, 2 -> 7, 2 -> 5, 3 ...


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


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


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


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

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


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


0

I think you're right about BipartiteMatchingAndCover returning a maximal matching. Instead of reciprocals, use negatives: Needs["Combinatorica`"] g = Combinatorica`CompleteGraph[3, 3]; edgeWeights = {{53, 96, 37}, {47, 87, 41}, {60, 92, 36}}; g1 = Combinatorica`SetEdgeWeights[g, -Flatten[edgeWeights]]; Combinatorica`BipartiteMatchingAndCover[g1] ...


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


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


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


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


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.


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


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)


1

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


2

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


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


1

If you are just asking how to reproduce your code more compactly/parametrically, you can use RandomInteger to produce a list of integers then rearrange. For now let's just use n = 5. We can generate the rules by creating two long lists and then threading them together. Here's the list of left-hand sides (of the rules): nodes = Sort@Flatten@Table[Range@8, ...


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


1

You could extract adjacency matrix and export it. g = RandomGraph[DegreeGraphDistribution[Table[8, {10000}]]]; Export["g.col", AdjacencyMatrix[g]] It will ignore vertex names, but it's not supported in DIMAC any way.


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]]; (* ...


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


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


-1

I think the easiest solution is to just solve for the single traversal and then just reverse it. You should cover each edge exactly once on your "trip back" and wind up where you originally started. Then you don't need to double any edges or anything (which I imagine would greatly increase the complexity as n gets bigger and bigger.


0

Is this what you are seeking? expr = a[b[c, d[e][f], g], h] boxes = ToBoxes@TreeForm[expr] positions = Cases[boxes, LineBox[{x__}] -> x, Infinity] nodes = Cases[ boxes, StyleBox[x_, __] :> ToExpression@x, Infinity] /. {t_Times :> First@t, Verbatim[HoldForm][x_] -> x} Rule @@@ Extract[nodes, List /@ positions] {a -> b, a -> ...


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


1

On the Wikipedia page for connected-component labeling a couple of algorithms are explained that probably are similar to what the component image processing functions are doing. Although I'm not really satisfied with the code, I'll go ahead and post an implementation of the two-pass algorithm, since it seems to be pretty popular for this task. ...


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


1

I post this (it was an approach to a New York Times NumberPlay). Note there are major scaling issues for this (Hamiltonian cycles). Apologies if this is unhelpful. Some examples: f[k_, n_] := (k!)^k^(n - 1)/k^n fun[alpha_, n_] := Module[{t, g, gp}, t = Tuples[alpha, n]; g = Map[Function[x, {#, Take[Join[#, {x}], -n]}], alpha] & /@ t; gp = ...


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


1

An idea for a workaround, but the Permutations is pretty inefficient and quickly burns through memory. Any ideas how to improve this? DeBruijnGraph[3, 1] // EdgeList Cases[ Permutations[List @@@ %], x_ /; x[[;; -2, 2]] == x[[2 ;;, 1]]]; NestWhile[ RotateLeft, #, First@# != {1, 1} &] & /@ % // DeleteDuplicates; Apply[DirectedEdge, %, {2}] ...


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



Top 50 recent answers are included