I've been playing around with Mathematica's visualization and webcrawling capabilities. Building on some demonstration code, I'm able to visualize the a network. Here's an example on a university webpage:
webcrawler[rooturl_, depth_] :=
Flatten[Rest[NestList[
Union[Flatten[Thread[# -> Import[#,"Hyperlinks"]] & /# Last /# #]] &,
{"" -> rooturl}, depth]]];
Graph[webcrawler[
"http://www.yorku.ca/", 2], {ImageSize -> Full}]
However, I've been trying fruitlessly to figure out a way to apply EdgeLabels[] to this Graph[] command. I would like to have each link written on each line, just to give a sense of what exactly the link clusters represent.
I've tried applying a generated list of the Hyperlink connections to it, which didn't work, and neither did any of the readily obvious commands from documentation/elsewhere on stack/the cookbook.
I envision a very cluttered output.
I don't know in case of a large graph how will the edge label look. But here how it can be done in Mathematica 8.
webcrawler[rooturl_, depth_] :=
Flatten[Rest[
NestList[
Union[Flatten[
Thread[# -> Import[#, "Hyperlinks"]] & /#
Last /# #]] &, {"" -> rooturl}, depth]]];
dats = webcrawler["http://www.uni-kl.de/", 2];
Graph[dats ,EdgeLabels ->Table[dats[[i]] -> dats[[i]][[2]],
{i,Length[dats]}], {ImageSize -> Full}]
I hope this helps.
BR
Place EdgeLabels inside Tooltips
The following will display the names of both the edges and the vertices as tooltips. (You can remove the VertexLabels, of course. I included them because the EdgeLabels were often very long.)
data = webcrawler["http://www.yorku.ca/", 2];
Graph[data,
EdgeLabels -> Placed["Name", Tooltip],
EdgeShapeFunction -> "Line",
VertexLabels -> Placed["Name", Tooltip],
EdgeStyle -> {Orange},
VertexSize -> {"Scaled", 0.007},
ImageSize -> 800]
It should be helpful for browsing the network. But of course, it will not print out the labels.
Related
How can one extract the coordinates of all the points which make up the following graphics (here just an example)?
spl = BSplineCurve[{{-.4, -.3}, {0, -.6}, {.4, -.3}, {0, -1.2}},
SplineClosed -> True] ;
Graphics[{Red, Thick, spl}]
The problem is that if I add //FullForm to the last line there is no point coordinates in the output, so no pattern to use to make that extraction:
With a Plotor CoutourPlot output I would have coded Flatten[Cases[Normal#output, Line[x_] :> x, Infinity], 1]
which is not possible here.
The b-spline is itself a graphics primitive so you cant pull out the "line" like that.
You need to use the related BSplineFunction to generate your points:
pts=BSplineFunction[{{-.4, -.3}, {0, -.6}, {.4, -.3}, {0, -1.2}},
SplineClosed -> True] /# Range[0, 1, .01];
Graphics#Line#pts
If you need to extract from a graphic you can do this:
Cases[graphics, BSplineCurve[a__] :> BSplineFunction[a], Infinity]
but you still need to feed it a table of parameter values to get your points.
To extract just the control points you can go:
curveData=Cases[graphics, BSplineCurve[a__] :> a, Infinity]
how many BSplineCurves were found in the graphic?
Length[curveData]
here are the control points of one of them
curveData// First // MatrixForm
If you have a list of BSplineFunctions you can find out much more
so first convert the BSplineCurves to BSplineFunctions as the previous post
bfs =Cases[graphics, BSplineCurve[a__] :> BSplineFunction[a], Infinity]
then you could just go
Inputform[bfs]
and parse the result, but it is cleaner to go:
cdata = Cases[bfs, BSplineFunction[a__] :> a, Infinity];
d = Partition[cdata, 9];
This is Mathematica 11. other versions may need different partitioning
each element of d will be something like:
d[[1]] // MatrixForm
1
{{0.,1.}}
{3}
{False}
{{{0.,0.,0.},{0.,298.986,167.077},{0.,497.083,497.459},{0.,503.603,839.898}},Automatic}
{{0.,0.,0.,0.,1.,1.,1.,1.}}
{0}
MachinePrecision
Unevaluated
The 5th element contains the control point coordinates. The sixth corresponds to the knots. The other elements look familiar but let us not post our guesses!
I'm new in system Wolfram Mathematica 9.0 and I want to make table with horizontal approaches. And I had made only vertical ones. Now I will show you:
You did not show the input that produced the undesired output, but I assume it is something like this:
xx = {4, 16};
yy = {3, 5};
TableForm[{{xx}, {yy}}, TableHeadings -> {{"x", "y"}, None}]
To get the output you desire you merely need to leave out the extraneus set of List brackets ({}) around each expression. You can also omit None as this is inferred.
TableForm[{xx, yy}, TableHeadings -> {{"x", "y"}}]
You could also expressly specify the directions with TableDirections:
TableForm[{{xx}, {yy}},
TableHeadings -> {{"x", "y"}},
TableDirections -> {Column, Row, Row}
]
This earlier answer of mine illustrates the way that TableForm formats nested lists:
https://stackoverflow.com/a/5011242/618728
I am using NDSolve[] to integrate an orbital trajectory (with ExplicitRungeKutta). Mathematica gives me
{{x[t]->InterpolatingFunction[{{0.,2000.}},<>][t],
y[t]->InterpolatingFunction[{{0.,2000.}},<>][t]}}
My question is how do I get this into table of raw data where t=0,1,2...2000?
I tried:
path = Table[Solved, {t, 0, tmax}];
But I get a huge table of stuff like this:
{{{x[0] -> -0.523998, y[0] -> 0.866025}}, {{x[1] -> -0.522714,
y[1] -> 0.886848}}, {{x[2] -> -0.480023,
y[2] -> 0.951249}}, {{x[3] -> -0.369611, y[3] -> 1.02642}}
I want something like:
{{{-0.523998, 0.866025}}, {{-0.522714, 0.886848}}, etc
I don't have a lot of experience working with these Interpolating functions, any help would be appreciated.
You are getting back rules, not functions directly. In order to access the interpolating functions themselves, you need to do a rule replacement.
Instead of
Table[Solved, {t, 0, tmax}]
you need
Table[Evaluate[{x[t], y[t]} /. Solved], {t, 0, tmax}];
Solved (which I assume is the output of NDSolve) is just a list of rules which will allow for the expressions x[t] and y[t] to be replaced by the corresponding interpolating functions, which you then evaluate.
Check out the F1 help for NDSolve for more examples.
You could try using the PropertyValue[] function if you are interested in the points that were used to interpolate - which sometimes is interesing when using NDSolve[]. See the example below:
x = Range[1, 10];
y = x^2;
pts = Transpose[{x, y}];
f = Interpolation[pts];
Plot[f[t], {t, 1, 10}]
(*getting the coordinates*)
X = PropertyValue[f, "Coordinates"][[1]]
Y = PropertyValue[f, "ValuesOnGrid"]
ListPlot[Transpose[{X, Y}]]
In such way you can extract almost any properties of any object. To get the list of properties use PropertyList[] function. In the above example it returns:
PropertyList[f]
{"Coordinates", "DerivativeOrder", "Domain", "ElementMesh",
"Evaluate", "GetPolynomial", "Grid", "InterpolationMethod",
"InterpolationOrder", "MethodInformation", "Methods",
"OutputDimensions", "Periodicity", "PlottableQ", "Properties",
"QuantityUnits", "Unpack", "ValuesOnGrid"}
I want to implement simple classification tree (binary classification) using Mathematica.
How can I implement a binary tree in Mathematica? Is there is a symbol for doing that?
I'd say it depends on what you want to do with the data structure.
You can exploit the fact that Mathematica expressions themselves are trees.
If only the leaf nodes are relevant, then use nested lists, e.g. {{1, {2, 3}}, 4}. If the other node need to carry some data too, then you can use something like this:
tree[1][tree[2][a, b], tree[3][c, tree[4][d, e]]]
See the structure like this:
{{1, {2, 3}}, 4} // TreeForm
tree[1][tree[2][a, b], tree[3][c, tree[4][d, e]]] // TreeForm
The next question is how to implement algorithm X on such a data structure.
Among the new objects in MMA 8 are TreeGraph, CompleteKaryTree, and KaryTree. The latter two objects give binary trees by default. I don't know how efficient they are for intensive computation but they do seem well-suited for displaying classifications. And there are many predicates and options for manipulating and displaying them.
Here's an example of a classification tree from [Breiman, L. Classification and Regression Trees: Chapman & Hall/CRC, 1984.]. It concerns 3 questions to determine whether a cardiac patient is likely to die within 30 days if not treated.
KaryTree[9, 2,
VertexLabels -> {1 -> "Blood pressure > 91 ?", 2 -> "Age > 62.5?",
4 -> "Sinus tachycardia ?", 8 -> "< 30 days"},
EdgeLabels -> {1 \[UndirectedEdge] 2 -> "yes",
1 \[UndirectedEdge] 3 -> "no", 2 \[UndirectedEdge] 4 -> "yes",
2 \[UndirectedEdge] 5 -> "no", 4 \[UndirectedEdge] 8 -> "yes",
4 \[UndirectedEdge] 9 -> "no"}, ImagePadding -> 20]
I'd like to get rid of the two unused nodes on the right, but have not figured out a an elegant way to do it. So I think I'll post a simple question about that on SO.
Personally I don't quite know, but there appears to be an article about the very subject on the Wolfram site, found here. It might not answer your question, but it will hopefully give you some insight!
Some types of objects have special input/output formatting in Mathematica. This includes Graphics, raster images, and, as of Mathematica 8, graphs (Graph[]). Unfortunately large graphs may take a very long time to visualize, much longer than most other operations I'm doing on them during interactive work.
How can I prevent auto-layout of Graph[] objects in StandardForm and TraditionalForm, and have them displayed as e.g. -Graph-, preferably preserving the interpretability of the output (perhaps using Interpretation?). I think this will involve changing Format and/or MakeBoxes in some way, but I was unsuccessful in getting this to work.
I would like to do this in a reversible way, and preferably define a function that will return the original interactive graph display when applied to a Graph object (not the same as GraphPlot, which is not interactive).
On a related note, is there a way to retrieve Format/MakeBoxes definitions associated with certain symbols? FormatValues is one relevant function, but it is empty for Graph.
Sample session:
In[1]:= Graph[{1->2, 2->3, 3->1}]
Out[1]= -Graph-
In[2]:= interactiveGraphPlot[%] (* note that % works *)
Out[2]= (the usual interactive graph plot should be shown here)
Though I do not have Mathematica 8 to try this in, one possibility is to use this construct:
Unprotect[Graph]
MakeBoxes[g_Graph, StandardForm] /; TrueQ[$short] ^:=
ToBoxes#Interpretation[Skeleton["Graph"], g]
$short = True;
Afterward, a Graph object should display in Skeleton form, and setting $short = False should restore default behavior.
Hopefully this works to automate the switching:
interactiveGraphPlot[g_Graph] := Block[{$short}, Print[g]]
Mark's concern about modifying Graph caused me to consider the option of using $PrePrint. I think this should also prevent the slow layout step from taking place. It may be more desirable, assuming you are not already using $PrePrint for something else.
$PrePrint =
If[TrueQ[$short], # /. _Graph -> Skeleton["Graph"], #] &;
$short = True
Also conveniently, at least with Graphics (again I cannot test with Graph in v7) you can get the graphic with simply Print. Here, shown with Graphics:
g = Plot[Sin[x], {x, 0, 2 Pi}]
(* Out = <<"Graphics">> *)
Then
Print[g]
I left the $short test in place for easy switching via a global symbol, but one could leave it out and use:
$PrePrint = # /. _Graph -> Skeleton["Graph"] &;
And then use $PrePrint = . to reset the default functionality.
You can use GraphLayout option of Graph as well as graph-constructors to suppress the rendering. A graph can still be visualized with GraphPlot. Try the following
{gr1, gr2, gr3} = {RandomGraph[{100, 120}, GraphLayout -> None],
PetersenGraph[10, 3, GraphLayout -> None],
Graph[{1 -> 2, 2 -> 3, 3 -> 1}, GraphLayout -> None]}
In order to make working easier, you can use SetOptions to set GraphLayout option to None for all graph constructors you are interested in.
Have you tried simply suppressing the output? I don't think that V8's Graph command does any layout, if you do so. To explore this, we can generate a large list of edges and compare the timings of graph[edges];, Graph[edges];, and GraphPlot[edges];
In[23]:= SeedRandom[1];
edges = Union[Rule ### (Sort /#
RandomInteger[{1, 5000}, {50000, 2}])];
In[25]:= t = AbsoluteTime[];
graph[edges];
In[27]:= AbsoluteTime[] - t
Out[27]= 0.029354
In[28]:= t = AbsoluteTime[];
Graph[edges];
In[30]:= AbsoluteTime[] - t
Out[30]= 0.080434
In[31]:= t = AbsoluteTime[];
GraphPlot[edges];
In[33]:= AbsoluteTime[] - t
Out[33]= 4.934918
The inert graph command is, of course, the fastest. The Graph command takes much longer, but no where near as long as the GraphPlot command. Thus, it seems to me that Graph is not, in fact, computing the layout, as GraphPlot does.
The logical question is, what is Graph spending it's time on. Let's examine the InputForm of Graph output in a simple case:
Graph[{1 -> 2, 2 -> 3, 3 -> 1, 1 -> 4}] // InputForm
Out[123]//InputForm=
Graph[{1, 2, 3, 4},
{DirectedEdge[1, 2],
DirectedEdge[2, 3],
DirectedEdge[3, 1],
DirectedEdge[1, 4]}]
Note that the vertices of the graph have been determined and I think this is what Graph is doing. In fact, the amount of time it took to compute Graph[edges] in the first example, comparable to the fastest way that I can think to do this:
Union[Sequence ### edges]; // Timing
This took 0.087045 seconds.