Tag Info

Hot answers tagged

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


8

For the part I would need to identify the relevant segments automatically. you can use vd2 = ConnectedComponents@Subgraph[g0, VertexList[g0, x_ /; (VertexDegree[g0, x] == 2)]] {{36, 43, 49, 48, 55, 63}, {41, 42, 47, 54, 62}, {39, 40, 46, 53}, {94, 95, 96}, {82, 92, 99}, {77, 78, 84}, {38, 45, 52}, {13, 17, 18}, {9, 10, 11}, {104, 105}, ...


7

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


7

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


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


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


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


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


5

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


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


4

This is much faster in my machine: el = Sort /@ EdgeList[g]; eSF[pos_, vert_, kset_] := {c[[Position[kset, Sort@vert][[1, 1]]]], Line[pos]} genG[el_, kSet_] := System`Graph[el, EdgeShapeFunction -> (eSF[##, kSet] &), VertexLabels -> "Name"] all1 = genG[el, #] & /@ p; // Timing (* {0.790625, Null} *) The "new" PropertyValue[] is nice, but a ...


3

One can smooth the graph by averaging the position of each degree 2 vertex with its neighborhoods. In addition, if the vertex's original position is included in the average, the vertex will be pulled slightly toward it. (Thus four points are being averaged, hence the 0.25 below.) If one iterates this procedure, nice "curved" paths develop. coords = ...


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


3

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


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

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]


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


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.


2

ClearAll[f1]; f1 = EdgeDelete[#2, Complement[EdgeList[#2], #]] &; Example: e = {1 <-> 2, 2 <-> 3}; gA = CompleteGraph[3, VertexLabels -> "Name", ImagePadding -> 20]; gA = SetProperty[{g, 2}, {VertexStyle -> Purple, VertexLabels -> Placed["Name", Center], VertexSize -> .15, VertexLabelStyle -> Directive[White, ...


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.


2

k[] is function defined by you and tri is making UndirectedEdge-s k[j_List] := Block[{t = j[[1]], r = j[[2]], i = j[[3]]},(2 t - 1) 2^(-i + r) 3^(-1 + i)] tri[{t_, r_, i_}] := {{t, r, i} <-> {t, r + 1, i}, {t, r + 1, i} <-> {t, r + 1, i + 1},{t, r + 1, i + 1} <-> {t, r, i}} I remaked your code like this for making Graph. d = 4; data ...


1

Try this: First[Timing[ all = Graph[g, EdgeStyle -> Thread[Rule[ Function[set, If[Length[set] > 1, Alternatives @@ set, First@set]] /@ #, c[[;; numColors]]]]] & /@ p]]


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


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


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

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


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



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