Tag Info

New answers tagged

1

If you go up two levels in the url's hierarchy, you can find a copy of the bayesian network library. Graphical models http://cs.brown.edu/research/ai/dynamics/tutorial/Documents/GraphicalModels.html tutorials including notebooks for most of the topics. http://cs.brown.edu/research/ai/dynamics/tutorial/home.html


6

You need to write function to set new coord and new edge shape function. Here's one example to do such things: mergeVertex[g_, set_List] := Block[{vcoord, ids, ncoord, ng, newv, nedge, endp, oedge, pind, neshape}, vcoord = GraphEmbedding[g]; ids = {VertexIndex[g, #]} & /@ set; ncoord = Join[Delete[vcoord, ids], {Mean[Extract[vcoord, ...


2

Here is one possible way to do it: L1 = {{1, 2}, {1, 3}, {1, 4}}; L2 = {{1, 2}, {1, 3, 2}, {1, 4, 3, 2}}; Outer[Boole[#1 == #2[[{1, -1}]]] &, L1, L2, 1] which produces $$\left( \begin{array}{ccc} 1 & 1 & 1 \\ 0 & 0 & 0 \\ 0 & 0 & 0 \\ \end{array} \right),$$ which shows that the computation of L2 is redundant, since the ...


5

Not to detract from PatoCriollo's excellent answer, but just to show that there is always a "there is also...". Furthermore, the following, to my surprise, is not as fragile as I thought it might be with respect changes in ImageSize and in the vertex count of CompleteGraph. vc = GraphEmbedding[CompleteGraph[26]]; g = Graph[EdgeList@CompleteGraph[26], ...


6

g = Graph[CompleteGraph[26], VertexLabels -> Table[i -> Placed["Name", {{0,0}, {-Cos[Pi/2 + 2 i Pi/26], .25 - Sin[Pi/2 + 2 i Pi/26]}}], {i, 26}]]


2

You can use UndirectedGraph directly for your graph problem list = {"A" -> "B", "B" -> "A", "C" -> "D"}; Graph[list, VertexLabels -> "Name"] g = UndirectedGraph[Graph[list], VertexLabels -> "Name"] EdgeList[g]


1

You can also use an Orderless function foo. In matching patterns with Orderless functions, all possible orders of arguments are tried. list = {"A" -> "B", "B" -> "A", "C" -> "D"}; SetAttributes[foo, Orderless]; Rule @@@ DeleteDuplicates[foo @@@ list] (* or DeleteDuplicates[foo @@@ list] /. foo -> Rule *) (* or DeleteDuplicates[list ...


6

Using ComponentMeasurements twice, on the original matrix m and on Transpose/@m we can get all Neighbors: mat = RandomInteger[{0, 1}, {3, 3, 3}]; m = Module[{i = 1}, mat /. 1 :> i++]; v = ComponentMeasurements[m, "Label"][[All, 1]] (*{1,2,3,4,5,6,7,8,9,10,11,12,13,14}*) vcoords = ComponentMeasurements[m, "Centroid"][[All, -1]] ...


6

Here is how it works. If you have a volume in 3d it is essential, that you use connected component labeling in 3d so that components that are connected over layers stick together and get the same label. Lucky for us that MorphologicalComponents can do this. Let's create a test volume data = With[{init = RandomChoice[{0, 0, 1}, {10, 10}]}, NestList[ ...


2

As Oska noted in the comments, adding the option CornerNeighbors->False in arrayGraph gives the desired result for 2D. (See also this answer to a different Q/A).. ClearAll[arrayGraph]; arrayGraph[mat_, opts : OptionsPattern[]] := Module[{m = Module[{i = 1}, mat /. 1 :> i++], edges, vcs, v}, v = ComponentMeasurements[m, "Label"][[All, 1]]; vcs = ...


2

Try this: graphList = {{1, 2}, {1, 3}, {1, 4}, {2, 5}, {3, 6}, {4, 7}} Graph[UndirectedEdge @@@ graphList, GraphLayout -> "SpringElectricalEmbedding"] There are a couple layout methods available, but the ones you probably want to use are either "SpringElectricalEmbedding" or "SpringEmbedding". Both work by a minimization of an energy functional ...


1

With respect to my question, I was after the partitioning of 10 between 2 and 4 integers, so "ulvi" ans. helped. Show[FerrersDiagram[IntegerPartitions[10, {2, 4}]], Frame -> True, FrameLabel -> {Style["N", Large, Bold], Style["Level", Large, Bold]}, RotateLabel -> True, LabelStyle -> Directive[Bold, Large]]


1

Argument should be a partition: FerrersDiagram[{1, 1, 2, 2, 4}]


1

graph1 = RandomGraph[{4, 5}]; RandomInteger[{2, 5}, {VertexCount@#, EdgeCount@#}] &@graph1 (* {{4, 3, 2, 3, 4}, {5, 3, 2, 4, 4}, {5, 3, 4, 4, 4}, {5, 5, 3, 4, 4}} *) You are missing a & in the last line of your code. With that fixed, ec = EdgeCount[graph1]; vertices = VertexList[graph1]; result = RandomInteger[{2, 5}, {ec}] & /@ vertices (* ...


0

I've managed to do some optimization of the code, using matrix operations instead of loops (or tables) whenever possible and changing the main loop from a For to a Do as suggested. The ParallelTable command (also suggested) seems not to work inside a Manipulate. The computation time has reduced by a factor of 10 (more or less) and it's now possible to build ...


2

From the documentation on GraphIntersection > Details and Options: Similarly, GraphDifference > Details and Options In both cases, the vertex set of the graph produced by the two functions is the Union of the vertex sets of the input graphs.


5

I can reproduce your problem (Win7 64, M10.0.1). Same problem if you try with PDF or EPS format. When actually your graph should look like this Graph[{1 <-> 1, 1 <-> 2}, EdgeShapeFunction -> "Line", EdgeStyle -> {Black}, VertexStyle -> Black, VertexSize -> .05] It looks like this is a bug, but there is an easy way around ...


2

ClearAll[wrapLabel]; wrapLabel[lbl_] := StringReplace[lbl, ":" -> "\n"]; vlist={"Melvyn:GRU", "Gordon:Minion 1", "Philip:Minion 2"}; options = {GraphStyle -> "SmallNetwork", EdgeShapeFunction -> (*Edges consist of 3 pairs of 2d cords to create a typical Org Chart style 3 Line Edge*) ({Line[{#1[[1]](*1st pair*), {#1[[1, 1]], #1[[1, ...


2

You can use FindCycle in Mathematica 10.


4

You can turn off caching in graphs by setting the system options: SetSystemOptions["GraphOptions" -> "CacheResults" -> False]


3

I post this as another variant but clearly inspired by other answers but different from my original: sa[g_] := With[{el = EdgeList[g], vl = VertexList[g]}, sub = Subsets[vl, {3, Infinity, 2}]; SparseArray[{i_, j_} /; (Length@Intersection[sub[[i]], List @@ el[[j]]] == 2) :> 1, {Length@sub, Length@el}]] Testing: test graph with adjacency ...


1

Given a simple directed or simple undirected weighted graph, WeightedAdjacencyMatrix gives a matrix with non-zero entries a_ij representing the weight of the edge v_i to v_j. The default value 0 implicitly describes the (dis)connectivity. Such connectivity information is needed to build a weighted graph from a matrix. For WeightedAdjacencyGraph, two ...


6

Here's another variation using IncidenceMatrix: relation[g_] := Block[{im, sub, vlist}, im = IncidenceMatrix[g]; sub = Subsets[Range[VertexCount[g]], {3, Infinity, 2}]; UnitStep[Total[im[[#]]] & /@ sub - 2] ] example: g = RandomGraph[{5, 5}] TableForm[relation[g], TableHeadings -> {Subsets[VertexList[g], {3, Infinity, 2}], ...


6

This is ugly cf @kguler and other answers fun[gr_] := Module[{el, vl, sub, f = Function[{x, y}, 1 - Unitize[Norm[# - Sort@x] & /@ (Sort /@ List @@@ y)]], subg, res}, el = EdgeList[gr]; vl = VertexList[gr]; sub = Subsets[vl, {1,Infinity,2}]; subg = List @@@ EdgeList[Subgraph[gr, #]] & /@ sub; res = If[# == {}, ...


6

Here is a version that is slightly faster then all the other answers so far: g = RandomGraph[{9, 12}] nZ = Flatten[ Position[EdgeList[g], #] & /@ EdgeList[Subgraph[g, #]]] & /@ Select[Subsets[VertexList[g]], Length@# > 1 && OddQ@Length@# &]; nZ = Flatten@Table[{n, #} -> 1 & /@ nZ[[n]], {n, 1, ...


9

Odd-length subsets can be obtained using the second argument of Subsets (although documentation does not show this usage pattern *) oddsubsets = Subsets[VertexList[#], {3, ∞, 2}] &; (* excluded subsets of length 1; change 3 to 1 if you need all odd-sized subsets *) eVsubsetsM = Function[{g}, Outer[Boole[MemberQ[EdgeList[Subgraph[g, #1]], #2]], ...


1

Graph[{ Labeled["Mon Sol" <-> "Dim Sol", "K1"], Labeled["Dim Sol" <-> "Dim Surf 1", "K4"], Labeled["Dim Surf 1" <-> "Dim Surf 2", "K6"], Labeled["Mon Sol" <-> "Mon Surf", "K2"], Labeled["Mon Surf" <-> "Dim Surf 2", "K7"], Labeled["Mon Surf" <-> "Dim Surf 1", "K5"]}, VertexLabels -> "Name", VertexSize ...


1

For V9 and up. (you haven't specified your version in your question) g = CompleteGraph[4]; PropertyValue[{g, UndirectedEdge[1, 2]}, EdgeWeight] = 2; MatrixForm@Normal@WeightedAdjacencyMatrix[g] $\left( \begin{array}{cccc} 0 & 2 & 1 & 1 \\ 2 & 0 & 1 & 1 \\ 1 & 1 & 0 & 1 \\ 1 & 1 & 1 & 0 \\ \end{array} ...


1

I'm not sure I quite understand what you intend to do with EdgeAdd thus I will only answer the "I want to modify the edge 1-4 of the CompleteGraph[5]" question. Here I modify the edge 1 <-> 4 and 1 <-> 2 for generalisation purposes: g = CompleteGraph[5]; weightsVal = {a, b}; (* in the same order as {1 <-> 4, 1 <-> 2}*) weights = ...


0

You are trying to get at the graph {"Antiprism",5} since you get: G = Part[GraphData[10],1] (* Output: {"Antiprism",5} *) After that, you actually need to use "LineGraph" as an argument for GraphData as: GraphData[G, "LineGraph"] That should give you the line graph of your G.


0

Well, I haven't quite understood your request for a Dynamic approach (I don't see the why or how of it) but since no one else has responded, here is what I can cook up in a few minutes: Clear[G] G[n_] := G[n] = Module[{e1, e2, Gr = G[n - 1], m = Length[G[n - 1]], t}, e1 = RandomInteger[{1, m}]; e2 = RandomInteger[{1, m}]; While[Gr[[e1, 2]] ...


1

The key function used in Combinatorica`HasseDiagram is the transitive reduction function TR. TR = Compile[{{closure, _Integer, 2}}, Module[{reduction = closure, n = Length[closure], i, j, k}, Do[If[reduction[[i, j]] != 0 && reduction[[j, k]] != 0 && reduction[[i, k]] != 0 && (i != j) && (j ...


3

I'm not sure if I understand your question. I'm trying to answer: Does mathematica have some object to draw a Hasse Diagram from DirectedEdges or adjacency matrices So, let's draw a Hasse Diagram starting from its adjacency matrix: << Combinatorica`; am = {{1, 1, 1, 1, 1, 1, 1}, {0, 1, 1, 0, 1, 1, 1}, {0, 0, 1, 0, 1, 0, 0}, {0, 0, 0, 1, ...


8

Here is a recursive way to get them all: (slow due to the use of IsomorphicGraphQ inside DeleteDuplicates, if anybody knows how to do it faster, please comment). Much faster now thanks to @MarkMcClure's clever improvement. Edit Improved again by 40% prefiltering the added rows using the automorphisms of the n-1 graph: << Combinatorica` ...


1

You can generate a connected random graph with the same number of vertices and edges as g1. adjm = {{0, 1, 0, 0, 1, 0, 0, 0, 1}, {1, 0, 1, 0, 0, 0, 0, 1, 0}, {0, 1, 0, 1, 0, 0, 0, 1, 0}, {0, 0, 1, 0, 1, 1, 0, 0, 0}, {1, 0, 0, 1, 0, 1, 0, 0, 0}, {0, 0, 0, 1, 1, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 1}, {0, 1, 1, 0, 0, 0, 1, 0, 0}, {1, 0, 0, 0, ...


4

The website http://cs.anu.edu.au/~bdm/data/graphs.html contains a list of all unlabelled graphs, with up to 10 vertices. It uses a special format, which can be converted to an adjacency matrix using the showg program, downloadable (as C source code) from here. Once converted to an adjacency matrix, Mathematica can read it. I compiled showg on a ...


8

Mathematica should render the secondary structure in the usual way when you import pdb files. I dont know why this doesn't work with the example you provided. I thought there might be a size limit for the protein but I managed to import much bigger proteins such as 1YHU and they got rendered without problems... strange. ...


1

If your graph is a path graph, only thing you need to do is finding root (starting vertex). Once you find root, you could do DepthFirstScan (like Igor Rivin suggested), BreadthFirstScan, VertexComponent, etc... For example: g = PathGraph[RandomSample[Range[100], 100], VertexLabels -> "Name"] roots = VertexList[g][[Flatten[Position[VertexDegree[g], ...


1

Like Daniel Lichtblau suggested, Using FindShortestTour might be the best way. For example, shortestPath[g_] := Block[{tour, pos}, tour = UndirectedEdge @@@ Partition[FindShortestTour[g][[2]], 2, 1]; pos = Last[Ordering[PropertyValue[{g, #}, EdgeWeight] & /@ tour]]; Rest[RotateLeft[tour, pos - 1]] ] I replace 0 to Infinity to remove loops ...


1

What you want is DepthFirstScan, as in: vlist = {} DepthFirstScan[tree, 1, {"PrevisitVertex"-> (vlist = Append[vlist, #]&)}] UPDATE As Mark points out, that does not work, what does work (almost) is Reap[DepthFirstScan[tree2, 1, {"PrevisitVertex" -> Sow}]] However, this will give non-leaf vertices multiple times. What do you actually want it ...


4

labels = Table[i -> Style[Subscript[v, i], 20], {i, 3}] names = Table[i -> "longname_" <> "v_" <> ToString@i, {i, 3}]; colors = {1 -> Blue, 2 -> Red, 3 -> Green}; legend = SwatchLegend[Last /@ colors, Row[{#[[1]], ": ", #[[2]]}] & /@ Transpose[{labels, names}][[All, All, -1]], LegendMarkers -> "Bubble"]; You ...



Top 50 recent answers are included