# Tag Info

20

Some function definitions first. AkimaInterpolation[] stolen from here (Thanks JM, wherever you are!): AkimaInterpolation[data_] := Module[{dy}, dy = #2/#1 & @@@ Differences[data]; Interpolation[Transpose[{List /@ data[[All, 1]], data[[All, -1]], With[{wp = Abs[#4 - #3], wm = Abs[#2 - #1]}, If[wp + wm == 0, (#2 + #3)/2, (wp #2 + wm ...

8

This seems to work pretty well: r = 0.2/3; regions = RegionPlot[ Evaluate@Table[ Length@clique PDF[SmoothKernelDistribution[data[[clique]], r], {x, y}] > 1/(4 π r^2), {clique, mycliques}], {x, -2 r, 1 + 2 r}, {y, -2 r, 1 + 2 r}, Frame -> False]; Show[regions, Graph[mygraph, GraphStyle -> "BasicBlack"]] Further reading: ...

6

I suggest you try the following. Set your two plots in the Question to p1 and p2. Then, col = Map[ColorData["TemperatureMap"][#] &, Rescale[var[[2]], {0, maxvar}]]; ans = MapIndexed[(#1 /. (RGBColor[__] -> col[[Last[#2]]])) &, p1 // InputForm, {6}]; ans[[1]] reproduces p2 without calling GraphPlot3D, which should be faster. This process can, ...

5

edges = coords /. Line[{a_, b_}] :> UndirectedEdge[a, b]; g = Graph[edges]; starts = VertexList[g, {_, 0}]; ends = VertexList[g, {_, 4}]; Intersection[Join @@ ConnectedComponents[g, starts], ends] != {} (*True*) And we can show all of them ... g = Graph[edges]; g1 = SetProperty[g, VertexCoordinates -> VertexList@g]; paths = ...

4

You can modify your VertexRenderingFunction using Text[verts[[#2]], #1] instead of Text[#2, #1]: verts = {"Aa", "Ba", "Ca", "Da", "Ea", "Fa"}; g1 = WeightedAdjacencyGraph[SparseArray[{{i_, j_} /; (i != j) -> 1}, {6, 6}, \[Infinity]], VertexLabels -> Thread[Range[6] -> verts], ImagePadding -> 20, ImageSize -> 400]; g2 = GraphPlot[g1, ...

4

There are two problems: Combinatorica is an obsolete package and many of the function/symbol names conflict with new, builtin ones. You'll need to refer to these symbols with their fully qualified name, e.g. SystemGraph and CombinatoricaGraph. Whenever a symbol name is shown in red, you'll need to prepend a context to indicate whether you're referring ...

4

Anyway, Treegraph offers a lot of flexibility: nodes = {RandomInteger[#] , # + 1} & /@ Range[0, 30]; rn = Range@Length@nodes; crules = Rule @@@ Partition[Riffle[rn, ColorData[15, "ColorList"]], 2]; g = TreeGraph[UndirectedEdge @@@ nodes, VertexSize -> 0.4, VertexStyle -> crules]; HighlightGraph[g, PathGraph@FindShortestPath[g, 1, 30], ...

2

GraphicsMeshMeshInit[]; cC = #[[ConvexHull[#]]]&/@ (PropertyValue[{mygraph, #}, VertexCoordinates] & /@ # & /@ mycliques); g2 = Graphics[{Opacity[.25], {Hue[RandomReal[]], Polygon[#]} & /@ cC}]; mygraph2 = Show[g2, HighlightGraph[mygraph, Subgraph[mygraph, #] & /@ mycliques]]; Row[{Panel@mygraph, Panel@mygraph2}, Spacer[15]] ...

2

plotOne[g_Graph] := Module[{probs, purgedTab, r = Range@Max@VertexDegree@g}, probs = {#, Probability[x == #, x \[Distributed] VertexDegree[g]]} & /@ r; purgedTab = DeleteCases[probs, {x_, y_} /; x y == 0]; ListLinePlot[Log@purgedTab, Filling -> Axis, Mesh -> Full, MeshStyle -> Directive[PointSize[Large], Black], ...

2

As indicated by @Szabolcs, you just have to use SetAttributes[plotting, HoldAll] or even in your case SetAttributes[plotting, HoldFirst] (because you have only one argument) when defining your function. But then, there is a problem to test the header of the function argument, plotting[g_Graph] won't never plot anything because as g is now by defintion ...

2

Starting from the graph indicated. vertexWeight={1, 2, 1, 1}; g = GridGraph[{2, 2}, VertexWeight -> vertextWeight, VertexLabels -> "VertexWeight"] m = AdjacencyMatrix[g]; {l1, l2} = Dimensions[m]; h = WeightedAdjacencyGraph[ Table[m[[i, j]] (vertexWeight[[i]] + vertexWeight[[j]]), {i, l1}, {j, l2}] /. Rule[0, \[Infinity]], VertexLabels ...

2

You can just create a graph on the maximal cliques, where cliques are joined if they share any elements. Then you find maximal independent sets in the derived graph-of-cliques. (This is easily adaptable if you do not require cliques to be maximal, just throw in a bunch more vertices into cv to account for sub-cliques.) n = 15; a = RandomReal[{0.7, 0.9}]; g ...

2

colorRules = Thread[DeleteDuplicates[f] -> {Blue, Red, Orange}]; mm = RandomChoice[{0, 1}, {5, 5}]; GraphPlot3D[mm, VertexRenderingFunction -> ({f[[#2]] /. colorRules, Sphere[#1, 0.05]} &)] or cF[1] = Blue; cF[2] = Red; cF[20] = Orange; GraphPlot3D[mm, VertexRenderingFunction -> ({cF[f[[#2]]], Sphere[#1, 0.05]} &)] gives ...

2

Another way is use AdjacencyGraph with the full graph and setting the EdgeStyle so that edges smaller than 1 are not visible: paint[adj_?MatrixQ, style_] := AdjacencyGraph[ Ceiling[adj], EdgeStyle -> (DirectedEdge @@ # -> style & /@ Position[adj, _?(0 < # < 1 &)])] and then you can go with adjMat = RandomInteger[{0, 1}, {10, 10}] ...

2

edges = {"R1" -> "A", "R1" -> "B", "R2" -> "A", "R2" -> "B", "R2" -> "C", "R3" -> "B", "R3" -> "C", "A" -> "D", "A" -> "E", "B" -> "D", "B" -> "E", "B" -> "F", "C" -> "E", "C" -> "F", "D" -> "T", "E" -> "T", "F" -> "T"}; ew = {120, 115, 70, 90, 110, 140, 120, 110, 85, 130, 95, 85, 130, 160, 220, ...

2

Without being expert in the field, it seems that the required numbers can be expressed as the coefficients of a two-variable polynomial. So $x$ and $y$ are only used to create that polynomial (Why and how is a different thing, though). They have no other purpose and are of no interest later on.

1

Your code has several typographical errors, especially in merging different variables, such as vt and f (which must be kept separate). When cleaned up, you get a single trajectory: Manipulate[ ParametricPlot[{{Cos[θ] vt, Sin[θ] vt - 9.8 t^2/2}, {Cos[θ] v vt/9.8 (1 - Exp[-9.8 t/vt]), vt/9.8 (v Sin[θ] + vt) (1 - Exp[-9.8 t/vt]) - vt*t}}, {t, ...

1

You could use HighlightGraph: m = {{0, 0.5, 1}, {1, 0, 0}, {0.1, 1, 0}}; g = WeightedAdjacencyGraph[m]; GraphicsRow[{g, HighlightGraph[g, Style[e_ /; (PropertyValue[{g, e}, EdgeWeight] < 1), Transparent]]}]

1

If somehow you don't like @belisarius's answer (it is very neat, there's no reason not to use it!), you can also get the vertex coordinates from the complete graph and force them on the original graph. Stealing some of his answer's definitions: g = AdjacencyGraph@Ceiling@newAdjM PropertyValue[{g, #}, VertexCoordinates] & /@ VertexList[g] ...

1

SeedRandom[42]; (* set up the before/after adjecency matrix *) adjM = RandomInteger[{0, 1}, {5, 5}]; twoEdges = Position[adjM, 0][[1 ;; 2]]; newAdjM = ReplacePart[adjM, Thread[Rule[twoEdges, 1/2]]]; (* function to build the new graph*) f[aM_, col_] := Module[{edgs}, edgs = DirectedEdge @@@ Position[newAdjM, Except[_Integer], {2}, Heads -> False]; ...

1

This only work when graph is well structured like David's example and know source, sink, and both: g = Graph[Range@40, DeleteDuplicates[Join[myFirstRules, mySecondRules]]]; add1 = Thread["s" -> Select[mySources, VertexOutDegree[g, #] > 0 &]]; add2 = Thread[ Select[myBoth, (VertexOutDegree[g, #] == 0 && VertexInDegree[g, #] != ...

1

ClearAll[circularKPartiteF]; circularKPartiteF = With[{rl =Range[Length@{##}]}, Join @@ (2^rl (GraphComputation`CircularEmbedding[#] & /@ {##}))] &; Example 1: David's example Graph[Range@40, DeleteDuplicates[Join[myFirstRules, mySecondRules]], VertexSize -> Large, VertexStyle -> Join[Thread[mySources -> ...

1

You can use GraphLayout to arrange your Vertexes by SpringEmbedding or other function, then extract the full two-dimensional locations of the vertexes, then assign the x-coordinate of each vertex to your known or desired x coordinates and re-display the graph with these new vertex locations. g = CompleteGraph[20, GraphLayout -> ...

1

It appears to be very difficult to use GraphLayout -> RadialEmbedding in your case but you can place your Vertexes using VertexCoordinates. mySources = Range[1, 10]; myBoth = Range[11, 20]; mySinks = Range[21, 40]; myFirstRules = Table[Rule[RandomChoice[mySources], RandomChoice[myBoth]], {30}]; mySecondRules = Table[Rule[RandomChoice[myBoth], ...

1

So in fact, this is a graph search problem, Right? The normal approaches is to use Depth-First-Search(DFS) or Breadth-First-Search(BFS) to test connected relation of two points. For example, if you want to test whether coordinate (3,0) is connected to coordinate (2, 4), you can just use DFS or BFS to do the test. I think the trick point in your problem ...

1

I am not sure if this will completely answer your question. I would suggest plotting scatterplot of all available graphs, with conveniently chosen x and y axes, and tooltips. Like this: ListPlot[Tooltip[GraphData[#, {"VertexCount", "EdgeCount"}], GraphData[#, "StandardName"]] & /@ GraphData[]] ListPlot[Tooltip[GraphData[#, {"VertexCount", ...

1

In Mathematica 10 it is easy to do with GeoDistance. Simply replace your g with the following lines stateToLocation = Rule[First[#], ToExpression[Rest[#]]] & /@ (StringSplit[stateData, ","]); edgeLabels = Thread[Rule[ EdgeList[g], (EdgeList[g] /. numberToState /. stateToLocation) /. UndirectedEdge -> GeoDistance]]; g = ...

1

Not sure if this is what you're after. The following is the steady state supposing null divergences except at the source: g = DirectedGraph[CompleteGraph[5], "Acyclic", VertexLabels -> "Name"] in[n_] := Tr[v[#]/VertexOutDegree[g, #] & /@ Complement[VertexInComponent[g, n, 1], {n}]] Solve[Join[{v[1] == 1}, Table[v[n] == in[n], {n, 2, ...

1

I'm hardly sure that I have understood your question fully, but does this give you the result that you want? Table[Probability[x == k, x \[Distributed] VertexDegree[j]], {j, allgraphs}, {k, Max[VertexDegree[j]]}] You need to specify the j iterator first, as the specification of k depends on j. On a more general note, I would say that if I want to ...

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