Context: Two sets of data, one is the radius, r, and the other is the velocity, v. v can be positive and negative. The following code
p1=ListLogLogPlot[Table[{r[[i]],v[[i]]},{i,1,number_of_data}]];
p2=ListLogLogPlot[Table[{r[[i]],-v[[i]]},{i,1,number_of_data}],PlotStyle->{Red}];
Show[p1,p2]
is used to give a curve, with positive and negative v both plotted in log-log coordinates.
Question: How to draw a circular, contour-like plot, with Log[r] as the distance to the center of the circle, and the velocities (Log[v]) shown as different, but continuously varying colors, according to v's sign and magnitude?
You may use a DensityPlot function:
v[r_] := Sin[r]*r^2
DensityPlot[v[Norm[{x, y}]], {x, -5, 5}, {y, -5, 5}]
You can deal with the tabular data in two ways. You can either interpolate and use the interpolating function as above or you may use a ListDensityPlot function:
ListDensityPlot[Table[With[{r = RandomReal[{0, 4}], t = RandomReal[{0, 2 Pi}]},
{r Cos[t], r Sin[t], v[r]}], {10^4}]]
I hope this helps.
This question might seem a little strange but for my purposes is not that crazy.
Its easy but I need you to follow me.
The aim
My aim is plotting a tridimensional graph.
The problem
The problem is the material I have in my hands to start building this graph. Actually I have a collection of points in the 2D space (thus tuples of two real ordered values). Consider a moment to have these collection of points stored into an array and now consider to plot them on a 2D diagram. You will just have a nice sparse view of these points.
Well, the second step is this: consider the surface with these points and create a third axis orthogonal to the plane where those points are drawn. The aim is assigning to every point a numerical scalar value (using a function that accepts the couple and returns a numerical value). So the graph should show bars starting from every point and having a specific value according to the assignment function.
How can I achieve this in Mathematica?
A little note
Basically my points in the 2d space are also connected by a graph. Is it possible to connect the top of the bars to the top of other bars whose base point are connected together in the 2d graph?
Some other notes
My graph doesn`t have to be a surface but just a collection of bars placed on a plane in the exact place where the correspondent point they refer to is located. But if you have a good hint how to draw a surface other than bars, it will be gladly accepted.
I hope I was clear. I would like to point that I have Mathematica 8 so all functionalities are available. Thank you.
This can be done using Graphics3D primitives. Lets start with some data
(* a list of 2D coordinates *)
points2D = RandomReal[{0, Pi}, {50, 2}];
(* some edges as a list of pairs of vertex indices *)
edges = Union[Flatten[MapIndexed[Sort /# Thread[{#2[[1]],
Nearest[points2D -> Automatic, #, 4]}] &, points2D], 1]];
(* constructing list of 3D coordinates *)
f[{x_, y_}] := 2 + Sin[x y]
points3D = {##, f[{##}]} & ### points2D;
The actual plot can then be constructed as follows (width is half the width of the bars)
With[{width = .02},
Graphics3D[{{LightBlue, EdgeForm[None],
Cuboid[{#1, #2, 0} - width {1, 1, 0}, {##} + width {1, 1, 0}] & ### points3D},
{Orange,
GraphicsComplex[points3D, Line[edges]]}},
Lighting -> "Neutral",
BoxRatios -> {1, 1, .6}]]
Continuing with the project I previously described I am currently building an animation showing movement between a list of cities. My current code renders a list of cities and makes a set of great circle arcs connecting the cities. The list of cities are part of a timeline so after visiting one city the animation will transition to be centered upon the next.
To my mind this means the ViewVector should be adjusted to show points between a starting city and an ending city. The resulting would probably look like an in-flight map for a long-haul flight sped up considerably. A single frame might look like the following manually produced still:
I now understand how to position the ViewVector above the most recent city but I am quite unsure about how to move the camera smoothly between two spherical coordinate points. My current code is below:
SC[{lat_, lon_}] := {Cos[lon \[Degree]] Cos[lat \[Degree]],
Sin[lon \[Degree]] Cos[lat \[Degree]], Sin[lat \[Degree]]};
GreatCircleArc[{lat1_, lon1_}, {lat2_, lon2_}] :=
Module[{u = SC[{lat1, lon1}], v = SC[{lat2, lon2}], a},
a = VectorAngle[u, v];
Table[Evaluate[RotationTransform[\[Theta], {u, v}][u]], {\[Theta],
0, a, a/Ceiling[10 a]}]]
CityGraphic[name_] := {Opacity[0.85], Black, PointSize[Medium], White,
PointSize[0.045], Point[1.01 SC[CityData[name, "Coordinates"]]]}
CityGraph[places_, age_] :=
Graphics3D[{
Opacity[0.75],
Sphere[{0, 0, 0}, 0.99 ],
Map[Line[
Map[SC,
CountryData[#, "SchematicCoordinates"], {-2}]] &,
CountryData["Countries"]],
Map[CityGraphic, places],
Text[Style[age, FontFamily -> "Helvetica"],
1.02 SC[CityData[First[places], "Coordinates"]]],
White, Line
[Apply[GreatCircleArc,
Partition[Map[CityData[#, "Coordinates"] &, places], 2, 1], {1}]]
},
ViewVector -> {
4 SC[CityData[First[places], "Coordinates"]], {0, 0, 0}},
Boxed -> False,
SphericalRegion -> True,
ImageSize -> {640, 480}
];
CityGraph[{"Tokyo", "Dublin", "Cape Town", "Seattle", "Denver"}, "04"]
In computer graphics people often use Quaternions to smoothly interpolate between various camera viewing directions. Mathematica has a Quaternion package which you could use for basic Quaternion arithmetic. A conversion between Quaternions and Euler angles is described here.
The interpolation process is described here.
Is there a simple way to do the following in Mathematica 8?
Construct a graph, and display it using some graph layout.
Modify the graph slightly (e.g. add or remove an edge or a vertex).
Re-compute the layout starting from the original layout, in such a way that the the "shape" of the object is more or less preserved. E.g. re-run a spring-electric layout algorithm starting with the coordinates of the previous layout.
If the graph hasn't changed between two displays, the layout shouldn't change either (or only minimally). Using the display of the new Graph or GraphPlot are both acceptable.
EDIT: In essence I need similar layouts for similar graphs. I always obtain similar graphs by modifying an existing one, which may have already been laid out, but any generic solution is acceptable.
EDIT 2: Here's an example of where this kind of thing is useful. Go to http://ccl.northwestern.edu/netlogo/models/GiantComponent and click "Run in browser" (requires Java). Click Setup then click Go. You can see the graph evolve. If we do this in Mathematica, then each of the successive graphs will look completely different, and it will be difficult to see that it is the same graph that is evolving. In several applications it's quite useful to be able to visualize small changes to the graph as such. But if many successive changes are done, then re-computing the layout is a must, simply fading or highlighting edges is not sufficient. Again, this is just an example: I'm not trying to use Mathematica to animate a graph, or to visualize the emergence of the giant component.
Here are two basic approaches for altering graphs in MMA 8.0. The first relies on HighlightGraph and in particular on GraphHighlightStyle -> "DehighlightHide". The second approach uses the VertexCoordinates of a graph in future variants of that graph.
We'll discuss deletion separately from addition because they involve slightly different methods.
[P.S. : I made several edits to my answer in to make it clearer.]
First some data:
edges={1\[UndirectedEdge]8,1\[UndirectedEdge]11,1\[UndirectedEdge]18,1\[UndirectedEdge]19,1\[UndirectedEdge]21,1\[UndirectedEdge]25,1\[UndirectedEdge]26,1\[UndirectedEdge]34,1\[UndirectedEdge]37,1\[UndirectedEdge]38,4\[UndirectedEdge]11,4\[UndirectedEdge]12,4\[UndirectedEdge]26,4\[UndirectedEdge]27,4\[UndirectedEdge]47,4\[UndirectedEdge]56,4\[UndirectedEdge]57,4\[UndirectedEdge]96,4\[UndirectedEdge]117,5\[UndirectedEdge]11,5\[UndirectedEdge]18,7\[UndirectedEdge]21,7\[UndirectedEdge]25,7\[UndirectedEdge]34,7\[UndirectedEdge]55,7\[UndirectedEdge]76,8\[UndirectedEdge]11,26\[UndirectedEdge]29,26\[UndirectedEdge]49,26\[UndirectedEdge]52,26\[UndirectedEdge]111,27\[UndirectedEdge]28,27\[UndirectedEdge]51,42\[UndirectedEdge]47,49\[UndirectedEdge]97,51\[UndirectedEdge]96}
Here is the initial graph:
g = Graph[edges, VertexLabels -> "Name", ImagePadding -> 10,
ImageSize -> 500]
"Deleting" a graph edge without changing the overall appearance of the graph.
Let's begin to remove the edge (4,11) located at the center of the graph. remainingEdgesAndVertices contains all vertices and the initial edges with the exception of edge (4,11).
remainingEdgesAndVertices =
Join[VertexList[g], Complement[EdgeList[g], {4 \[UndirectedEdge] 11}]]
Let's "delete" (i.e. hide) the edge (4,11):
HighlightGraph[g, remainingEdgesAndVertices, VertexLabels -> "Name",
ImagePadding -> 10, GraphHighlightStyle -> "DehighlightHide",
ImageSize -> 500]
If we had actually removed edge (4, 11) the graph would have radically changed its appearance.
Graph[Complement[edges, {4 \[UndirectedEdge] 11}],
VertexLabels -> "Name", ImagePadding -> 10, ImageSize -> 500]
"Adding" a graph edge without changing the overall appearance of the graph.
Adding a graph edge is slightly more challenging. There are two ways that come to mind. The method used here works backwards. You include the new edge first in hidden form and then uncover it later. The initial graph with the hidden, "to-be-added" edge will be in a layout similar to that of the graph with the "new" edge. The reason is this: they are in fact the same graph: however they show different numbers of edges.
g2 = Graph[Append[edges, 42 \[UndirectedEdge] 37],
VertexLabels -> "Name", ImagePadding -> 10, ImageSize -> 500]
HighlightGraph[g2,
Join[Complement[EdgeList[g2], {42 \[UndirectedEdge] 37}],
VertexList[g2]], VertexLabels -> "Name", ImagePadding -> 10,
GraphHighlightStyle -> "DehighlightHide"]
Now show the graph with the "new edge" added.
This looks very different from Figure 1. But it seems to be a natural extension of Fig. 4.
Adding new vertices and edges on-the-fly
There is another way to add edges (and vertices) while maintaining the overall appearance. It was inspired by something Sjoerd wrote in his response.
Let's reserve the point {0,0} for a future vertex 99. We simply add that point to the VertexCoordinates from g2:
vc = VertexCoordinates ->
Append[AbsoluteOptions[g2, VertexCoordinates][[2]], {0, 0}]
Now let's see what it looks like. g3 is just g2 with the additional vertex (999) and edge (4,99).
g3 = Graph[Append[EdgeList [g2], 4 \[UndirectedEdge] 999], vc,
VertexLabels -> "Name", ImagePadding -> 10,
GraphHighlightStyle -> "DehighlightHide", ImageSize -> 500]
This procedure allows us to add new edges and vertices as we move forward. But some trial and error will be needed to ensure that the new vertices are located in a suitable position.
Adding only another edge (without a new vertex) is much easier: just add the new edge and use the VertexCoordinates from the prior graph.
You should be able to delete edges from a graph using the same approach (using same VertexCoordinates).
As you know there are several graph formats floating around in MMA. We have the Combinatorica package format, the GraphPlot format and the M8 Graph format.
GraphPlot
You can find the coordinates of GraphPlot nodes as follows.
GraphPlot[{1 -> 2, 2 -> 3, 3 -> 1, 3 -> 4}, DirectedEdges -> True,
VertexLabeling -> True]
This plot can be manually manipulated. You can still find both the old and the new coordinates in it:
VertexCoordinateRules -> {{0.000196475, 0.}, {0.,0.847539},
{0.916405, 0.423865}, {2.03143, 0.42382}}
VertexCoordinateRules -> {{0.000196475, 0.}, {0., 0.847539},
{1.07187,0.708887}, {1.9537, 0.00924285}}
You can draw the plot again using the modified coordinates:
GraphPlot[{1 -> 2, 2 -> 3, 3 -> 1, 3 -> 4}, DirectedEdges -> True,
VertexLabeling -> True, newRules]
or draw a new graph
GraphPlot[{1 -> 2, 2 -> 3, 3 -> 1, 3 -> 4, 1 -> 5, 5 -> 4},
DirectedEdges -> True, VertexLabeling -> True]
that by default looks like this:
using the old coordinates:
updatedRules = VertexCoordinateRules ->
Append[VertexCoordinateRules /. newRules, {1, 0}];
GraphPlot[{1 -> 2, 2 -> 3, 3 -> 1, 3 -> 4, 1 -> 5, 5 -> 4},
DirectedEdges -> True, VertexLabeling -> True, updatedRules]
Graph
I don't think you can manipulate a Graph as you can a GraphPlot, but you can access its vertex coordinates.
GraphData["AGraph"]
oldCoords = AbsoluteOptions[GraphData["AGraph"], VertexCoordinates]
(* ==> VertexCoordinates -> {{1., 2.}, {2., 3.}, {2., 1.}, {1.,1.},
{1., 3.}, {2., 2.}} *)
It is good to have these old coordinates because if we re-create this graph using its adjacency matrix its layout is slightly different. This can be restored using the old coordinates.
You might want to check if the GraphLayout option helps with your graph in problem.
I checked all the combinations of possible values of ComponentLayout and PackingLayout with an example graph (graph0 and graph1 which is graph0 with one edge removed, in the following code). Some combinations definitely look more useful for your purpose (changes the graph layout less when an edge is removed. I find
"ComponentLayout" -> "CircularEmbedding"
"ComponentLayout" -> "LayeredDrawing"
"ComponentLayout" -> "SpiralEmbedding"
preserve the layout the best.
The code to show all combinations is
In[5]:= Quit
In[12]:= $COMPONENTLAYOUTS={(*Automatic,None,*)"CircularEmbedding","HighDimensionalEmbedding","LayeredDrawing","LinearEmbedding","RadialEmbedding","RandomEmbedding","SpiralEmbedding","SpringElectricalEmbedding","SpringEmbedding"};
$PACKINGLAYOUTS={"ClosestPacking","ClosestPackingCenter","Layered","LayeredLeft","LayeredTop","NestedGrid"};
layoutopt[c_,p_]:=GraphLayout-> {"ComponentLayout"->$COMPONENTLAYOUTS[[ c]],"PackingLayout"-> $PACKINGLAYOUTS[[p]]};
In[4]:= words=DictionaryLookup["*zz"];
In[5]:= graph0=Flatten[Map[(Thread[#\[DirectedEdge]DeleteCases[Nearest[words,#,3],#]])&,words]];
i=RandomInteger[{1,Length[graph0]}];
graph0[[i]]
graph1=Drop[graph0,{i}];
Out[7]= tizz\[DirectedEdge]fizz
In[18]:= g0[i_,j_]:=Graph[graph0,VertexLabels->"Name",ImagePadding->20,ImageSize->200,layoutopt[i,j]];
g1[i_,j_]:=Graph[graph1,VertexLabels->"Name",ImagePadding->20,ImageSize->200,layoutopt[i,j]]
Column[Grid/#Table[
{
$COMPONENTLAYOUTS[[c]],
$PACKINGLAYOUTS[[p]],
g0[c,p],
g1[c,p]
},
{c,1,Length[$COMPONENTLAYOUTS]},
{p,1,Length[$PACKINGLAYOUTS]}
]]
This is at best a partial answer. Also, I am working with Mma 7.
If I modify a graph such that it now contains an 'orphan' vertex (no connecting edges) but I still want to show the vertex on a new graph, this may be done by converting to an adjacency matrix (as originally pointed out by Carl Woll)
For example:
gr1 = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5, 5 -> 6, 6 -> 1};
gplot1 = GraphPlot[gr1, Method -> "CircularEmbedding",
VertexLabeling -> True]
Defining a new graph, gr2, as follows:
gr2 = {2 -> 3, 3 -> 4, 4 -> 5, 5 -> 6}
A new plot showing vertex 1 may be generated as follows, for example:
Needs["GraphUtilities`"];
gplot2 =
GraphPlot[SparseArray#Map[# -> 1 &, EdgeList[gr2]],
VertexLabeling -> True,
VertexCoordinateRules ->
Thread[VertexList[gr1] ->
First#Cases[gp1, GraphicsComplex[points_, __] :> points,
Infinity]]]
giving