Tag Info

Hot answers tagged

5

s = "AJDKSIRUXBLHWTMCQGZNPYFVOE"; pc = PermutationCycles[ToCharacterCode@s - 64] // First; Graph[Flatten[Thread[# -> RotateRight@#] & /@ pc], VertexLabels -> Table[i -> FromCharacterCode[i + 64], {i, Flatten@pc}], ImagePadding -> 12] Perhaps better: pc = (PermutationCycles[ToCharacterCode@s - 64] // First) /. ...


5

Here is your initialization code: (*SeedRandom[30];*) (*initial coordinates of masses*) mass = RandomReal[{0, 3}, {4, 2}]; (*mass 1 is connected to {2,3} and so on*) spring = {{2, 3}, {1, 4}, {1, 4}, {2, 3}}; (*spring constant*) k = 2.; (*spring rest length*) l = 1.; (*step size*) step = 0.02; (*tolerance*) tol = 10^-10.; (*pinned masses*) pinned = {2, ...


5

ClearAll[cyclesF, edgesF] cyclesF = Map[FromCharacterCode, 64 + PermutationCycles[ToCharacterCode@# - 64][[1]], {-1}] &; edgesF = Developer`PartitionMap[DirectedEdge @@ # &, #, 2, 1, {1, 1}] & /@ cyclesF[#] &; str = "AJDKSIRUXBLHWTMCQGZNPYFVOE"; colors = {Red, Green, Blue, Orange, Cyan, Yellow}; vl = cyclesF@str; el = ...


4

Not going to win a beauty contest, but you might get some ideas: string = "AJDKSIRUXBLHWTMCQGZNPYFVOE"; rules[cycle_] := Thread[DirectedEdge[cycle, RotateLeft[cycle]]]; edges = MapIndexed[Style[#1, Thick, ColorData[2][#2[[1]]]] &, rules /@ PermutationCycles[LetterNumber /@ Characters[string], Identity], {2}]; verts = ...


3

am1 = GraphData["DodecahedralGraph", "AdjacencyMatrix"]; or am2 = AdjacencyMatrix[GraphData["DodecahedralGraph"]]; am1 == am2 (* True *) MatrixPlot[am1]


3

Just for fun to do recursively in contrast to in-built binary graphs, e[n_] := {n <-> 2 n, n <-> 2 n + 1}; gf[grp_, n_, opts : OptionsPattern[]] := Module[{vl, ne, ng}, vl = Sort@VertexList[grp]; ne = Flatten[e /@ vl[[-n ;;]]]; ng = EdgeAdd[VertexAdd[grp, ne[[All, 2]]], ne]; Graph[VertexList[ng], EdgeList[ng], ...


3

Update: athreepartitegraph = CompleteGraph[{10, 7, 3}, GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> {10, 7, 3}}, ImageSize -> 400, VertexLabels -> "Name", ImagePadding -> 20]; cgp = CommunityGraphPlot[athreepartitegraph, {Range[10], Range[11, 17], Range[18, 20]}, Method -> "Hierarchical"]; ...


3

not quite what you asked for, but possibly useful: relationships = {1 <-> 2, 2 <-> 3, 2 <-> 4, 3 <-> 5, 2 <-> 6, 6 <-> 7, 4 <-> 8, 4 <-> 9}; numNodes = Max[relationships[[All, 2]]]; sizes = RandomReal[{0.25, 1}, numNodes]; xCoords = {0, 1, 2, 2, 3, 3, 4, 5, 5}; vars0 = Array[a, 9]; Manipulate[ vars = ...


2

{af, bf, cf, pf, qf, rf, xf, yf, zf} = {a, b, c, p, q, r, x, y, z} /. NDSolve[{ a'[t]==20+0.03*a[t]-0.00005*a[t]*q[t]-0.0002*a[t]*y[t]-0.0743*a[t], b'[t]==0.03*b[t]+0.00005*a[t]*q[t]+0.0002*a[t]*y[t]-0.0743*b[t]-0.01072*b[t], c'[t]==0.03*b[t]+0.00005*a[t]*q[t]+0.0002*a[t]*y[t]-0.0743*c[t]+0.01072*b[t], p'[t] == 15 + 0.03*p[t] - 0.0001*p[t]*b[t] - ...


2

An alternative workaround is using igraph through my IGraphR package. minimum.size.separators gives all possible smallest vertex cuts. Example: << IGraphR` g = CycleGraph[5, VertexLabels -> "Name", VertexSize -> Large] vcs = IGraph["minimum.size.separators"][g] (* {{2., 5.}, {2., 4.}, {3., 5.}, {1., 3.}, {1., 4.}} *) HighlightGraph[g, #] ...


2

Assuming the file datagr.xls contains your data, import it using importeddata = Import["datagr.xls"][[1]]; and construct the edge list using Apply (@@@) edgelist = {DirectedEdge, UndirectedEdge}[[1 + #3]][#, #2] & @@@ importeddata alternatively, edgelist = If[#3==0, DirectedEdge[#,#2], UndirectedEdge[#,#2]]& @@@ importeddata or Map ...


2

Expanding on comment, the VertexLables->"Name" option shows the "value" of each vertex: {a, b, c} = {ExampleData[RandomChoice[ExampleData["TestImage"]]], 1, "c vertex"} Note the use of ImagePadding to ensure the VertexLabels are not clipped. Graph[{a <-> b, b <-> c, c <-> a}, VertexLabels -> "Name", ImagePadding -> 10] ...


1

gg = GridGraph[{5, 5}]; from = GraphEmbedding[gg] (* {{1., 1.}, {1., 2.}, {1., 3.}, {1., 4.}, {1., 5.}, {2., 1.}, {2., 2.}, {2., 3.}, {2., 4.}, {2., 5.}, {3., 1.}, {3., 2.}, {3., 3.}, {3., 4.}, {3., 5.}, {4., 1.}, {4., 2.}, {4., 3.}, {4., 4.}, {4., 5.}, {5., 1.}, {5., 2.}, {5., 3.}, {5., 4.}, {5., 5.}} *) to = GraphEmbedding[gg, ...


1

It seems that the DiscreteMarkovProcess has directed edges, so you need use the [DirectedEdge] version in your EdgeLabels specification. In version 10 the following works: proc = DiscreteMarkovProcess[1, {{1/2, 1/2, 0, 0, 0}, {1/2, 1/2, 0, 0, 0}, {0, 1/2, 1/2, 0, 0}, {0, 0, 0, 0, 1}, {0, 0, 0, 1, 0}}]; ...


1

If your are looking for a Binary tree than this may work for you: fnBTree[n_] := CompleteKaryTree[Sequence @@ # , VertexLabels -> "Name"] & /@ Join[{{1, 1}, {2, 1}}, Table[{i + 1, 2}, {i, n - 2}]] Call fnBTree with n=4 fnBTree[4]


1

You could add set back to your EdgeShapeFunction: EdgeShapeFunction -> (If[#[[1]] != #[[-1]], {Arrowheads[ If[#2[[1]] == chr, {{0.04, 1}}, {{0.02, 0.2}, {0.02, 0.8}}]], Arrow[BSplineCurve[{#[[1]], {0, 0}, #[[-1]]}, SplineWeights -> {2, 1, 2}], .025]}, Opacity[0]] &)



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