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

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


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


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


5

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

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


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

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

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


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


4

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


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


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

Several ways to get the vertex coordinates: g = RandomGraph[BarabasiAlbertGraphDistribution[15, 2]] v1 = GraphEmbedding[g] (* {{1.51112,1.79164},{1.96659,2.33322},{1.69272,1.22345},{1.26659,0. 698685}, {0.707776,0.695621},{2.39199,0.702118},{2.798,1.67443},{1.00596,2. 14422}, {0.317993,2.08198},{0.891194,1.40115},{2.70447,2.43294},{1.66747,0. }, ...


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


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

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

You can use FindCycle in Mathematica 10.


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

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.


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

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


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


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



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