Tag Info

Hot answers tagged

13

Here is a different take on @Szabolcs idea. If a general grouping will do CommunityGraphPlot can be used. Define a 13-vertex graph with no simple (as opposed to hyper) edges: g = Graph[Range[13], {}, VertexCoordinates -> RandomReal[1, {13, 2}], VertexLabels -> "Name"] Explicetely define hyper-edges as groups of vertices they connect: ...


12

It looks to me like you're using DirectedEdges, which are designed to work with Graph as opposed to GraphPlot. If you'd like to use GraphPlot and VertexRenderingFunction, you can do like so: matrix[1] = { {0, 1, 0}, {0, 0, 1}, {0, 0, 1} }; matrix[2] = { {1, 0, 0}, {1, 0, 1}, {1, 0, 0} }; matrix[3] = { {1, 0, 1}, {0, 0, 0}, ...


10

Something similar to one in the Op's link: hyperPlot[sets_, blayout_: "SpringEmbedding"] := Block[{l, esym, eset, vset, g, em, rules, edges, vcircle}, l = Length[sets]; esym = Table[Unique["e"], {l}]; eset = Flatten[Table[Thread[sets[[i]] <-> esym[[i]]], {i, l}]]; vset = Union[Join @@ sets]; g = Graph[vset, eset, GraphLayout -> ...


10

Update: If the graph g1 is already created, I think SetOptions is the most convenient way to make changes in g1: g1 = Graph[{1 <-> 2, 2 <-> 3, 3 <-> 1}, EdgeWeight -> {2, 3, 4}]; ew = PropertyValue[g1, EdgeWeight]; el = EdgeList[g1]; edgestylea = Thread[el -> (Directive[CapForm["Round"], Thickness[Rescale[# , Through@{Min, ...


8

proc = DiscreteMarkovProcess[1, {{0.6, 0.4}, {0.3, 0.7}}]; g = Graph[{"A", "E"}, proc, GraphStyle -> "DiagramBlue"]; SetProperty[g, Sequence @@ (AbsoluteOptions[g, EdgeLabels] /. Tooltip -> 1/2)] Few more alternatives -- all give the same picture g1 = Graph[{"A", "E"}, proc, GraphStyle -> "DiagramBlue", EdgeLabels -> {e_ :> ...


7

One can use this small piece of code f[s_, n_?EvenQ] := Flatten[Outer[Join, #[[;; , -2 ;; 2 ;; -1]], #, 1] & /@ GatherBy[#, #[[{1, -1}]] &] &@ Nest[Flatten[{If[# > 1, {# - 1, ##}, ## &[]], If[# < s, {# + 1, ##}, ## &[]]} & @@@ #, 1] &, Transpose@{Range@s}, n/2], 2] f[__] = {}; f[3, 4] {{2, 1, 2, 1}, {2, 3, 2, ...


7

Edit: OP wanted EdgeLabels which are easily added, and as pointed out this is M10 compatible only (with the introduction of multigraph) In cases like this I always think that Properties are the best way to go, here I provide various Properties to the edges OP provided. edgeProperties = Join[Property[#, {"TransportMode" -> "Foot", EdgeStyle -> Red, ...


7

From the documentation for DiscreteMarkovProcess, you can come up with this: Graph[proc, GraphStyle -> "DiagramBlue", EdgeLabels -> With[{sm = MarkovProcessProperties[proc, "TransitionMatrix"]}, Flatten@Table[DirectedEdge[i, j] -> sm[[i, j]], {i, 2}, {j, 2}]], VertexLabels -> {1 -> "A", 2 -> "E"} ] I took the liberty of ...


6

proc = DiscreteMarkovProcess[1, {{0.6, 0.4}, {0.3, 0.7}}] h = Graph[{"A", "E"}, proc, GraphStyle -> "DiagramBlue"] ToExpression@StringReplace[ToString@FullForm@h, "Tooltip" :> ".1"]


5

In the following I have changed Coords to coords,otherwise same names. pl = GeoGraphics[Point[Reverse /@ coords], GeoRange -> {{20, 49}, {-120, -65}}]; col = {Red, Green, Blue, Orange}; all = {foot, car, plane, train}; grp = Graph[Join @@ all, EdgeStyle -> Join @@ MapThread[Map[Function[x, x -> #2], #1] &, {all, col}], ...


5

The following works without V10. We can't use the easier Graph[] because in v9 (and before) it doesn't support multigraphs. NB: Your city coordinates doesn't match any particular city ordering, so I calculated my own. It was much more difficult than I expected due to the need to circumvent this bug. Perhaps there is a simpler way, but I can't find it: all ...


5

Here's my submission in the category 'shortest code': AllTuples[s_, n_?EvenQ] := Map[ Sequence @@ Outer[Plus, Range[1 - Min@#, s - Max@#], #]& @ Accumulate @ # &, Permutations @ Flatten @ ConstantArray[{-1, 1}, n/2] ] This is based on the observation that desired list of tuples without the first condition is isomorphic to all ...


5

The converstion between sparse arrays and graphs can be done with AdjacencyMatrix and AdjacencyGraph or IncidenceMatrix and IncidenceGraph. The file you provided here is a AdjacencyMatrix. To get the Graph and GraphEmbeddingtry tje following: m = Import["...\\ash292.mtx"]; graph = AdjacencyGraph[m] graphEmb = GraphEmbedding[graph] ...


5

Judging from the paper you linked to and your own comments, I think what you really want is a directed Barabasi‚ÄďAlbert graph whose opposite edges have different weight. (Thus e.g. edge 1 -> 2 should have a different weight than 2 -> 1). The code you posted generates an undirected BA graph, so allow me to suggest an alternative generating function ...


4

This is just a rough proof-of-concept that needs additional work for real applications. For 3-hypergraphs, you could simply surround each triple with a rounded polygon. I didn't implement rounded polygons now (which would look better), I just used B-splines, but these are a but ugly. hg = RandomSample[Subsets[Range[10], {3}], 10] (* {{2, 5, 6}, {3, 5, 9}, ...


4

There is a undocumented input form such as: DegreeGraphDistribution[indegree, outdegree] For example: g = RandomGraph[ DegreeGraphDistribution[{1, 3, 3, 1, 2}, {3, 1, 3, 2, 1}]]; VertexInDegree[g] {1, 3, 3, 1, 2} VertexOutDegree[g] {3, 1, 3, 2, 1}


4

In version 10, you can use MeshCoordinates[ConvexHullMesh[...]] as in RunnyKine's answer, but you need to re-order them using MeshCells: pentagon=N@Table[{Cos[2 Pi k /5], Sin[2 Pi k /5]}, {k, 5}] points = N@RandomSample[Join[pentagon, {{0, 0}}]] chm=ConvexHullMesh[points]; ordering=MeshCells[chm,2][[1,1]] out=MeshCoordinates[chm][[ordering]] ...


4

For smallish values of n one can use integer programming. Below is one way to code that into Reduce. I don'tpect it to be competitively fast, as written, for n>10 or so. lacedTuples[n_] := Module[ {a, vars, fvars, c1, c2, c3, c4, c5, constraints, adjacents, wrappedvars, colvals, coldiffs, soln}, vars = Array[a, {n, n}]; fvars = Flatten[vars]; ...


4

This seems to give you the format: Graph[ {vertices}, { directededges, undirectededges} ] For example, try changing up what you have to include non-null entries: Graph[{1, 2, 3}, { {{1, 2},{2, 3},{1, 3}}, {{3, 2}} }] Graph[{1, 2, 3}, { {{1, 2},{2, 3}}, {{3, 2},{1, 3}} }] etc... It still falls under category "2" from your list, more or less. I don't ...


4

You can use memoization and some other ideas to speed this up. Clear[Mat, d, g]; Mat[G_] := Normal[AdjacencyMatrix[G]]; d[s1_, s2_, G_] := d[s1, s2, G] = If[s1 == {} || s2 == {}, 0, If[Length[s1] > VertexCount[G]/2, d[s2, s1, G], d[Rest[s1], s2, G] + Plus @@ Mat[G][[s1[[1]], s2]] (* This takes s1 excluding its first element and computes ...


4

This is the "exact" calculation. Don't try it with large Graphs: f[g_] := Min[ (Length@ Complement[Sort /@ EdgeList[NeighborhoodGraph[EdgeDelete[g, UndirectedEdge[a_, b_] /; Nor[MemberQ[#, a], MemberQ[#, b]]], #]], Sort /@ EdgeList[Subgraph[g, #]]] / Length@#) ...


4

An alternative approach is to use Mesh and MeshFunctions as follows: ClearAll[f, g]; f = 2/(1 + 20 x^2); g = 1/(1 + 20 x^2)^(1/2); Plot[{f, g}, {x, 0, 3}, MeshFunctions -> {(f - g) /. x -> # &}, Mesh -> {{0}}, MeshStyle -> Directive[Red, PointSize[Large]], AxesLabel -> {"x", "y"}, LabelStyle -> (FontSize -> 16), GridLines -> ...


3

I'm late to the party and only want to show that you can shorten the input to such questions considerably by using Interpreter: cities = Interpreter["City"][#] & /@ {"LosAngeles", "NewYork", "Chicago", "Houston"}; paths = GeoPath /@ Subsets[cities, {2}]; Column[{ GeoGraphics[{Blue, Thick, paths}, GeoProjection -> "AzimuthalEquidistant", ImageSize ...


3

If you have Version 10, you could use ConvexHullMesh. pts = RandomReal[{-10, 10}, {6, 2}]; You can then order them by doing: chull = ConvexHullMesh[pts]; And here are the points: MeshCoordinates[chull] Note: This does not always order the points but one can use MeshCells which will give the ordering correctly. See @kguler's answer.


3

I am using Mathematica 10 but I suppose the same issues will apply. I believe that the GraphUtilites package is not designed to work with Graph objects but instead other, earlier formats. After loading Needs["GraphUtilities`"] the Symbol EdgeList is highlighted in red indicating shadowing, meaning that this Symbol exists in multiple contexts in the ...


3

f1 = 2/(1 + 20 x^2); f2 = 1/(1 + 20 x^2)^(1/2); xp = FindInstance[f1 == f2 && 0 < x < 3, x, Reals, 15] // Values // Flatten yp = f1 /. x -> xp Plot[{f1, f2}, {x, 0, 3}, AxesLabel -> {"x", "y"}, Epilog -> {Red, PointSize[0.02], Point[{First@xp, First@yp}]}, LabelStyle -> (FontSize -> 16), GridLines -> Automatic, ...


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

EDIT: This method really just optimizes, and visualizes binary decision trees, not general binary decision diagrams. I answered a question - sadly not one that was asked! :) "If and constants" ("IF") form of BooleanConvert seems to be sensitive to order of boolean variables; it always builds the tree starting from the first appearing in the description of a ...


2

For Sound objects like sound = Import["ExampleData/rule30.wav"] Mathematica creates a visual representation be default. To use it in your own visualizations, you can extract this information by ListLinePlot[sound[[1, 1]], PlotRange -> All] and do something like Graph@Table[ sound[[1, 1, 1]][[n]] <-> sound[[1, 1, 1]][[n + 1]], ...


2

Could use ConvexHull in the ComputationalGeometry standard add-on package. Needs["ComputationalGeometry`"] We'll create a simple example. pts = RandomReal[{-10, 10}, {6, 2}]; ListPlot[Append[pts, First[pts]], Joined -> True] Now find and plot the (ordered) outer points. hullindices = ConvexHull[pts]; hullpts = pts[[hullindices]]; ...



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