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!
Related
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'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.
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.
I spend a lot of time looking at larger matrices (10x10, 20x20, etc) which usually have some structure, but it is difficult to quickly determine the structure of them as they get larger. Ideally, I'd like to have Mathematica automatically generate some representation of a matrix that will highlight its structure. For instance,
(A = {{1, 2 + 3 I}, {2 - 3 I, 4}}) // StructureForm
would give
{{a, b}, {Conjugate[b], c}}
or even
{{a, b + c I}, {b - c I, d}}
is acceptable. A somewhat naive implementation
StructureForm[M_?MatrixQ] :=
MatrixForm # Module[
{pos, chars},
pos = Reap[
Map[Sow[Position[M, #1], #1] &, M, {2}], _,
Union[Flatten[#2, 1]] &
][[2]]; (* establishes equality relationship *)
chars = CharacterRange["a", "z"][[;; Length # pos ]];
SparseArray[Flatten[Thread /# Thread[pos -> chars] ], Dimensions[M]]
]
works only for real numeric matrices, e.g.
StructureForm # {{1, 2}, {2, 3}} == {{a, b}, {b, c}}
Obviously, I need to define what relationships I think may exist (equality, negation, conjugate, negative conjugate, etc.), but I'm not sure how to establish that these relationships exist, at least in a clean manner. And, once I have the relationships, the next question is how to determine which is the simplest, in some sense? Any thoughts?
One possibility that comes to mind is for each pair of elements generate a triple relating their positions, like {{1,2}, Conjugate, {2,1}} for A, above, then it becomes amenable to graph algorithms.
Edit: Incidentally, my inspiration is from the Matrix Algorithms series (1, 2) by Stewart.
We can start by defining the relationships that we want to recognize:
ClearAll#relationship
relationship[a_ -> sA_, b_ -> sB_] /; b == a := b -> sA
relationship[a_ -> sA_, b_ -> sB_] /; b == -a := b -> -sA
relationship[a_ -> sA_, b_ -> sB_] /; b == Conjugate[a] := b -> SuperStar[sA]
relationship[a_ -> sA_, b_ -> sB_] /; b == -Conjugate[a] := b -> -SuperStar[sA]
relationship[_, _] := Sequence[]
The form in which these relationships are expressed is convenient for the definition of structureForm:
ClearAll#structureForm
structureForm[matrix_?MatrixQ] :=
Module[{values, rules, pairs, inferences}
, values = matrix // Flatten // DeleteDuplicates
; rules = Thread[Rule[values, CharacterRange["a", "z"][[;; Length#values]]]]
; pairs = rules[[#]]& /# Select[Tuples[Range[Length#values], 2], #[[1]] < #[[2]]&]
; inferences = relationship ### pairs
; matrix /. inferences ~Join~ rules
]
In a nutshell, this function checks each possible pair of values in the matrix inferring a substitution rule whenever a pair matches a defined relationship. Note how the relationship definitions are expressed in terms of pairs of substitution rules in the form value -> name. Matrix values are assigned letter names, proceeding from left-to-right, top-to-bottom. Redundant inferred relationships are ignored assuming a precedence in that same order.
Beware that the function will run out of names after it finds 26 distinct values -- an alternate name-assignment strategy will be needed if that is an issue. Also, the names are being represented as strings instead of symbols. This conveniently dodges any unwanted bindings of the single-letter symbols names. If symbols are preferred, it would be trivial to apply the Symbol function to each name.
Here are some sample uses of the function:
In[31]:= structureForm # {{1, 2 + 3 I}, {2 - 3 I, 4}}
Out[31]= {{"a", "b"}, {SuperStar["b"], "d"}}
In[32]:= $m = a + b I /. a | b :> RandomInteger[{-2, 2}, {10, 10}];
$m // MatrixForm
$m // structureForm // MatrixForm
Have you tried looking at the eigenvalues? The eigenvalues reveal a great deal of information on the structure and symmetry of matrices and are standard in statistical analysis of datasets. For e.g.,
Hermitian/symmetric eigenvalues have
real eigenvalues.
Positive semi-definite matrices have
non-negative eigenvalues and vice versa.
Rotation matrices have complex eigenvalues.
Circulant matrices have eigenvalues that are simply the DFT of the first row. The beauty of circulant matrices is that every circulant matrix has the same set of eigenvectors. In some cases, these results (circulant) can be extended to Toeplitz matrices.
If you're dealing with matrices that are random (an experimental observation can be modeled as a random matrix), you could also read up on random matrix theory, which relates the distributions of eigenvalues to the underlying symmetries in the matrix and the statistical distributions of elements. Specifically,
The eigenvalue distribution of symmetric/hermitian Gaussian matrices is a [semicircle]
Eigenvalue distributions of Wishart matrices (if A is a random Gaussian matrix, W=AA' is a Wishart matrix) are given by the Marcenko-Pastur distribution
Also, the differences (spacings) between the eigenvalues also convey information about the matrix.
I'm not sure if the structure that you're looking for is like a connected graph within the matrix or something similar... I presume random matrix theory (which is more general and vast than those links will ever tell you) has some results in this regard.
Perhaps this is not really what you were looking for, but afaik, there is no one stop solution to getting the structure of a matrix. You'll have to use multiple tools to nail it down, and if I were to do it, eigenvalues would be my first pick.
What is the simplest way to map an arbitrarily funky nested list expr to a function unflatten so that expr==unflatten##Flatten#expr?
Motivation:
Compile can only handle full arrays (something I just learned -- but not from the error message), so the idea is to use unflatten together with a compiled version of the flattened expression:
fPrivate=Compile[{x,y},Evaluate#Flatten#expr];
f[x_?NumericQ,y_?NumericQ]:=unflatten##fPrivate[x,y]
Example of a solution to a less general problem:
What I actually need to do is to calculate all the derivatives for a given multivariate function up to some order. For this case, I hack my way along like so:
expr=Table[D[x^2 y+y^3,{{x,y},k}],{k,0,2}];
unflatten=Module[{f,x,y,a,b,sslot,tt},
tt=Table[D[f[x,y],{{x,y},k}],{k,0,2}] /.
{Derivative[a_,b_][_][__]-> x[a,b], f[__]-> x[0,0]};
(Evaluate[tt/.MapIndexed[#1->sslot[#2[[1]]]&,
Flatten[tt]]/. sslot-> Slot]&) ]
Out[1]= {x^2 y + y^3, {2 x y, x^2 + 3 y^2}, {{2 y, 2 x}, {2 x, 6 y}}}
Out[2]= {#1, {#2, #3}, {{#4, #5}, {#5, #7}}} &
This works, but it is neither elegant nor general.
Edit: Here is the "job security" version of the solution provided by aaz:
makeUnflatten[expr_List]:=Module[{i=1},
Function#Evaluate#ReplaceAll[
If[ListQ[#1],Map[#0,#1],i++]&#expr,
i_Integer-> Slot[i]]]
It works a charm:
In[2]= makeUnflatten[expr]
Out[2]= {#1,{#2,#3},{{#4,#5},{#6,#7}}}&
You obviously need to save some information about list structure, because Flatten[{a,{b,c}}]==Flatten[{{a,b},c}].
If ArrayQ[expr], then the list structure is given by Dimensions[expr] and you can reconstruct it with Partition. E.g.
expr = {{a, b, c}, {d, e, f}};
dimensions = Dimensions[expr]
{2,3}
unflatten = Fold[Partition, #1, Reverse[Drop[dimensions, 1]]]&;
expr == unflatten # Flatten[expr]
(The Partition man page actually has a similar example called unflatten.)
If expr is not an array, you can try this:
expr = {a, {b, c}};
indexes = Module[{i=0}, If[ListQ[#1], Map[#0, #1], ++i]& #expr]
{1, {2, 3}}
slots = indexes /. {i_Integer -> Slot[i]}
{#1, {#2, #3}}
unflatten = Function[Release[slots]]
{#1, {#2, #3}} &
expr == unflatten ## Flatten[expr]
I am not sure what you are trying to do with Compile. It is used when you want to evaluate procedural or functional expressions very quickly on numerical values, so I don't think it is going to help here. If repeated calculations of D[f,...] are impeding your performance, you can precompute and store them with something like
Table[d[k]=D[f,{{x,y},k}],{k,0,kk}];
Then just call d[k] to get the kth derivative.
I just wanted to update the excellent solutions by aaz and Janus. It seems that, at least in Mathematica 9.0.1.0 on Mac OSX, the assignment (see aaz's solution)
{i_Integer -> Slot[i]}
fails. If, however, we use
{i_Integer :> Slot[i]}
instead, we succeed. The same holds, of course, for the ReplaceAll call in Janus's "job security" version.
For good measure, I include my own function.
unflatten[ex_List, exOriginal_List] :=
Module[
{indexes, slots, unflat},
indexes =
Module[
{i = 0},
If[ListQ[#1], Map[#0, #1], ++i] &#exOriginal
];
slots = indexes /. {i_Integer :> Slot[i]};
unflat = Function[Release[slots]];
unflat ## ex
];
(* example *)
expr = {a, {b, c}};
expr // Flatten // unflatten[#, expr] &
It might seem a little like a cheat to use the original expression in the function, but as aaz points out, we need some information from the original expression. While you don't need it all, in order to have a single function that can unflatten, all is necessary.
My application is similar to Janus's: I am parallelizing calls to Simplify for a tensor. Using ParallelTable I can significantly improve performance, but I wreck the tensor structure in the process. This gives me a quick way to reconstruct my original tensor, simplified.