Tag Info

New answers tagged

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


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


0

Since you are only drawing Spheres (like @belisarius mentioned), GraphEmbedding and Graphics3D will be enough to do this (GraphicsComplex may not help that much in this situation). For example, g = RandomGraph[{100, 150}]; coord = GraphEmbedding[g, Automatic, 3]; colors = ColorData["TemperatureMap"] /@ RandomReal[{0, 1}, 100];; spheres = MapThread[{#, ...


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


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


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


0

I think the problem is that you use wrong input mode. For example, the following example: When using the standard input cell form or input cell form, Mathematica evaluate the result, but when using the Wolfram Language input, it gives the "no interpretations available" result. But for your specific example, the Wolfram Language can evaluate the result, ...


0

Fixed in 10.0.2. On windows 7, 64 bit << ComputationalGeometry` g = RandomGraph[{12, 18}]; pt = GraphEmbedding[g]; convexhull = ConvexHull[pt]; Show[PlanarGraphPlot[pt, convexhull, ColorOutput -> Red], g, Graphics[{Red, PointSize@Large, Point[#]} & /@ pt]] g = RandomGraph[{10, 20}]; GraphEmbedding[g]; g


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.


0

You may see that removing a single vertex doesn't disconnects your graph. It's a bug,as noted in the comments: And @@ Thread[ Length /@ ConnectedComponents /@ (VertexDelete[g, #] & /@ VertexList@g) == 1] (* True *)


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


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


0

Here is how g = RandomGraph[{20, 25}, VertexLabels -> "Name"] FindClique[g, Infinity, All] {{3, 4, 17}, {2, 10, 16}, {13, 15}, {13, 14}, {12, 16}, {12, 14}, {11, 19}, {11, 13}, {7, 9}, {6, 20}, {6, 17}, {6, 10}, {5, 17}, {5, 14}, {5, 7}, {3, 8}, {3, 7}, {1, 13}, {1, 9}, {2, 9}, {2, 4}, {18}} In general you cannot partition a graph entirely ...


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


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


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. System`Graph and Combinatorica`Graph. Whenever a symbol name is shown in red, you'll need to prepend a context to indicate whether you're referring ...


0

quick fix is to use EdgeShapeFunction. My function here is not very sophisticated so it may happen that you cross different vertices somewhere some day, so be careful :) : Graph[{1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 4, 2 \[UndirectedEdge] 3, 2 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 5, 3 \[UndirectedEdge] 4}, VertexLabels -> {1 -> ...


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


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


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


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


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


0

Similar to the one in the documentation. I just made it into a function so that you can specify the number of vertices. randomTree[n_, opts___] := Graph[Range@n, # + 1 <-> RandomInteger[{1, #}] & /@ Range[n - 1], opts]


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


2

Graphics`Mesh`MeshInit[]; 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]] ...


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


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


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



Top 50 recent answers are included