I have the following dataset:
dataset =
Dataset[{<|"City" -> "Belgrade" , "Population" -> 1500000|>, <|
"City" -> "Ljubljana", "Population" -> 300000|>, <|
"City" -> "Sarajevo", "Population" -> 275000|>, <|
"City" -> "Zagreb", "Population" -> 800000|>, <|
"City" -> "Skopje", "Population" -> 530000|>, <|
"City" -> "Podgorica", "Population" -> 180000|>}]
I want to construct proximity matrix out of it, using Euclidean Distance (function in Wolfram Mathematica: EuclideanDistance) between the city populations. I had some trials but it didn't work out in the end. Anyone has an idea?
Thank you in advance!
Try
pop=Normal[dataset[All,"Population"]];
MatrixPlot[Outer[Sqrt[(#1-#2)^2]&,pop,pop]]
which I think implements EuclidianDistance
Adding FrameTicks and using EuclideanDistance.
pop = Normal[dataset[All, "Population"]];
cities = Normal[dataset[All, "City"]];
ticks = List ### Thread[Range#Length#cities -> (Style[#, 14, Black] &) /# cities]
MatrixPlot[Outer[EuclideanDistance[##] &, pop, pop],
FrameTicks -> {ticks, ticks, ticks, ticks},
Mesh -> True,
MeshStyle -> Black,
ImageSize -> 600]
Related
Does anyone know the Mathematica code that will trace the graph below?
Here is the equation for the graph, a second order linear differential equation with constant coefficients:
Here is the graph traced by this equation:
Quote from the book "Times Series Analysis and Forecasting By Example":
... where δ(t ) is an impulse (delta) function that, like a pea shot, at
time t = 0 forces the pendulum away from its equilibrium and a is the
size of the impact by the pea. It is easy to imagine that the curve
traced by this second order differential equation is a damped
sinusoidal function of time although, if the friction or viscosity is
sufficiently large, the (overdamped) pendulum may gradually come to
rest following an exponential curve without ever crossing the
centerline.
eq = m z''[t] + c z'[t] + k z[t] == a DiracDelta[t];
parms = {m -> 1, c -> .1, k -> 1, a -> 1};
sol = First#DSolve[{eq /. parms, z[0] == 1, z'[0] == 0}, z[t], t];
Plot[z[t] /. sol, {t, 0, 70}, PlotRange -> All, Frame -> True,
FrameLabel -> {{z[t], None}, {Row[{t, " (sec)"}], eq}},
GridLines -> Automatic]
Notice that, for zero initial conditions, another option is to use the Control system functions in Mathematica as follows
parms = {m -> 10, c -> 1.2, k -> 4.3, a -> 1};
tf = TransferFunctionModel[a/(m s^2 + c s + k) /. parms, s]
sol = OutputResponse[tf, DiracDelta[t], t];
Plot[sol, {t, 0, 60}, PlotRange -> All, Frame -> True,
FrameLabel -> {{z[t], None}, {Row[{t, " (sec)"}], eq}},
GridLines -> Automatic]
Update
Strictly speaking, the result of DSolve above is not what can be found by hand derivation of this problem. The correct solution should come out as follows
(see this also for reference)
The correct analytical solution is given by
which I derived for this problem and similar cases in here (first chapter).
Using the above solution, the correct response will look like this:
parms = {m -> 1, c -> .1, k -> 1, a -> 1};
w = Sqrt[k/m];
z = c/(2 m w);
wd = w Sqrt[1 - z^2];
analytical =
Exp[-z w t] (u0 Cos[wd t] + (v0 + (u0 z w))/wd Sin[wd t] +
a/(m wd) Sin[wd t]);
analytical /. parms /. {u0 -> 1, v0 -> 0}
(* E^(-0.05 t) (Cos[0.998749 t] + 1.05131 Sin[0.998749 t]) *)
Plotting it:
Plot[analytical /. parms /. {u0 -> 1, v0 -> 0}, {t, 0, 70},
PlotRange -> All, Frame -> True,
FrameLabel -> {{y[t], None}, {Row[{t, " (sec)"}],
"analytical solution"}}, GridLines -> Automatic, ImageSize -> 300]
If you compare the above plot with the first one shown above using DSolve you can see the difference near t=0.
I am trying show a series of plots in the same figure using Mathematica 8 with Show[p1, p2, PlotRange -> All], but the y axis label (ranging from log 0.5 to log 1.5) appears non-uniform. How can I correct the axis label to be uniform?
I've included an example with two plots (dataPlot3 and dataPlot4), but I am trying to show more in the same figure.
Show uses the options from the first graphic specified, including PlotRange and Ticks. You can specify an explicit PlotRange in the creation of the first plot that encompasses the range of both data sets and appropriate ticks will be generated to cover it:
d1 = Table[x^2, {x, 50}];
d2 = Table[50 + x^3, {x, 50}];
p1 = ListLogLogPlot[d1, PlotStyle -> Red, PlotRange -> {1, 200000}]
p2 = ListLogLogPlot[d2, PlotStyle -> Black]
Show[p1, p2]
I have a collection of sets that I'd like to place in a trie.
Normal tries are made of strings of elements - that is, the order of the elements is important. Sets lack a defined order, so there's the possibility of greater compression.
For example, given the strings "abc", "bc", and "c", I'd create the trie:
(*,3) -> ('a',1) -> ('b',1) -> ('c',1)
-> ('b',1) -> ('c',1)
-> ('c',1)
But given the sets { 'a', 'b', 'c' }, { 'b', 'c' }, { 'c' }, I could create the above trie, or any of these eleven:
(*,3) -> ('a',1) -> ('b',1) -> ('c',1)
-> ('c',2) -> ('a',1)
(*,3) -> ('a',1) -> ('c',1) -> ('b',1)
-> ('b',1) -> ('c',1)
-> ('c',1)
(*,3) -> ('a',1) -> ('c',1) -> ('b',1)
-> ('c',2) -> ('a',1)
(*,3) -> ('b',2) -> ('a',1) -> ('c',1)
-> ('c',1)
-> ('c',1)
(*,3) -> ('b',1) -> ('a',1) -> ('c',1)
-> ('c',2) -> ('b',1)
(*,3) -> ('b',2) -> ('c',2) -> ('a',1)
-> ('c',1)
(*,3) -> ('b',1) -> ('c',1) -> ('a',1)
-> ('c',2) -> ('b',1)
(*,3) -> ('c',2) -> ('a',1) -> ('b',1)
-> ('b',1) -> ('c',1)
(*,3) -> ('c',2) -> ('a',1) -> ('b',1)
-> ('b',1)
(*,3) -> ('c',2) -> ('b',1) -> ('a',1)
-> ('b',1) -> ('c',1)
(*,3) -> ('c',3) -> ('b',2) -> ('a',1)
So there's obviously room for compression (7 nodes to 4).
I suspect defining a local order at each node dependent on the relative frequency of its children would do it, but I'm not certain, and it might be overly expensive.
So before I hit the whiteboard, and start cracking away at my own compression algorithm, is there an existing one? How expensive is it? Is it a bulk process, or can it be done per-insert/delete?
I think you should sort a set according to item frequency and this get a good heuristics as you suspect. The same approach using in FP-growth (frequent patterns mining) for representing in compact way the items sets.
Basically you should construct a dependence graph. If element y occurs only if x occurs, draw an edge from x to y (in case of equality, just order lexicographically). The resulting graph is a DAG. Now, do a topological sorting of this graph to get the order of the elements with a twist. Whenever you can choose one of the two (or more elements) choose the one with higher number of occurrences.
My suspiscion is that the maximum compression would keep the most common elements at the top (as in your last example).
The compression algorithm would start with the whole collection of sets and the top node, and recursively create nodes for each subset containing the most common elements
Compress(collection, node):
while NOT collection.isEmpty?
e = collection.find_most_common_element
c2 = collection.find_all_containing(e)
collection = collection - c2
if e==NIL //empty sets only
node[END_OF_SET]=node
else
c2.each{set.remove(e)}
node[e]=new Node
Compress(c2,node[e])
end
end
The resulting tree would have a special End-of-set marker to signify that a complete set ends at that node. For your example it would be
*->(C,3)->(B,2)->(A,1)->EOS
->EOS
->EOS
Deleting a set is easy, just remove it's EOS marker (and any parent nodes that become empty). You could insert on the fly - at each node, descend to the matching element with the most children until there are no matches, then use the algorithm above - but keeping it maximally compressed would be tricky. When element B gained more children than element A, you'd have to move all sets containing A & B into the B node, which would involve a full search of all of A's children. But if you don't keep it compressed, then the inclusion searches are no longer linear with the set size.
I want to add interactivity to Mathematica 3D graphics, other than with Manipulate which is cool but has its limitations. Think four example of a demo of the four cubes problem in Mathematica, a click on one of the cubes rotates a cube.
Questions.
Is it possible to catch MouseEvents in Mathematica graphics ( for example with using a Java class or otherwise? )
Or is the use Java then call Mathematica from Java the advised route?
Or ( I hope not ) is developing interactive graphics programs beyond of what one should do with Mathematica?
EventHandler can be used to catch various mouse events (mouse up, mouse down, mouse clicked, mouse dragged). Use MousePosition to add some intelligence.
Example:
DynamicModule[{col1 = Green, col2 = Blue}, Graphics[
{
EventHandler[
Dynamic[{col1, Disk[]},
ImageSize ->
Tiny], {"MouseClicked" :> (col1 =
col1 /. {Red -> Green, Green -> Red})}],
EventHandler[
Dynamic[{col2, Disk[{1, 1}]},
ImageSize ->
Tiny], {"MouseClicked" :> (col2 =
col2 /. {Blue -> Yellow, Yellow -> Blue})}]
}
]
]
The circles can be clicked independently. An action is defined for each object separately.
Amazingly, this even works for 3D Graphics:
DynamicModule[{col1 = Green, col2 = Blue},
Graphics3D[
{
EventHandler[
Dynamic[{col1, Sphere[]},
ImageSize ->
Tiny], {"MouseClicked" :> (col1 =
col1 /. {Red -> Green, Green -> Red})}],
EventHandler[
Dynamic[{col2, Sphere[{1, 1, 1}]},
ImageSize ->
Tiny], {"MouseClicked" :> (col2 =
col2 /. {Blue -> Yellow, Yellow -> Blue})}]
}
]
]
I'm stuck on a conversion.
I have a KMZ file with some coordinates. I read the file like this:
m=Import["~/Desktop/locations.kmz","Data"]
I get something like this:
{{LayerName->Point Features,
Geometry->{
Point[{-120.934,49.3321,372}],
Point[{-120.935,49.3275,375}],
Point[{-120.935,49.323,371}]},
Labels->{},LabeledData->{},ExtendedData->{},
PlacemarkNames->{1,2,3},
Overlays->{},NetworkLinks->{}
}}
I want to extract the {x,y,z} from each of the points and also the placemark names {1,2,3} associated with the points. Even if I can just get the points out of Geometry->{} that would be fine because I can extract them into a list with List###, but I'm lost at the fundamental part where I can't extract the Geometry "Rule".
Thanks for any help,
Ron
While Leonid's answer is correct, you will likely find that it does not work with your code. The reason is that the output of your Import command contains strings, such as "LayerNames", rather than symbols, such as LayerNames. I've uploaded a KML file to my webspace so we can try this using an actual Import command. Try something like the following:
in = Import["http://facstaff.unca.edu/mcmcclur/my.kml", "Data"];
pointList = "Geometry" /.
Cases[in, Verbatim[Rule]["Geometry", _], Infinity];
pointList /. Point[stuff_] -> stuff
Again, note that "Geometry" is a string. In fact, the contents of in look like so (in InputForm):
{{"LayerName" -> "Waypoints",
"Geometry" -> {Point[{-82.5, 32.5, 0}]},
"Labels" -> {}, "LabeledData" -> {},
"ExtendedData" -> {}, "PlacemarkNames" -> {"asheville"},
"Overlays" -> {}, "NetworkLinks" -> {}}}
Context: KML refers to Keyhole Markup Language. Keyhole was a company that developed tools that ultimately became Google Earth, after they were acquired by Google. KMZ is a zipped version of KML.
A simplification to Leonid and Mark's answers that I believe can be made safely is to remove the fancy Verbatim construct. That is:
Leonid's first operation can be written:
Join ## Cases[expr, (Geometry -> x_) :> (x /. Point -> Sequence), Infinity]
Leonid's second operation:
Join ## Cases[expr, (PlacemarkNames -> x_) :> x, Infinity]
I had trouble importing Mark's data, but from what I can guess, one could write:
pointList = Cases[in, ("Geometry" -> x_) :> x, Infinity, 1]
I'll let the votes on this answer tell me if I am correct.
Given your expression
expr = {{LayerName -> Point Features,
Geometry -> {
Point[{-120.934, 49.3321, 372}],
Point[{-120.935, 49.3275, 375}],
Point[{-120.935, 49.323, 371}]},
Labels -> {}, LabeledData -> {}, ExtendedData -> {},
PlacemarkNames -> {1, 2, 3}, Overlays -> {}, NetworkLinks -> {}}}
This will extract the points:
In[121]:=
Flatten[Cases[expr, Verbatim[Rule][Geometry, x_] :> (x /. Point -> Sequence),
Infinity], 1]
Out[121]= {{-120.934, 49.3321, 372}, {-120.935, 49.3275,375}, {-120.935, 49.323, 371}}
And this will extract the placemarks:
In[124]:= Flatten[Cases[expr, Verbatim[Rule][PlacemarkNames, x_] :> x, Infinity], 1]
Out[124]= {1, 2, 3}
Here is a more elegant method exploiting that we are looking for rules, that will extract both:
In[127]:=
{Geometry, PlacemarkNames} /.Cases[expr, _Rule, Infinity] /. Point -> Sequence
Out[127]=
{{{-120.934, 49.3321, 372}, {-120.935, 49.3275,375}, {-120.935, 49.323, 371}}, {1, 2, 3}}
How about Transpose[{"PlacemarkNames", "Geometry"} /. m[[1]]] ?