Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions from all groups sorted by active[GIF] Toss (Projectile envelope)
http://community.wolfram.com/groups/-/m/t/1077609
![Projectile envelope][1]
**Toss**
Inspired by [Example 5 from the Wikipedia article on "Envelope (mathematics)"][2]. Basically: if you throw a projectile from the origin with initial speed $v$ and initial angle $\theta$ subject to gravitational acceleration $g$, then its trajectory as a function of $t$ is given by:
Trajectory[t_, v_, g_, θ_] := {t v Cos[θ], t v Sin[θ] - g/2 t^2};
All such trajectories are tangent to the parabola $y=\frac{v^2}{2g}-\frac{g}{2v}x^2$, so the parabola is the envelope of the family of trajectories.
The animation shows a number of trajectories simultaneously, and the resulting envelope emerges without ever being explicitly drawn.
Note that the animation is _not_ to scale: I've used `AspectRatio -> 1` to scale the vertical axis to get proportions that work better for a square image. A more physically realistic animation is:
![More realistic projectile envelope][3]
The code is below, but I want to point out a couple of quirks. I originally used `ParametricPlot` rather than `Graphics`, which is conceptually simpler, but there seems to be a bug in the interaction of `CapForm` and `ParametricPlot` which makes it basically impossible to get endcaps to look right.
Consequently, I re-implemented the trajectories as a table of `Line`s, which mostly works okay, except that you can't really use transparency with concatenated lines unless you use `CapForm["Butt"]` or `CapForm[None]`: for example, with `CapForm["Round"]` the lines overlap, creating spots of increased opacity. This can make for a cool visual effect, but doesn't lend itself to a nice smooth gradient. Unfortunately, using `CapForm["Butt"]` leaves tiny gaps between the adjacent line segments, which I obscured by exporting the original GIF at 2160x2160 and then resizing down to 540x540.
Anyway, hopefully that explains most of the oddities in the code, which is not exactly speedy:
DynamicModule[{v = 1., g = 10., n = 101, timesteps = 75, transparencypoint = 3/2, pts,
cols = RGBColor /@ {"#393C83", "#C84771", "#FFE98A", "#280B45"}},
pts = Join[
Table[Trajectory[t, v, g, θ], {θ, 0., π/2, π/n}, {t, 0., 2 v/g, 2 v/(timesteps*g)}],
Table[Trajectory[t, v, g, θ], {θ, π + 0., π/2, -π/n}, {t, 0., 2 v/g, 2 v/(timesteps*g)}]];
Manipulate[
Graphics[
{Thickness[.004],
Table[{
If[i == s, CapForm["Round"], CapForm["Butt"]],
Opacity[Min[1, transparencypoint + 2 (i - s)/timesteps]],
Blend[cols[[;; -2]], (i - 1)/(Length[pts[[1]]] - 1)],
Line[pts[[j, i ;; i + 1]]]},
{j, 1, Length[pts]}, {i, 1, Min[s, timesteps]}]},
ImageSize -> 540, PlotRange -> {6/5 {-v^2/g, v^2/g}, {0, 5/4 v^2/(2 g)}},
AspectRatio -> 1, Axes -> False, Background -> cols[[-1]]],
{s, 0, timesteps (1 + transparencypoint/2), 1}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=toss12Lsru.gif&userId=610054
[2]: https://en.wikipedia.org/wiki/Envelope_(mathematics)#Example_5
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=toss12LsRealisticr.gif&userId=610054Clayton Shonkwiler2017-04-29T22:24:48ZMathematica 11.0.1 now available for the Raspberry Pi
http://community.wolfram.com/groups/-/m/t/1028536
Hi all,
Mathematica 11.0.1 is now available for the Raspberry Pi on Raspbian. If you already have Mathematica installed on your Raspberry Pi, you can update with the following:
sudo apt-get update && sudo apt-get upgrade wolfram-engine
If you don't already have Mathematica installed you can run the following commands to install it:
sudo apt-get update && sudo apt-get install wolfram-engine
New features for the Raspberry Pi include :
- Neural Network features including constructing custom nets : http://reference.wolfram.com/language/guide/NeuralNetworks.html
- Audio processing features including out of core streaming of large sounds as well as advanced audio processing : http://reference.wolfram.com/language/guide/AudioProcessing.html
- Travel based path plan functions including path finding from one city to another : http://reference.wolfram.com/language/guide/LocationsPathsAndRouting.html
- Channel based communication for sending and receiving messages : http://reference.wolfram.com/language/guide/Channel-BasedCommunication.html
- Powerful and easy scripting through WolframScript : http://reference.wolfram.com/language/ref/program/wolframscript.html
- And many more : http://reference.wolfram.com/language/guide/SummaryOfNewFeaturesIn11.html
Additionally, with the new release of WolframScript on the Raspberry Pi, you can install WolframScript standalone and run it without a local kernel against the cloud using the `-cloud` option. This means you can use the Wolfram Language through WolframScript on the Raspberry Pi without having wolfram-engine installed by running it against the cloud. See the documentation page for WolframScript for more details.Ian Johnson2017-03-09T21:02:49ZLinux: Code wiggles when navigating through it
http://community.wolfram.com/groups/-/m/t/1075914
Nowadays, Mathematica highlights per default the enclosed function you are in by colouring the braces as well as the head. Unfortunately, since version 11.0 this seems to have a font problem. What happens is that the green background highlighting slightly changes the width of the font (at least it seems so). When you now browse through your code and the enclosing function changes because you move the cursor inside a different function, several lines are slightly shifted. Let me give an example where you need to pay attention how several lines wiggle when I move the cursor:
![enter image description here][1]
This might be a minor annoyance but believe me, it drives you crazy when you edit a large portion of code. I tried to fix it by changing the style of the highlighting but I had no success. I reset Mathematica with `mathematica -cleanstart` but that didn't change a thing.
It is probably my own fault since I didn't report it in the pre-release but this issue seemed so obvious to me that I thought it will definitely be fixed in the release. Now, we already have 11.1.1 out and the bug still persists. Is it only me or do other Linux users have the same problem?
I'm on XUbuntu 16.04 with the latest Mathematica. Any thoughts?
## Edit
I have filed a bug-report **[CASE:3884553]**
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=wiggle.mp4.gif&userId=44126Patrick Scheibe2017-04-27T23:37:02ZHow to write this program Hermite correctly to vary n and m from 0 to 10 ?
http://community.wolfram.com/groups/-/m/t/1077585
How to write this program correctly to vary n and m from 0 to 10 in mathematica 11 i need to the correct program
f = (HermiteH[n, x])^2*Exp[-x^2]*(HermiteH[m, y])^2*Exp[-y^2], {n, 0, 10}, {m, 0, 10}n n2017-04-29T17:59:18ZWhat´s wrong?
http://community.wolfram.com/groups/-/m/t/1077522
Hello everyone! I have this problem...
EQS = D[S[t],
t] == -\[ScriptA]*S[t]*Inf[t]/\[ScriptCapitalN] - \[ScriptCapitalQ]
EQI = D[Inf[t],
t] == \[ScriptA]*S[t]*
Inf[t]/\[ScriptCapitalN] - \[ScriptCapitalQ] - (\[Theta] + \
\[Alpha])*Inf[t]
EQQ = D[Q[t], t] == \[Theta]*Inf[t] - \[Gamma]\[ScriptCapitalQ]
EQR = D[R[t], t] == \[Alpha]*Inf[t] + \[Gamma]\[ScriptCapitalQ]
CIS = S[t] == S0 /. t -> 0
CII = Inf[t] == Inf0 /. t -> 0
CIR = R[t] == R0 /. t -> 0
CIQ = S[t] == S0 /. t -> 0
\[ScriptCapitalN] = \[ScriptCapitalS] + \[ScriptCapitalI] + \
\[ScriptCapitalR] + \[ScriptCapitalQ]
What´s wrong?GUILHERME destro2017-04-29T15:05:18ZWhy does this series have imaginary terms?
http://community.wolfram.com/groups/-/m/t/1077452
I am trying to construct a series around infinity and I get the following result:
In[14]:= Normal@Series[ Sqrt[2 Pi x] BesselI[3, x]/Exp[x], {x, \[Infinity], 3}, Assumptions -> (x > 0)]
Out[15]=(-I + E^(2*x)*(1 + 945/(128*x^2) - 35/(8*x)) - (945*I)/(128*x^2) - (35*I)/(8*x))/E^(2*x)
Notice that x is assumed real which means that the result should not not have any imaginary terms but it does. What is going on here? And what is the best way to get rid of these terms?David Sagan2017-04-29T16:08:32ZHow can i fix the constant in equations?
http://community.wolfram.com/groups/-/m/t/1077564
i tried to plot i(t)=e^((-Rt+C)/L)
constants are R,C,L
but wolfram alpha did not work out.
how can i fix the constant ??Sanghyun Kim2017-04-29T15:51:39ZPlot fractional beam energy concentrated inside the rectangular spot Hermit
http://community.wolfram.com/groups/-/m/t/1075431
I have to trace Fractional beam energy concentrated inside the rectangular spot as a function of m and n for a Hermite Gaussian beam. with mathimatica But I do not know how to do,In the article of Spot size and divergence for Hermite Gaussian beams of any order of William H. Carter obtained the table of the energy, I must write a mathematica program to trace the energies according to M and n
![enter image description here][1]
This table was obtained with this formula
f = (HermiteH[n, x])^2*Exp[-x^2]*(HermiteH[m, y])^2*Exp[-y^2]
Intf = Integrate[f, {x, -Sqrt[2 l + 1], Sqrt[2 l + 1]}, {y, -Sqrt[2 l + 1],Sqrt[2 l + 1]}, {l, 0, 10}]
S = [Intf/(2^n*Sqrt[Pi]n!)(2^m*Sqrt[Pi]*m!), {n, 0, 10}, {m, 0, 10}]
How to fix this program to trace correctly Fractional beam energy concentrated inside the rectangular spot as a function of m and n for a Hermite Gaussian beam. with mathimatica
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=images.jpg&userId=1075050n n2017-04-27T12:43:48ZThe Global Terrorism Database (GTD)
http://community.wolfram.com/groups/-/m/t/1075841
In some of my recent posts I have looked at databases and information about crime and new articles world-wide. In particular news articles allow us to data mine incidents of specific events, such as terrorism related acts. In this post I will look at the data from a projet called the "[Global Terrorism Database][1]" (GTD) https://www.start.umd.edu/gtd/. The reference for the data base is here:
National Consortium for the Study of Terrorism and Responses to Terrorism (START). (2016). Global Terrorism Database [Data file]. Retrieved from https://www.start.umd.edu/gtd
Here is one of the animations you can generate:
![enter image description here][2]
The data can be downloaded as an xlsx spreadsheet. I have used the file generated in June 2016. I understand that the data is updated about six months after the end of the respective year. So my data is for 2015. It turns out that without increasing the heap space the file cannot be imported, so I will use the following
Needs["JLink`"]
SetOptions[InstallJava, JVMArguments -> "-Xmx32g"]
SetOptions[ReinstallJava, JVMArguments -> "-Xmx32g"]
ReinstallJava[]
to get a bit more of it. Now I can import the file (takes a little while).
gtdb = Import["/Users/thiel/Desktop/globalterrorismdb_0616dist.xlsx"];
Let's see how many entries we have:
gtdb[[1]] // Dimensions
So that is 156k events and lots of information on each of them. The total dataset has a ByteCount of
ByteCount[gtdb]
which is slightly less than 1.2 GB - the file itself is only about 77MB. Let's look at the information provided for each event.
Grid[{TableForm /@ Partition[Rule @@@ Transpose[{Range[Length[gtdb[[1, 1]]]], gtdb[[1, 1]]}], 34]}, Frame -> All, Background -> LightGray]
![enter image description here][3]
There is a "codebook" (https://www.start.umd.edu/gtd/downloads/Codebook.pdf) where the GTDB team provide more information about all of these entries. Most of the entries are quite straight forward to read. I will not go through every entry of the list now, but only use the ones I need. If in doubt, you can always consult the codebook.
Where do attacks happen?
------------------------
First we visualise where terrorism incidents happen in the world. Entries 14 and 15 are the longitude and latitude of an event. Here are the first 10 events:
gtdb[[1, -11 ;; -2, {14, 15}]]
![enter image description here][4]
I will use a representation I have now used in several other posts. I think that it is pretty intuitive to read.
toCoordinates[coords_] := FromSphericalCoordinates[{#[[1]], Pi/2 - #[[2]], Mod[Pi + #[[3]], 2 Pi, -Pi]}] & /@ (Flatten[{1., #/360*2 Pi}] & /@ coords)
lengths[inputdata_] := 2.*(inputdata/Max[inputdata])
myGeoHistogram[data_, radius_] := Show[SphericalPlot3D[radius, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[White, 10], Texture[Import["/Users/thiel/Desktop/backgroundimage.gif"]]], Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", Boxed -> False, PlotPoints -> 100, PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Full],
Graphics3D[Flatten[{Green, Thick, Line[{#[[1]], (radius + #[[2]])*#[[1]]}] & /@ Transpose[{toCoordinates[#[[All, 1]]], lengths[#[[All, 2]]]} &@data]}]]]
The background image is attached to this post. With that we can represent the events like so:
myGeoHistogram[Transpose@{DeleteCases[gtdb[[1, -2071 ;; -2, {14, 15}]], {"", ""}], ConstantArray[1, Length[DeleteCases[gtdb[[1, -2071 ;; -2, {14, 15}]], {"", ""}]]]}, 3.]
![enter image description here][5]
There is obviously a very high number of events in the Middle East and in Afghanistan. Here is another visualisation of the same data:
GeoListPlot[GeoPosition /@ DeleteCases[gtdb[[1, -2071 ;; -2, {14, 15}]], {"", ""}], GeoRange -> "World", GeoProjection -> "Robinson", ImageSize -> 800]
![enter image description here][6]
Number of people killed
-----------------------
In column 101 each entry contains information on the number of people that were killed in the attack. We can make a histogram of that.
ListLogLogPlot[SortBy[Select[DeleteCases[Tally[Round /@ gtdb[[1, 2 ;; -2]][[All, 101]]], {"", _}], #[[1]] >= 1 &], First], PlotTheme -> "Marketing",
ImageSize -> Large, LabelStyle -> Directive[Bold, 16], FrameLabel -> {"number of casulties", "number of incidents"}]
![enter image description here][7]
It turns out that occasionally the number of people killed is not an integer.
Select[SortBy[Select[DeleteCases[Tally[gtdb[[1, 2 ;; -2]][[All, 101]]], {"", _}], #[[1]] >= 1 &], First][[All, 1]], # - Floor[#] != 0 &]
![enter image description here][8]
In the codebook they say:
> When several cases are linked together, sources sometimes provide a
> cumulative fatality total for all of the events rather than fatality
> figures for each incident. In such cases, the preservation of
> statistical accuracy is achieved by distributing fatalities across the
> linked incidents. Depending on the number of linked events and the
> cumulative total of fatalities, it is possible for fractions to appear
> in the fatality field for individual events.
This is why I used the "Round" function of the histogram. As expected there are fewer incidents with very high casualty numbers. In fact, the behaviour seems to be nearly "scale-free", i.e. a straight line in a log-log plot.
Country by country
------------------
We can also look at the data for a specific country. These are incidents in Germany all from December 2015:
Select[gtdb[[1, -1071 ;; -2]], #[[9]] == "Germany" &] // TableForm
![enter image description here][9]
Here are descriptions of what happened:
Select[gtdb[[1, -1071 ;; -2]], #[[9]] == "Germany" &][[All, 19]] // TableForm
![enter image description here][10]
Most of the attacks are on refugee shelters.
Attacks over the years
----------------------
The dataset also contains historic case since 1970. We can extract the years from the database like this:
![enter image description here][11]
Note that there are no incidents reported for 1993. Let's sort this by year and tally:
attacksvsyear = Transpose[{DateObject[ToString[#]] & /@ DeleteCases[Range[1970, 2015], 1993], Length /@ GatherBy[gtdb[[1, All]], #[[2]] &][[2 ;;]]}]
![enter image description here][12]
Now we can plot the number of incidents from 1970 until 2015.
DateListPlot[attacksvsyear, Background -> Black, PlotStyle -> Directive[RGBColor[{0.7, 0, 0}], Thickness[0.005]],
LabelStyle -> Directive[Yellow, Bold, Medium, FontSize -> 22], Filling -> Bottom, FillingStyle -> RGBColor[1, 0.5, 0.5],
ImageSize -> Full, PlotRange -> All]
![enter image description here][13]
On the GTDB website they say that some time in the middle of the sequence the methodology of the data acquisition has changed, so the methodology might not be completely consistent. In particular at the end of 2011 the method has changed (see page 4 of the codebook); it has been tried though to be as consistent as possible.
Graphics of geo-distribution of attacks and casualties
------------------------------------------------------
The following image shows terrorism incidents on a map of the world; the sizes of the disks correspond to the number of people killed.
Here are the deadly attacks of 2015:
GeoGraphics[Join[{Red}, GeoDisk[{#[[1]], #[[2]]}, Sqrt[#[[3]]]*Quantity[40, "Kilometers"]] & /@
Select[Cases[gtdb[[1, -14806 ;; -2, {14, 15, 101}]], {_Real, _Real, _Real}], #[[3]] > 0. &]], GeoRange -> "World",
GeoProjection -> "Mercator", ImageSize -> Full, GeoBackground -> "CountryBorders"]
![enter image description here][15]
We can change the styling a little bit:
styling = {GeoBackground -> GeoStyling["StreetMapNoLabels", GeoStylingImageFunction -> (ImageAdjust@ColorNegate@ColorConvert[#1, "Grayscale"] &)], GeoScaleBar -> Placed[{"Metric", "Imperial"}, {Right, Bottom}], GeoRangePadding -> Full, ImageSize -> Large};
GeoGraphics[Join[{Red}, GeoDisk[{#[[1]], #[[2]]}, Sqrt[#[[3]]]*Quantity[40, "Kilometers"]] & /@ Select[Cases[gtdb[[1, -8000 ;; -2, {14, 15, 101}]], {_Real, _Real, _Real}], #[[3]] > 0. &]], GeoRange -> "World", GeoProjection -> "Equirectangular", ImageSize -> Full, styling]
![enter image description here][16]
We can now also plot this on a 3D representation of the world:
backgrnd = GeoGraphics[Join[{Red, GeoStyling[Opacity[0.4]]}, GeoDisk[{#[[1]], #[[2]]}, Sqrt[#[[3]]]*Quantity[40, "Kilometers"]] & /@
Select[Cases[gtdb[[1, -8000 ;; -2, {14, 15, 101}]], {_Real, _Real, _Real}], #[[3]] > 0. &]], GeoRange -> "World", GeoBackground -> "Satellite" ,
GeoProjection -> "Equirectangular", ImageSize -> Large]; SphericalPlot3D[3, {u, 0, Pi}, {v, 0, 2 Pi},
Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &), PlotStyle -> Directive[Specularity[Black], Texture[backgrnd]],
Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", Boxed -> False, PlotPoints -> 100, PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Large]
![enter image description here][18]
We can also build a function to deal with data of the form {lat,lon,nkilled}. First, we prepare the data:
datalonlatkill = Select[Cases[gtdb[[1, -80 ;; -2, {14, 15, 101}]], {_Real, _Real, _Real}], #[[3]] > 0. &];
then we generate the function:
myBlobPlot[data_] := Module[{}, backgrnd = GeoGraphics[
Join[{Red, GeoStyling[Opacity[0.4]]}, GeoDisk[{#[[1]], #[[2]]}, Sqrt[#[[3]]]*Quantity[40, "Kilometers"]] & /@ data],
GeoRange -> "World", GeoBackground -> "Satellite" , GeoProjection -> "Equirectangular", ImageSize -> Large];
SphericalPlot3D[3, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[Black], Texture[backgrnd]], Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip",
Boxed -> False, PlotPoints -> 100, PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Large]]
and plot:
myBlobPlot[datalonlatkill]
![enter image description here][19]
Let's try to plot this as a movie in 3 month windows. First we need to create data with also contains the year and month of the attack.
datalonlatkill = Select[Cases[gtdb[[1, ;; -2, {14, 15, 101, 2, 3}]], {_Real, _Real, _Real, _, _}], #[[3]] > 0. &];
Then we calculate a list of positions in the data of the "last case belonging to one of the particular time window.
threemonthwindows = Flatten[Table[{_, _, _, i, j}, {i, 1970., 2015., 1.}, {j, {3., 6., 9., 12.}}], 1];
Then we calculate the indices of all elements in each window.
borders = Prepend[Quiet[Table[Position[datalonlatkill, Cases[datalonlatkill, threemonthwindows[[k]]][[-1]]][[1, 1]], {k, 1, Length[threemonthwindows]}] /. {}[[1, 1]] -> Missing["NotAvailable"]], 0];
and then the bins
bins = {1, 0} + # & /@ Partition[borders, 2, 1];
Now we can make the 3D globe for all time points:
myBlobPlot[datalonlatkill[[#[[1]] ;; #[[2]]]][[All, 1 ;; 3]]] &@ bins[[22]]
Now we want to create a little animation. The globe should turn and show a sequence of states. I could use something like rotate or Viewpoint, but chose to do something a bit different: I will actually move the background image and map it onto a stable sphere. First of all we need to know the dimensions of the background image
backgrnd // ImageDimensions
(*{576,288}*)
Let's remove the bins without any events and count how many there are.
Cases[bins, {_?NumberQ, _?NumberQ}] // Length
(*179*)
We can now make a Manipulate structure to get the idea. As I move the slider the image is cut into to pieces and reassembled. It is actually quite responsive.
Manipulate[ImageAssemble[{ImageCrop[backgrnd, {576 - k, Full}, Left], ImageCrop[backgrnd, {k, Full}, Right]}], {k, 1, 575, 1}]
![enter image description here][20]
Now we can use this idea to "rotate" the background and map it onto the sphere. I generate the frames that will make up my movie.
Monitor[frames =
Table[backgrnd =
GeoGraphics[
Join[{Red, GeoStyling[Opacity[0.4]]},
GeoDisk[{#[[1]], #[[2]]},
Sqrt[#[[3]]]*
Quantity[40,
"Kilometers"]] & /@ (datalonlatkill[[#[[1]] ;; \
#[[2]]]][[All, 1 ;; 3]] &@ (Cases[
bins, {_?NumberQ, _?NumberQ}][[k]]))],
GeoRange -> "World", GeoBackground -> "Satellite" ,
GeoProjection -> "Equirectangular", ImageSize -> Large];
backgrnd =
ImageAssemble[{ImageCrop[backgrnd, {576 - Mod[k*10, 576], Full},
Left], ImageCrop[backgrnd, {Mod[k*10, 576], Full}, Right]}];
Image[
SphericalPlot3D[3, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None,
TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[Black], Texture[backgrnd]],
Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip",
Boxed -> False, PlotPoints -> 100,
PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Large,
Background -> Black]], {k, 1, 179}];, k]
We can now animate the frames or export them.
Monitor[Do[Export["~/Desktop/GTDBmovie/frame" <> ToString[1000 + k] <> ".jpg", frames[[k]], ImageResolution -> 100], {k, 1, Length[frames], 1}],k]
The resulting video is shown at the top of this post.
Incidents by country
--------------------
The following histogram looks at the number of cases in different countries; only the first 40 are displayed.
BarChart[#[[All, 2]], ChartLabels -> (Rotate[Style[#, 16], Pi/2] & @@@
Reverse[SortBy[Tally[gtdb[[1, -5000 ;;, 9]]], Last]][[1 ;; 40]]), ColorFunction -> Function[{height}, ColorData["Temperature"][height]],
ImageSize -> Full, ScalingFunctions -> "Log"] & @ Reverse[SortBy[Tally[gtdb[[1, -5000 ;;, 9]]], Last]][[1 ;; 40]]
![enter image description here][21]
Other information in the database
---------------------------------
Again, this is a very rich database and much more information can be extracted. Let's look at textual data. We can first find the positions of textual data in the entries like so:
textpos = Flatten[Position[gtdb[[1, 1]], #] & /@ Select[gtdb[[1, 1]], StringContainsQ[#, "_txt"] &]];
We can now create a lookup table for these columns.
Rule @@@ Transpose[{textpos, gtdb[[1, 1, textpos]]}]
![enter image description here][22]
In column 85 for example there are the weapon types.
gtdb[[1, 2 ;; 100, 85]]
![enter image description here][23]
Here is a tally of frequently used weapons.
Reverse@SortBy[Tally[RandomChoice[gtdb[[1, All, 85]], 5000]], Last] // TableForm
![enter image description here][24]
We can create a WordCloud to visualise this:
WordCloud[RandomChoice[gtdb[[1, All, 85]], 1000], ImageSize -> Large, WordOrientation -> {{0, \[Pi]/3}}]
![enter image description here][25]
Have the weapons changed over time? Let's look at the first 5000 attacks:
Reverse@SortBy[Tally[gtdb[[1, 2 ;; 5000, 85]]], Last] // TableForm
![enter image description here][26]
And the last 5000.
Reverse@SortBy[Tally[gtdb[[1, -5000 ;;, 85]]], Last] // TableForm
![enter image description here][27]
There seem to be more vehicle based attacks. Let's look at that more closely:
Reverse@SortBy[Tally[gtdb[[1, 2 ;;, 85]]], Last] // TableForm
![enter image description here][28]
Let's define
attacktypes = Reverse@SortBy[Tally[gtdb[[1, 2 ;;, 85]]], Last][[All, 1]]
![enter image description here][29]
We can now look at overlapping windows of 5000 and count the weapons used.
Monitor[weaponsovertime = Table[Count[gtdb[[1, 2 + k*50 ;; 5002 + k*50, 85]], #] & /@ attacktypes, {k, 0, 3000}], k]
Let's try to make this nice. First we normalise.
(1. #/Total[#]) & /@ (weaponsovertime[[1 ;; 3000]])
![enter image description here][30]
Now we plot that:
ListLinePlot[Transpose[Accumulate /@ ((1. #/Total[#]) & /@ (Reverse /@ weaponsovertime[[1 ;; 3000]]))], PlotRange -> All,
Filling -> (#[[2]] -> {#[[1]]} & /@ Partition[Range[12], 2, 1]), ImageSize -> Large, PlotLegends -> Reverse@attacktypes, LabelStyle -> Directive[Bold, 14], AxesLabel -> {"Time / au", "percentage"}]
![enter image description here][31]
Note that the legend is in "reverse order" the top most curve in the list corresponds to the last entry in the legend.
Conclusion
----------
This post is only scratching the surface of what is possible with this data set. I find it very exciting that with the Wolfram Language and freely available databases you can answer your own questions about many of the most urgent questions we face today.
[1]: https://www.start.umd.edu/gtd/
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=GTDBmovie.gif&userId=48754
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-27at23.55.03.png&userId=48754
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-27at23.56.56.png&userId=48754
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=WorldmoveGTDB.gif&userId=48754
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.02.56.png&userId=48754
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.04.15.png&userId=48754
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.05.15.png&userId=48754
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.07.01.png&userId=48754
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.07.50.png&userId=48754
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.09.06.png&userId=48754
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.09.59.png&userId=48754
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.10.46.png&userId=48754
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.15.11.png&userId=48754
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.16.42.png&userId=48754
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.17.56.png&userId=48754
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.19.38.png&userId=48754
[19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.22.02.png&userId=48754
[20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.57.42.png&userId=48754
[21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.30.46.png&userId=48754
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.32.56.png&userId=48754
[23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.33.37.png&userId=48754
[24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.34.29.png&userId=48754
[25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.35.17.png&userId=48754
[26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.36.06.png&userId=48754
[27]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.36.51.png&userId=48754
[28]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.37.39.png&userId=48754
[29]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.38.35.png&userId=48754
[30]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.40.26.png&userId=48754
[31]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at00.41.42.png&userId=48754Marco Thiel2017-04-27T23:44:30ZGet a pair with smallest total distance from one list
http://community.wolfram.com/groups/-/m/t/1073493
Cross post in *Stack Exchange* in [here](https://mathematica.stackexchange.com/questions/143344/how-to-find-the-a-minimum-cost-perfect-matching).
----------
I want to get a pair with smallest total distance from `pts` in following
SeedRandom[1]
pts = RandomInteger[20, {20, 2}]
>{{5,0},{7,0},{2,3},{0,0},{16,14},{3,8},{19,5},{18,16},{12,0},{19,4},{7,3},{0,4},{20,3},{5,12},{19,8},{11,2},{3,10},{4,2},{17,11},{15,6}}
I can use `FindIndependentEdgeSet` to get one pair like this:
g = CompleteGraph[20];
List @@@ FindIndependentEdgeSet[VertexReplace[g, Thread[VertexList[g] -> pts]]]
>{{{5,0},{7,0}},{{2,3},{3,8}},{{0,0},{16,14}},{{19,5},{4,2}},{{18,16},{3,10}},{{12,0},{7,3}},{{19,4},{11,2}},{{0,4},{20,3}},{{5,12},{19,8}},{{17,11},{15,6}}}
The total distance is
Total[EuclideanDistance @@@ pair] // N
>113.859
But I'm sure it is not the smallest pair. Actually, I think I need a `FindIndependentEdgeSet` of edge weight version to get a minimum cost perfect matching, but it seems the `FindIndependentEdgeSet` regards weighted graph as unweighted directly.It often make me depressed. Of course, I'm happy to know other methods that can do this which aren't based on *Graph Theory*.And I found a ready-made algorithm for min cost perfect matching [here](http://pub.ist.ac.at/~vnk/software.html#BLOSSOM5).If anybody can implement it in *Mathematica*,that will be an excited thing.Because as I know,that is a very efficient algorithm.
I hope the answer can meet a **additional** demand:it can use similar method to find a maximal cost perfect matching,which is promising.
Help to imporove *Mathematica*,Help me out,Please.yode Japhe2017-04-26T14:46:12ZAvoid problem while using ViewPoint in a Manipulate?
http://community.wolfram.com/groups/-/m/t/1074533
Hi everyone,
I am making an app which shows a shaft and unbalanced masses coming off it with varying radii and locations along the length of the shaft:
![enter image description here][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3063Shaft.png&userId=1074296
I need the user to be able to select between ViewPoint -> Right and ViewPoint -> Front so that they can set it up easily. I have set ViewPoint to a variable (viewPoint) inside Graphics3D and used that variable to populate a SetterBar in the usual way:
Manipulate[
Graphics3D[
Cylinder[{{0, 0, 0}, {0 + shaftLength, 0, 0}}, shaftRadius],
ViewPoint -> viewPoint,
ImageSize -> {500, 500},
PlotRange -> {{0, shaftLength}, {-0.1, 0.1}, {-0.1, 0.1}},
Boxed -> False
],
{viewPoint, {Right, Front}},
{{shaftLength, 1}, 0.1, 1},
{{shaftRadius, 0.01}, 0.001, 0.05}
]
This works perfectly until I manually adjust the viewpoint with the mouse - which I also need the user to be able to do - and then the buttons stop responding.
Is this a bug, or can someone spot a mistake in my approach?
Thanks,
SiSimon Dee2017-04-27T05:38:23ZComputational Lichtenberg Figures
http://community.wolfram.com/groups/-/m/t/1065956
![enter image description here][1]
Lichtenberg figures ([https://en.wikipedia.org/wiki/Lichtenberg_figure][2]) can be generated by irradiating e.g. PMMA (i.e. Poly(methyl methacrylate), "acrylic glass") with a high energy electron beam. This way electrons are implanted inside the material - which is an insulator. By a controlled discharge very aesthetic tree structures consisting of tracks from the electrical current can be generated. (This is just one method.)
It is fun trying to imitate this using Mathematica! The idea is simple:
- define a MeshRegion (this is all you need as input);
- convert it to a `Graph` (with preserved `VertexCoordinates` and `EdgeWeight`);
- use `FindShortestPath` to a specific "starting point".
As mentioned there is a simple mapping from a `MeshRegion` to the Lichtenberg graphics:
![enter image description here][3]
The code - a *short* notebook - comes as attachment.
And - due to the universally designed WL functions - it works in 3D without any change of code:
![enter image description here][4]
Best regards -- Henrik
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=lichtenberg.gif&userId=32203
[2]: https://en.wikipedia.org/wiki/Lichtenberg_figure
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Lichtenberg-Examples.png&userId=32203
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=LichtenberFigure3D.png&userId=32203Henrik Schachner2017-04-19T10:34:55ZUse text as element of line for plotting?
http://community.wolfram.com/groups/-/m/t/1044361
I'm looking for a way to include text as an element of a line for plotting with Plot[]. Thanks!
The two examples below show what I'm aiming for.
Example 1: Add text manually.
![Example of text as element of line for plotting.][1]
Example 2: ListPlot, ParametricPlot, and Show:
p1 := ListPlot[Table[{Sin[n], Sin[2 n]}, {n, 50}],
PlotMarkers -> {Style["1", 12, Background -> White]}]
p2 := ParametricPlot[{Sin[n], Sin[2 n]}, {n, 0, 50}, PlotStyle -> Thin]
Show[p2, p1]
which generates
![ListPlot + ParametricPlot.][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled.png&userId=147747
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled2.png&userId=147747Glenn Carlson2017-03-27T09:56:24ZHow to simplify (use variables) and plot this summation?
http://community.wolfram.com/groups/-/m/t/1076864
I'd like to simplify this equation by using variables. For some reason I can't get the right order and way to define them:
sum Part[IntegerDigits [b, 10], i+1] * (10^i+10^(Length[IntegerDigits [b, 10]]-1-i)), i = 0 to Length[IntegerDigits [b, 10]]-1
I have tried this:
a=IntegerDigits [b, 10], k=Length[a]-1, sum Part[a, i+1] * (10^i+10^(k-i)), i = 0 to k
but without success.
Then for some reason equation doesn't give right solution with free b variable. WolframAlpha claims it is: 11 (b + 10)
But with set variable b=153 calculation is correct: 504:
[https://www.wolframalpha.com/input/?i=b%3D153,+sum+Part%5BIntegerDigits+%5Bb,+10%5D,+i%2B1%5D+*+(10%5Ei%2B10%5E(Length%5BIntegerDigits+%5Bb,+10%5D%5D-1-i)),%C2%A0+i+%3D+0+to+Length%5BIntegerDigits+%5Bb,+10%5D%5D-1][1]
Thanks for any help provided,
-Marko
[1]: https://www.wolframalpha.com/input/?i=b=153,%20sum%20Part%5BIntegerDigits%20%5Bb,%2010%5D,%20i%2b1%5D%20*%20%2810%5Ei%2b10%5E%28Length%5BIntegerDigits%20%5Bb,%2010%5D%5D-1-i%29%29,%C2%A0%20i%20=%200%20to%20Length%5BIntegerDigits%20%5Bb,%2010%5D%5D-1Marko Manninen2017-04-28T18:56:07ZVertexSize doesn't work with more then 999 Vertices?
http://community.wolfram.com/groups/-/m/t/1075376
Mathematica Version 11.1/ Windows 10
I'm working om a dataset with 4000+ Vertices and wanted to make some of the Vertices a bit larger.
After spending a lot of time I found some suggestions like here:
[http://community.wolfram.com/groups/-/m/t/45871][1]
But it seems that the VertexSize is limited to a maximum of 1000 Vertices.
I couldn't find any documentation to such a limit and I would really think it's a pity to find this is bug.
So perhaps there's a workaround.
(The code is clumsy but I found it to be the most predictable)
> h = RandomGraph[{999, 800}, ImageSize -> {800, 800}]
![enter image description here][2]
vertexdata = {VertexList[h],
Rescale@BetweennessCentrality[h]/50}\[Transpose];
vertexes =
Property[#[[1]], {VertexStyle -> RandomChoice[{ Yellow, Red, Blue}],
VertexSize -> Scaled[#[[2]]]}] & /@ vertexdata;
Graph[vertexes, EdgeList[h]]
![enter image description here][3]
Now I change the number of vertices to 1000 and the Graphs is shown directly with small vertices (points)
![enter image description here][4]
I execute the same code and the result is not as desired. Only the colors are changed but not the size.
![enter image description here][5]
[1]: http://community.wolfram.com/groups/-/m/t/45871
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=g1.jpg&userId=196214
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=g2.jpg&userId=196214
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=g3.jpg&userId=196214
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=g4.jpg&userId=196214l van Veen2017-04-27T20:55:33ZIGraph/M: igraph interface for Mathematica
http://community.wolfram.com/groups/-/m/t/560469
The post below was written for the original release of IGraph/M. The current release is 0.3.0. See http://szhorvat.net/mathematica/IGraphM for more details.
It is compatible with Windows 64-bit, macOS 10.9 or later, Linux 64-bit and Raspbian Jessie (on the Raspberry Pi computer). It requires Mathematica 10.0.2 or later.
----
I would like to announce IGraph/M, a new igraph interface for Mathematica: http://szhorvat.net/mathematica/IGraphM
[igraph](http://igraph.org/) is a graph manipulation and analysis package. IGraph/M makes its functionality available from Mathematica.
This initial release, version 0.1, covers only some igraph functions, as I focused on the things that I need personally. However the main framework is complete, and new functions can be added quickly. If anyone would like to contribute, please contact me.
Binary packages for OS X (10.9 or later) and Linux can be downloaded [from GitHub](https://github.com/szhorvat/IGraphM/releases). Unfortunately I was unable to compile the development version of igraph for Windows, so I cannot provide a Windows version. If you can help with compiling igraph itself (not IGraph/M) on Windows, please let me know!
Functionality in this release that is not built into Mathematica:
* Vertex betweenness centrality for weighted graphs
* Estimates of vertex betweenness, edge betweenness and closeness centrality; for large graphs
* Minimum feedback arc set for weighted and unweighted graphs
* Find all cliques (not just maximal ones)
* Count 3- and 4-motifs
* Rewire edges, keeping either the density or the degree sequence
* Alternative algorithms for isomorphism testing: Bliss, VF2
* Subgraph isomorphism
* Test if a degree sequence is graphical
* Alternative algorithms for generating random graphs with given degree sequence
* Layout algorithms that take weights into account
Note that IGraph/M is *not a replacement* for Mathematica's graphs and networks functionality. It is meant to complement what is already available in Mathematica, thus it primarily focuses on adding functionality that is not already present.
Why did I release the package before covering most of the igraph functionality? I do not have time to work on things I do not personally need or use, so I am unlikely to extend it further unless the need comes up. I do think that the functions that are included in v0.1 can already be useful to others too. I would also like to give the opportunity for people to contribute to the project if they wish to. The groundwork has been laid, so further extensions should be quick and relatively easy.
Also check out a related project, [IGraphR](https://github.com/szhorvat/IGraphR), which makes igraph available for Mathematica users through RLink. I wrote IGraph/M because I needed higher performance and greater reliability (especially for parallel computing) than what RLink could provide.
----
**A request:** If any of you have used IGraphR in the past to access igraph from Mathematica, please post a response to this thread and let me know which specific functions you were using.Szabolcs Horvát2015-09-06T12:55:14Z[NASA Space Apps Challenge] The Earth and us - Pilot Plus and Volcanoes
http://community.wolfram.com/groups/-/m/t/1076892
*Note: You can try out the "Volcano Explorer App" [here][1].*
#Introduction#
The **NASA Space Apps** is an international hackathon that occurs over 48 hours in cities around the world. If you aren't close to any of these cities you can also [participate virtually][2].
This year there is a special focus on Earth. Here you can check the different challenges: https://2017.spaceappschallenge.org/challenges/. Many of them can be tackled directly using the Wolfram Language and its Wolfram Knowledgebase.
To begin with, I thought it would be fun to work a bit on the ["Pilot Plus Challenge"][3].
The description of this challenge is the following:
> Provide private aircraft pilots and passengers with an easy-to-use
> tool that gives information about the land underneath their flight
> plans.
#Part I - Getting the GeoVisibleRegion of an aircraft#
For this challenge we have a very useful built-in Wolfram Language Symbol called [GeoVisibleRegion][4] which is is a two-dimensional *GeoGraphics* primitive that represents the region on the surface of the Earth visible from the point of coordinates *lat*, *lon* and height *h*.
For example the visible region from an altitude of 10 km is:
GeoGraphics[GeoVisibleRegion[{43, -90, 10000}]]
![enter image description here][5]
We can even get the region currently viewable from the *International Space Station* using [SatelliteData][6]:
GeoGraphics[GeoVisibleRegion[SatelliteData[Entity["Satellite", "25544"], "Position"]], GeoRange -> "World"]
![enter image description here][7]
Sometimes we might not know the coordinates of the place that we want to explore and we only know the name of the place. In such cases one can get the the Latitude and Longitude coordinates using [LatitudeLongitude][8] and [Interpreter][9]["Location"] :
geoVR[place_String, altitude_] := GeoVisibleRegion[Append[LatitudeLongitude[Interpreter["Location"][place]], altitude]]
GeoGraphics[geoVR["Paris", 100]]
![enter image description here][10]
We can also get the NASA satellite image as a GeoBackground:
GeoGraphics[geoVR["Paris", 100], GeoBackground -> GeoStyling["Satellite"], GeoScaleBar -> "Kilometers"]![enter image description here][11]
#Getting information of Volcanoes within a region using GeoEntities #
So far so good, now we need to identify **geographic, natural, and cultural locations of interest** from these visible regions. And [GeoEntities][12] is exactly what we need! It gives a list of the geographic entities of type *enttype* contained in the extended region *reg*.
In particular we will focus on volcanoes, but you can try your other **entity types** like, *"Lake", "Mountain", "City"*, ... For example these are the volcanoes that you can see from an aircraft at 1000 m above Portland:
volcanoes = GeoEntities[geoVR["Portland", 1000], "Volcano"]
![enter image description here][13]
We can check all the properties available for a volcano entity:
![enter image description here][14]
Furthermore we can get extra info of these Volcanoes using [WikipediaData][15]:![enter image description here][16]
#Creating and Deploying the *Volcano Explorer App*#
Now we have the tools to retrieve the data, and we can put them together to create a Wolfram Cloud based App.
For this I decided to use [FormPage][17] but alternatively we could also use [FormFunction][18] or the [APIFuntion][19].
I'm sure that the following code can be optimized. Furthermore the user interface and the design of the App need to be improved, but as a first quick prototype I think it is decent enough.
fp = FormPage[{{"location", "Location"} ->
"Location", {"altitude", "Altitude (m)"} ->
Restricted["Number", {0, 10000}] -> 1000},
With[{geoVR =
GeoVisibleRegion[
Append[LatitudeLongitude[
Interpreter["Location"][#location]], #altitude]]},
Column[{GeoGraphics[{GeoStyling["Satellite",
GeoStylingImageFunction -> (Lighter[#, 0.4] &)],
EdgeForm[{Red, Thick}], geoVR,
With[{volcanoes = GeoEntities[geoVR, "Volcano"]},
If[Length[v = volcanoes] == 0, Nothing,
GeoMarker[GeoEntities[geoVR, "Volcano"],
Entity["Icon", "Volcano"]]]]},
GeoBackground -> GeoStyling["Satellite"],
GeoScaleBar -> "Kilometers"],
If[Length[v] == 0, Nothing, Column@Map[Column@Flatten@{"", "",
Style[#["Name"], Bold, 20],
DeleteMissing[#[{EntityProperty["Volcano", "Image"]}]],
Style["Elevation (m):", Bold],
DeleteMissing[
QuantityMagnitude[#[{EntityProperty["Volcano",
"Elevation"]}], "Meters"]],
Style["Last Eruption (year):", Bold],
DeleteMissing[#[{EntityProperty["Volcano",
"LastKnownEruptionDate"]}]],
GeoGraphics[#, GeoBackground -> GeoStyling["Satellite"],
GeoScaleBar -> "Kilometers"],
WikipediaData[#, "SummaryPlaintext"]} &, v]]}]]
&, FormTheme -> "Red",
AppearanceRules -> <|"Title" -> "Volcano Explorer",
"Description" ->
"Discover the volcanoes that are visible from your aircraft!"|>]
We can then CloudDeploy the FormPage:
CloudDeploy[fp, "VolcanoExplorer"]
And this is the resulting **"Volcano Explorer App"** , feel free to [try it][20], tweak it and suggest improvements:
![enter image description here][21]
![enter image description here][22]
As a next step, it could be great to include commercial flight routes into the App. This might be achieved with the code and resources that [@Marco Thiel][at0] used on his post about [flight data and trajectories of planes][23]. Another source of inspiration that we could use to enhance this App is the post from [@Arnoud Buzing][at1] about [earthquakes around a volcano][24].
[at0]: http://community.wolfram.com/web/mthiel
[at1]: http://community.wolfram.com/web/arnoudb
[1]: https://www.wolframcloud.com/objects/user-55ede016-e048-4097-9b58-db218e02e037/VolcanoExplorer
[2]: https://2017.spaceappschallenge.org/auth/signup
[3]: https://2017.spaceappschallenge.org/challenges/earth-and-us/pilots-plus/details
[4]: https://reference.wolfram.com/language/ref/GeoVisibleRegion.html
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.26.19.png&userId=95400
[6]: https://reference.wolfram.com/language/ref/SatelliteData.html
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.30.20.png&userId=95400
[8]: https://reference.wolfram.com/language/ref/LatitudeLongitude.html
[9]: http://reference.wolfram.com/language/ref/Interpreter.html
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.37.02.png&userId=95400
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.39.19.png&userId=95400
[12]: http://reference.wolfram.com/language/ref/GeoEntities.html
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.48.46.png&userId=95400
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.51.02.png&userId=95400
[15]: http://reference.wolfram.com/language/ref/WikipediaData.html
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at13.53.17.png&userId=95400
[17]: http://reference.wolfram.com/language/ref/FormPage.html
[18]: http://reference.wolfram.com/language/ref/FormFunction.html
[19]: http://reference.wolfram.com/language/ref/APIFunction.html
[20]: https://www.wolframcloud.com/objects/user-55ede016-e048-4097-9b58-db218e02e037/VolcanoExplorer
[21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at14.10.02.png&userId=95400
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-28at14.14.35.png&userId=95400
[23]: http://community.wolfram.com/groups/-/m/t/1072478
[24]: http://community.wolfram.com/groups/-/m/t/325930Jofre Espigule2017-04-28T19:25:55ZDisplaying negative exponents in Mathematica answers
http://community.wolfram.com/groups/-/m/t/1076590
While the expressions 1/z^2 and z^-2 are equivalent, in many signal processing applications the z^-2 form is more useful. However Mathematica will usually express the form as 1/z^2. Is there a way to force Mathematica to display the alternative form?Jesse Sheinwald2017-04-28T13:00:57ZWhy it's wrong the differential equation's solve
http://community.wolfram.com/groups/-/m/t/1076426
DSolve[{0 == c''[t] + 100/0.001 c'[t] + c[t]/(0.001*0.0005), c[0] == 0,
c'[0] == 0}, c[t], t] // Simplify
and it returns `c[t]->0`
This is the differential equation of an RLC series circuit whit a continuous voltage source.
Regards.Julian Oviedo2017-04-28T14:41:30ZDocumentation`HelpLookupPacletURI broken in 11.1, workaround?
http://community.wolfram.com/groups/-/m/t/1076445
Hello,
``Documentation`HelpLookupPacletURI`` is broken on Linux in 11.1. It opens a notebook window that has no search bar or navigation buttons. I thought it would get fixed for 11.1.1, but it wasn't.
So now I am asking here: Is there a workaround for this issue?
To test, try e.g.
Documentation`HelpLookupPacletURI["ref/FindRoot"]
![enter image description here][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2017-04-2817.32.32.png&userId=38370Szabolcs Horvát2017-04-28T15:32:56ZCalculating NMR-spectra with Wolfram Language
http://community.wolfram.com/groups/-/m/t/1052348
#Introduction
Perhaps there are already Mma-Procedures to calculate NMR-spectra, but I did not do a literature research.
I post a notebook to calculate NMR-Spectra of simple spin I = 1/2 systems.
The notebook comes in two parts.
Part one uses a spin-product function approach, where the spin-product function a, a ,...b is used as e.g. phi [ 1, 1, ,...., -1 ].
The Hamiltonian is constructed according to different mT-values and the spectrum is calculated.
Part two uses the "brute force" approach where all operators are mapped unto matrices (Kronecker-Products of individual matrix-operators) in the total spin-space. So here products of operators are matrix-products (in part 1 they are functions of functions) .Having the Hamiltonian and its Eigensystem the spectrum is calculated.
Note that the number of lines of even small systems are growing rapidly. So it may well be that there is not enough memory to cope with a system you would like to consider.
If you omit giving numbers to frequencies and coupling-constants you may get pure theoretical results. That works fine for two spins, but already for three spins - although here you will still get the Hamiltonian - very large outputs are generated, especially in the Eigensystems, So you should avoid that.
It seems to be not too complicated to modify the approach in part two to include spins with I > 1/2.
And certainly it is well possible to modify the code as to get an iterative procedure to fit data to spectra.
I am aware that there are "professional" systems to do all this, but I just wanted to see how it could be done in Mathematica.
#Part 1#
Number of Spins
nsp = 3;
Input of Parameters
freqs = {372.2, 364.4, 342, 6.083, 5.8};
JJ = ( {
{0, .91, 17.9, 1, 1, 1},
{0, 0, 11.75, 1, 1, 1},
{0, 0, 0, 1, 1, 1},
{0, 0, 0, 0, 1, 1},
{0, 0, 0, 0, 0, 1},
{0, 0, 0, 0, 0, 0}
} );
Do[\[Nu][i] = freqs[[i]], {i, 1, nsp}];
Do[J[i, k] = JJ[[i, k]], {i, 1, nsp - 1}, {k, i + 1, nsp}];
Basevectors
base = Apply[\[CurlyPhi],
IntegerDigits[#, 2, nsp] + 1 & /@ Table[j, {j, 0, 2^nsp - 1}] /.
2 -> -1, {1}]
![enter image description here][1]
mT - Values
mT = Table[-nsp/2 + j, {j, 0, nsp}]
![enter image description here][2]
Number of lines in the spectrum ( = Sum[Binomial[nsp, k] Binomial[nsp, k + 1], {k, 0, nsp - 1}], because only transitions between states of different mT's give lines on non-zero intensity )
numberoflines = Binomial[2 nsp, nsp - 1]
> 15
Rule for scalar products
rscp = {\[CurlyPhi][x__]^2 -> 1, \[CurlyPhi][x__] \[CurlyPhi][y__] -> 0}
![enter image description here][3]
SpinOperators
cs[a_, j_] := Module[{t}, t = a; b = t[[j]]; t[[j]] = -b; t]
Ix[v_, j_] := v/2 /. \[CurlyPhi][x___] :> \[CurlyPhi] @@ cs[{x}, j]
Iy[v_, j_] :=
I v/2 /. \[CurlyPhi][x___] :> {x}[[j]] \[CurlyPhi] @@ cs[{x}, j]
Iz[v_, j_] := v/2 /. \[CurlyPhi][x___] :> {x}[[j]] \[CurlyPhi][x]
Example
{Ix[\[CurlyPhi][4], 1], Ix[\[CurlyPhi][-1], 1], Iy[\[CurlyPhi][5], 1],
Iy[\[CurlyPhi][-1], 1], Iz[\[CurlyPhi][6], 1],
Iz[\[CurlyPhi][-1], 1]}
![enter image description here][7]
Hamiltonian - Matrixelements Subscript[H, i,j] for (sub-)base b
HH[b_, i_, j_] := (Sum[\[Nu][m] b[[j]] Iz[b[[i]], m], {m, 1, nsp}] +
Sum[J[m, k] b[[
j]] (Ix[Ix[b[[i]], k], m] + Iy[Iy[b[[i]], k], m] +
Iz[Iz[b[[i]], k], m]), {m, 1, nsp - 1}, {k, m + 1, nsp}] //
Expand) /. rscp
Example
HH[base, 1, 1]
> 546.94
HH[base, 1, 2]
> 0
HH[base, 3, 5]
> 0.455
Spinfunctions according to mT - value
wf = Function[x, Select[base, Total[List @@ #] == 2 x &]] /@ mT
![enter image description here][8]
Hamilton - Submatrices
HSM[j_] := (nn = Length[wf[[j]]];
Table[HH[wf[[j]], m, n], {m, 1, nn}, {n, 1, nn}])
HSM[2];
% // MatrixForm
![enter image description here][9]
HSM[2] /. {\[Nu][10] -> -\[Nu], \[Nu][11] -> 0, \[Nu][12] -> \[Nu],
J[1, 2] -> J, J[1, 3] -> J, J[2, 3] -> J};
% // MatrixForm
![enter image description here][13]
Get Eigenstates \[Congruent] all sets { freq, eigenvector } for different spin-states (mT values)
frevec[n_] := Module[{es},
es = Eigensystem[HSM[n]];
{#[[1]], #[[2]].wf[[n]]} & /@ Transpose[es]
]
eigenstates = frevec /@ Range[nsp + 1]
![enter image description here][14]
Operator for calculating relative intensities
IOP[x_] := Sum[Ix[x, n], {n, 1, nsp}]
Calculating a spectral line = difference of eigenvalues and intensity
line[a_, b_] := Module[{},
freq = Abs[a[[1]] - b[[1]]];
m2 = (Expand[a[[2]] IOP[b[[2]]]] /. rscp)^2;
{freq, Sqrt[m2]}]
Lorentzfunction
LF[x_, x0_, a_, h_] := Module[{},
If[h == 0, h = 1];
1/Sqrt[Pi] (a h/2)/(h^2/4 + Pi (x - x0)^2)]
Calculating the spectrum
spec = Table[0, {numberoflines}];
nL = 0;
Do[
lk = Length[eigenstates[[i]]];
lk1 = Length[eigenstates[[i + 1]]];
Do[
Do[
nL = nL + 1;
spec[[nL]] = line[eigenstates[[i, m]], eigenstates[[i + 1, n ]]],
{n, 1, lk1}
],
{m, 1, lk}
],
{i, 1, Length[eigenstates] - 1}];
normalizer = Max[Transpose[spec][[2]]];
bb = {.95 Min[Transpose[spec][[1]]], 1.05 Max[Transpose[spec][[1]]]};
spec = {#[[1]], #[[2]]/normalizer} & /@ spec;
spec
pl1 = ListPlot[spec, Filling -> Axis]
![enter image description here][15]
Show the spectrum with lines
pl2 = Plot[
Plus @@ (LF[x, #[[1]], #[[2]], 1.5] & /@ spec), {x, bb[[1]],
bb[[2]]}, PlotRange -> All, AxesOrigin -> {320, 0}]
![enter image description here][16]
For some physical reason spectra are recorded so that frequencies grow from right to left. So the plot is reversed and compared to the experimental spectrum ( see http://www.users.csbsju.edu/~frioux/nmr/Speclab4.htm ) which is given below the plot.
pl3 = Plot[
Plus @@ (LF[-x, #[[1]], #[[2]], 1.5] & /@ spec), {x, -bb[[2]], -bb[[
1]]}, PlotRange -> All]
![enter image description here][17]
#Part 2#
nsp = 3;
Input of Parameters
freqs = {372.2, 364.4, 342, 6.083, 5.8};
JJ = ( {
{0, .91, 17.9, 1, 1, 1},
{0, 0, 11.75, 1, 1, 1},
{0, 0, 0, 1, 1, 1},
{0, 0, 0, 0, 1, 1},
{0, 0, 0, 0, 0, 1},
{0, 0, 0, 0, 0, 0}
} );
Do[\[Nu][i] = freqs[[i]], {i, 1, nsp}];
Do[J[i, k] = JJ[[i, k]], {i, 1, nsp - 1}, {k, i + 1, nsp}];
number of lines to be expected and dimension ot (total) spin - space (at least for spin 1/2 )
numberoflines = Binomial[2 nsp, nsp - 1]
dimspsp = 2^nsp
> 15
> 8
spin operators for spin I = 1/2
ix = ( { {0, 1}, {1, 0} } )/2;
iy = ( { {0, -I}, {I, 0} } )/2;
iz = ( {{1, 0}, {0, -1} } )/2;
this function constructs the spin operator of particle j as matrix in the spin space of n particles
Op[op_, n_, j_] := Module[{x, m},
x = Join[Table[{{1, 0}, {0, 1}}, {j - 1}], {op},
Table[{{1, 0}, {0, 1}}, {n - j}]];
m = SparseArray[KroneckerProduct[Sequence @@ x]]
]
oIx[j_] := Op[ix, nsp, j]
oIy[j_] := Op[iy, nsp, j]
oIz[j_] := Op[iz, nsp, j]
Hamiltonian
HH = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(nsp\)]\(\[Nu][i] oIz[
i]\)\) + \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(nsp - 1\)]\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = i + 1\), \(nsp\)]J[i,
j] \((oIx[i] . oIx[j] + oIy[i] . oIy[j] + oIz[i] . oIz[j])\)\)\)
> SparseArray[SequenceForm["<", 32, ">"], {8, 8}]
Eigensystem for the Hamilton - Operator
est = Transpose[Eigensystem[HH]]
![enter image description here][18]
Intensity operator
IOP1 = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(nsp\)]\(oIx[j]\)\)
> SparseArray[SequenceForm["<", 24, ">"], {8, 8}]
line1[a_, b_] := Module[{},
freq = Abs[a[[1]] - b[[1]]];
m2 = (a[[2]].IOP1.b[[2]])^2;
{freq, Sqrt[m2]}]
Calculate spectrum, show it and display result from part 1
spec1 = Table[0, {Binomial[dimspsp, 2]}];
nL = 0;
Do[
Do[
nL = nL + 1;
spec1[[nL]] = line1[est[[u]], est[[v]]],
{u, v + 1, dimspsp}
],
{v, 1, dimspsp - 1}
]
spec1 = Select[spec1, #[[2]] > 0. &];
normalizer = Max[Transpose[spec1][[2]]];
bb = {.95 Min[Transpose[spec][[1]]], 1.05 Max[Transpose[spec][[1]]]};
spec1 = {#[[1]], #[[2]]/normalizer} & /@ spec1;
spec1
ListPlot[spec1, Filling -> Axis, FillingStyle -> Directive[Red, Thick]]
Show[pl1]
![enter image description here][19]
Plot the spectrum and compare with the result of the 1 st part
pl4 = Plot[
Plus @@ (LF[x, #[[1]], #[[2]], 1.5] & /@ spec1), {x, bb[[1]],
bb[[2]]}, PlotRange -> All, PlotStyle -> Red]
Show[pl2]
![enter image description here][20]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.23.20.png&userId=95400
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.25.36.png&userId=95400
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.28.10.png&userId=95400
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.32.12.png&userId=95400
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.33.44.png&userId=95400
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.23.20.png&userId=95400
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.25.36.png&userId=95400
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.34.56.png&userId=95400
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.37.59.png&userId=95400
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.41.13.png&userId=95400
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.42.24.png&userId=95400
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.43.26.png&userId=95400
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.50.48.png&userId=95400
[19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.53.45.png&userId=95400
[20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.55.25.png&userId=95400Hans Dolhaine2017-04-04T08:36:27ZProblems with Units Seconds vs. s
http://community.wolfram.com/groups/-/m/t/1075543
This ist only my first simple steps to build a computation to dimension an upload service. Even the first steps are not easy.
If i am evaluating this:
uploadtime[filesize_, bandwidth_] := (filesize / bandwidth)
uploadtime[UnitConvert[Quantity[12770776, "Bytes"], "Megabits"],
Quantity[2.4, "Megabits"/"Seconds"]]
I am getting this:
Quantity[42.5693, "Seconds"]
If I am evaluating this:
Convert[Month, Second]
I am getting this:
2628000 Second
If I am mulitplying both results I am getting:
Second (Quantity[52560000, ("Megabits")/("Seconds")])
What am I doing wrong?Oliver Scholz2017-04-27T15:55:38ZPublished Page doesn't work for others
http://community.wolfram.com/groups/-/m/t/1075818
I created a notebook and attempted to deploy it.
https://www.wolframcloud.com/objects/9d51bc03-ccaa-4ee4-bb15-d65ca75d0b6c
It works for me but no one else.
The notebook contains one cell with the following code:
Manipulate[Plot[{n!, 2^n, n^2, n Log[n], n, Log[n], 1},{n,0,10^e},PlotRange->{{0,10^e},{0,10^e}}, AspectRatio->Automatic,PlotLegends->"Expressions", PlotLabel->"10^"<>ToString[e] ], {{e,1}, 0, 10}]
What am I doing wrong?Gabriel Jones2017-04-27T21:59:59ZDynamic nested Do cycles
http://community.wolfram.com/groups/-/m/t/1076336
Hi everybody,
I managed to create a simple program calculating the weight spectra of non-binary linear block codes (using the old GF package):
<< GaloisField`GaloisField`
DeclareGaloisField[GF8]
pp = 2^ExtensionDegree[GF8];
nd = 12; (* code word length *)
kd = 5; (* the length of information vector *)
pmat = {{GF8[1], GF8[1], GF8[1], GF8[1], GF8[1], GF8[1], GF8[1]},
{GF8[5], GF8[7], GF8[6], GF8[3], GF8[4], GF8[2], GF8[1]},
{GF8[7], GF8[3], GF8[2], GF8[5], GF8[6], GF8[4], GF8[1]},
{GF8[1], GF8[1], GF8[1], GF8[1], GF8[1], GF8[1], GF8[1]},
{GF8[1], GF8[1], GF8[1], GF8[1], GF8[1], GF8[1], GF8[1]}}; (* parity part of generator matrix *)
vysl = Array[w, nd, 0];
Do[w[i] = 0, {i, 0, nd}];
Do[
Do[
Do[
Do[
Do[
info = {GF8[n], GF8[m], GF8[l], GF8[j], GF8[i]};
r = kd - Count[info, GF8[0]];
s = (nd - kd) - Count[info.pmat, 0];
t = r + s;
++w[t],
{j, 0, pp - 1}],
{i, 0, pp - 1}],
{l, 0, pp - 1}],
{m, 0, pp - 1}],
{n, 0, pp - 1}];
Do[Print["code word weight ", p, " = ", w[p]], {p, 0, nd}]
Note: the above assumes a systematic form of generator matrix.
My question is how to make this nested "Do" structure dynamic, so I do not have to input it manually and it will be created automatically based on the input parameters: "nd" and "kd"?
I tried to use Nest[] but I wasn't successful (I am not a good programmer).
Many thanks for your help,
MartinMartin Rakus2017-04-28T08:52:00ZCustom entities with Bostock's unemployment data and EntityStore
http://community.wolfram.com/groups/-/m/t/1076067
Note: I originally posted a [version of this tutorial](https://mathematica.stackexchange.com/a/123334/731) on Mathematica StackExchange. I was encouraged to make this crosspost and realized that a few things had changed since I wrote the original post. Notably, many counties now have FIPS codes. I've rewritten the text to make use of this.
Goal
====
The idea of the original text was to recreate Mike Bostock's D3.js [choropleth map](https://bl.ocks.org/mbostock/4060606). Here is a screenshot of what it looks like:
<img src="http://community.wolfram.com//c/portal/getImageAttachment?filename=bostock.png&userId=295249" width="660">
This choropleth map shows the unemployment rate in all the different US counties. I will try to use the Wolfram Knowledgebase and high-level geographics functions as much as possible. This means building my own entity store with entities that inherit properties from built-in county entities but also extend them with new properties.
Data from Wolfram Knowledgebase
===
`GeoRegionValuePlot` makes it very easy to plot data that is built into region entities. For example, this is how we can plot the fraction of each county's population that is foreign born.
counties = Cases[
EntityList@Entity["AdministrativeDivision", {"Country" -> Entity["Country", "UnitedStates"]}],
Entity[_, {_, _, _}] (*separates states from counties*)
];
GeoRegionValuePlot[counties -> "ForeignBornFraction"]
![enter image description here][1]
"ForeignBornFraction" is an entity property to administrative regions. Unfortunately, county properties are either missing or take the value of their state. The plot reflects the latter.
`GeoRegionValuePlot` is very convenient and it can be suitably styled, but Bostock's unemployment data is not available in Wolfram Knowledgebase. To be able to use the function for our purpose, we need to create our own entities where we have added Bostock's data as a property.
Custom data
===
We start by importing Bostock's data set.
data = <|Rule @@@ Rest@Import[
"https://gist.githubusercontent.com/mbostock/4060606/raw/25385f68a3be5c9dbe36af27fc2498fb2aab6bc0/unemployment.tsv",
"TSV"
]|>;
data // Shallow
(* Out: <|1001 -> 0.097, 1003 -> 0.091, 1005 -> 0.134, ... *)
Each entry consists of a county FIPS code and the corresponding unemployment rate. Most county entities have the FIPS code:
![enter image description here][2]
This makes it easy to correlate county entities with data points. However, in order to use `GeoRegionValuePlot`, we need entities which have the unemployment rate as one of their properties. We will achieve this by creating a new entity class, which inherits the necessary data from county entities but also includes our custom data.
getEntityIdentifier[Entity[_, {county_, state_, country___}]] := county <> "-" <> state
getEntityIdentifier[Entity[_, {"DistrictOfColumbia", _}]] := "DistrictOfColumbia"
customEntity[entity_] := If[
! MatchQ[entity["FIPSCode"], _Missing],
getEntityIdentifier[entity] -> <|
"Label" -> Style[entity["Name"], Bold],
"ParentEntity" -> entity,
"Unemployment" -> data[ToExpression@entity["FIPSCode"]]
|>,
Nothing
]
`customEntity` creates a "child entity" with the properties `ParentEntity` and `Unemployment. Counties which do not have a FIPS code are ignored. An example of a custom entity:
![Custom entity][3]
Note that we could easily add many other properties. Now create a child entity for each county:
Quiet[countyEntities = <|customEntity /@ counties|>;]
I don't know why, but it only worked if I first went to File -> Preferences -> Internet connectivity and unchecked the box "Allow the Wolfram System to access the Internet". Otherwise, the evaluation would hang forever. I put Quiet in there because otherwise it would complain about not having Internet access. Don't forget to enable the Internet connectivity again when you're done with this part, you'll need it for the geo functions.
We now create an entity store with the custom entities. This entity store comes with properties which are automatically computed from the parent entities. "Inheritance" is achieved by using the `ParentEntity` property to get the corresponding properties from the parent entity. The properties which are inherited have been chosen because they are the ones which are necessary to use `GeoRegionValuePlot`. `GeoRegionValuePlot` uses those properties internally.
store = EntityStore["USCounty" -> <|
"Entities" -> countyEntities,
"Properties" -> <|
"ParentEntity" -> <|
"Label" -> "Parent entity"
|>,
"FIPSCode" -> <|
"DefaultFunction" -> (#["ParentEntity"]["FIPSCode"] &),
"Label" -> "County FIPS code"
|>,
"Polygon" -> <|
"DefaultFunction" -> (#["ParentEntity"]["Polygon"] &),
"Label" -> "Polygon"
|>,
"Position" -> <|
"DefaultFunction" -> (#["ParentEntity"]["Position"] &),
"Label" -> "Position"
|>,
"Latitude" -> <|
"DefaultFunction" -> (#["ParentEntity"]["Latitude"] &),
"Label" -> "Latitude"
|>,
"Longitude" -> <|
"DefaultFunction" -> (#["ParentEntity"]["Longitude"] &),
"Label" -> "Longitude"
|>,
"HasPolygon" -> <|
"DefaultFunction" -> (#["ParentEntity"]["HasPolygon"] &),
"Label" -> "Has polygon?"
|>,
"Name" -> <|
"DefaultFunction" -> (#["ParentEntity"]["Name"] &),
"Label" -> "Name"
|>
|>,
"EntityClasses" -> <|
"Alaska" -> <|
"Entities" -> ("ParentEntity" -> (MatchQ[#,
Entity[_, {_, "Alaska", _}]] &)),
"Label" -> Style["Alaska", Bold]
|>,
"Hawaii" -> <|
"Entities" -> ("ParentEntity" -> (MatchQ[#, Entity[_, {_, "Hawaii", _}]] &)),
"Label" -> Style["Hawaii", Bold]
|>,
"Mainland" -> <|
"Entities" -> ("ParentEntity" -> (MatchQ[#, Entity[_, {_, Except["Alaska" | "Hawaii"], _}]] &)),
"Label" -> Style["Mainland", Bold]|>
|>
|>];
Demo of the entity store
===
We now add the entity store to the list of available entity stores:
AppendTo[$EntityStores, store];
We could also add it as a resource object for persistence.
ro = ResourceObject[<|
"Name" -> "USCounty",
"ResourceType" -> "DataResource",
"Content" -> store
|>];
The next time we'd like to use this entity store in a new session, we could simply write
AppendTo[$EntityStores, ResourceObject["USCounty"]]
Now we inspect our entity store:
![Entity list][4]
![Entity list 2][5]
Back to `GeoRegionValuePlot`
===
With the entity store in place we can now use GeoRegionValuePlot to plot our custom data like this:
GeoRegionValuePlot[EntityList[EntityClass["USCounty", "Mainland"]] -> "Unemployment"]
![Unemployment choropleth][6]
With a few options it looks almost the same as Bostock's map:
getColor[val_?NumericQ] := Which[
0 < val < 0.01667, RGBColor[{247, 251, 255}/255],
0.0166 < val < 0.0333, RGBColor[{222, 235, 247}/255],
0.0333 < val < 0.05, RGBColor[{198, 219, 239}/255],
0.05 < val < 0.0666, RGBColor[{158, 202, 225}/255],
0.0666 < val < 0.0833, RGBColor[{107, 174, 214}/255],
0.0833 < val < 0.1, RGBColor[{66, 146, 198}/255],
0.1 < val < 0.1166, RGBColor[{33, 113, 181}/255],
0.1166 < val < 0.1333, RGBColor[{8, 81, 156}/255],
0.1333 < val < 0.15, RGBColor[{8, 48, 107}/255],
True, RGBColor[{8, 48, 107}/255]
]
getColor[val_] := RGBColor[{8, 48, 107}/255]
mainland = GeoRegionValuePlot[
EntityList[EntityClass["USCounty", "Mainland"]] -> "Unemployment",
ColorFunction -> getColor,
ColorFunctionScaling -> False,
PlotLegends -> None,
PlotStyle -> Directive[EdgeForm[None]],
GeoBackground -> None,
GeoProjection -> {
"LambertAzimuthal",
"Centering" -> GeoPosition[{30, -195/2}]
},
PlotRange -> {{-0.37, 0.38}, {-0.13, 0.38}},
ImageSize -> 660
]
![Choropleth, Bostock style][7]
There are a few white counties here which are missing because they don't have the "FIPSCode" property. In my original version of this post over at Mathematica.StackExchange I used an external source for FIPS codes because at that time counties either did not have them or they were incorrect. Now that they are mostly correct I think that the added elegance of not having to use an external data source is preferred.
The last details
===
We now add Alaska and Hawaii:
getPolygon[entity_] := {
GeoStyling[None],
getColor[entity["Unemployment"]], Polygon[entity]
}
alaska = GeoGraphics[
getPolygon /@ EntityList[EntityClass["USCounty", "Alaska"]],
GeoBackground -> None
];
hawaii = GeoGraphics[
getPolygon /@ EntityList[EntityClass["USCounty", "Hawaii"]],
GeoBackground -> None
];
map = Show[
mainland,
GeoGraphics[{
Inset[alaska, {-0.3, -0.06}, {0, 0}, 0.3],
Inset[hawaii, {-0.15, -0.06}, {0.1569, -0.0436}, 0.3]
}]
]
![Choropleth, Bostock style, with Hawaii][8]
We can see Hawaii, but unfortunately no county entities for Alaskan counties have FIPS codes in them, so Alaska has disappeared.
To add the borderlines I first make a black and white mask, where states are black and the background is white. The state borderlines that I want to draw are white as well; I then use `ImageAdd` to put the images together. The counties will be unaffected because we'll only be adding black to them, except for on the borderlines. In principle, I could add the `GeoRegionValuePlot` to the `GeoGraphics` with Hawaii, but I use `GeoGraphics` for both to ensure matching image padding.
states = Cases[
EntityList@
Entity["AdministrativeDivision", {"Country" ->
Entity["Country", "UnitedStates"]}],
Entity[_, {_, _}]
];
alaska = GeoGraphics[
Polygon /@ EntityList[EntityClass["USCounty", "Alaska"]],
GeoBackground -> None
];
hawaii = GeoGraphics[
Polygon /@ EntityList[EntityClass["USCounty", "Hawaii"]],
GeoBackground -> None
];
map = GeoGraphics[{
getPolygon /@ EntityList[EntityClass["USCounty", "Mainland"]],
Inset[alaska, {-0.3, -0.06}, {0, 0}, 0.3],
Inset[hawaii, {-0.15, -0.06}, {0.1569, -0.0436}, 0.3]
},
GeoBackground -> None,
GeoProjection -> {
"LambertAzimuthal",
"Centering" -> GeoPosition[{30, -195/2}]
},
PlotRange -> {{-0.37, 0.38}, {-0.13, 0.38}},
ImageSize -> 1000
];
borders = GeoGraphics[{
FaceForm[Black],
EdgeForm[White],
GeoStyling[None],
Polygon /@ states,
Inset[alaska, {-0.3, -0.06}, {0, 0}, 0.3],
Inset[hawaii, {-0.15, -0.06}, {0.1569, -0.0436}, 0.3]},
GeoBackground -> None,
GeoProjection -> {
"LambertAzimuthal",
"Centering" -> GeoPosition[{30, -195/2}]
},
PlotRange -> {{-0.37, 0.38}, {-0.13, 0.38}},
ImageSize -> 660
];
ImageAdd[map, borders]
![Finished map][9]
With all FIPS codes
===
When I used an external source for FIPS codes I had FIPS codes for all the counties. Here is an image which shows what the picture looks like then. Hopefully FIPS codes for the remaining counties will be added to the built-in knowledgebase in the future.
![Image with all counties][10]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=georegionvalueplot.png&userId=295249
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=qqfZz.png&userId=295249
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=91gcC.png&userId=295249
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mgij5.png&userId=295249
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=uGD7b.png&userId=295249
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=grvp2.png&userId=295249
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=countyPlotWC.png&userId=295249
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=countyPlotWC2.png&userId=295249
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=finishedmap.png&userId=295249
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=allCounties.png&userId=295249Calle Ekdahl2017-04-28T05:00:53ZFlight data and trajectories of aeroplanes (reload page if empty)
http://community.wolfram.com/groups/-/m/t/1072478
Large amounts of data become evermore available - often these datasets are very valuable and difficult to access. In this post I will show how to use air traffic data to generate visualisations like this one.
![enter image description here][1]
On the website [http://www.flightradar24.com][2] one can find live flight information of most of the civil air traffic. A great amount of information on all current flights is being made available, such as position and altitude, call sign, type of plane, origin and destination and many more. There are different [subscription plans][3] with different features. The largest business plan even allows you to commercially use the data or use them for public display. Alternatively, you can contribute data https://www.flightradar24.com/add-coverage. This can be done with a tiny RTL-SDR receiver, such as [this one][4]. The setup is quite straight forward; I am usually working on Macs on which I had trouble making this work. On a Windows machine (which I only got for this purpose), the setup is quick. The software for sharing your data can be downloaded from [flightradar24's website][5]. You will also need a driver for the SDR stick, which you can download [from here][6]. You should make sure that you have a good visibility of the sky and that the computer and internet connection are stable. I had to use a Windows 8/Windows 10 machine. It was quite annoying that the machine routinely reboots for software updates. If you want uninterrupted monitoring you will have to deactivate this feature. I have no experience with Windows so this was more complicated than I expected. I found a nice set of [instructions here][7].
Once all of this is done and you donate your data, you will automatically upgraded to the Business plan and will have access to a very rich dataset. You will, for example, be allowed to download up to 1000 csv files per month with detailed tracking information of flights in the database. There is much more data available and using the Wolfram Language to analyse it seems to be quite natural.
First explorations
------------------
I download data for a flight from Frankfurt to Aberdeen in csv format. Each row contains a time stamp, date and time of the entry, the callsign, the position (as a string), altitude, speed and direction. I can import the data and then plot it:
flightdata = Import["/Users/thiel/Desktop/Flight_LH971_(cb294d1).csv"];
GeoGraphics[{Red, Thick, GeoPath@(ToExpression[#] & /@ Flatten[StringSplit[#, ","] & /@ flightdata[[2 ;;, {4}]], 1])}]
![enter image description here][8]
I needed to use StringSplit, because the GPS coordinates come in the form of a single string. Next, I can plot the path in 3D. I can clean the data to get it into the right format:
flightphs = {Join[ToExpression[StringSplit[#[[1]], ","]], {ToExpression[#[[2]]]}],ToExpression[#[[3]]]} & /@ flightdata[[2 ;;, {4, 5, 6}]];
Graphics3D[{Red, Thick, Line[{#[[1]], #[[2]], #[[3]]/30000.} & /@ flightphs[[All, 1]]]}]
![enter image description here][9]
The 30000 that I use to divide the altitude is just a scaling factor. (Note that the altitude value comes in feet.) We can now join the flight path to one of Mathematica's maps:
Show[Graphics3D[{Red, Thick, Line[{#[[1]], #[[2]], -#[[3]]/30000.} & /@ flightphs[[All, 1]]]},
Lighting -> {{"Ambient", White}}],
Graphics3D[{Texture[Image[GeoGraphics[GeoPath[GeoPosition[flightphs[[All, 1]]]]]]],
Polygon[(PadRight[#, 3] & /@ Tuples[GeoBounds[GeoPath@GeoPosition[flightphs[[All, 1]]], Scaled[0.05]]])[[{1, 2, 4, 3}]],
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}], ImageSize -> Full]
![enter image description here][10]
It also looks nice on a satellite image background:
Show[Graphics3D[{Red, Thickness[0.005], Line[{#[[1]], #[[2]], -#[[3]]/30000.} & /@ flightphs[[All, 1]]]},
Lighting -> {{"Ambient", White}}], Graphics3D[{Texture[Image[GeoGraphics[{Opacity[0],
GeoPath[GeoPosition[flightphs[[All, 1]]]]}, GeoBackground -> "Satellite"]]],
Polygon[(PadRight[#, 3] & /@ Tuples[GeoBounds[GeoPath@GeoPosition[flightphs[[All, 1]]],
Scaled[0.05]]])[[{1, 2, 4, 3}]], VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}], ImageSize -> Full]
![enter image description here][11]
Multiple flights
----------------
Next, I download 10 trajectories of the flight LH971 from Frankfurt to Aberdeen.
FileNames["*", "/Users/thiel/Desktop/Aberdeen LH971/"]
![enter image description here][12]
I then import all of the trajectories:
flightdataall = Import /@ FileNames["*", "/Users/thiel/Desktop/Aberdeen LH971/"];
This corresponds to 282 entries - each consisting of time stamp, date and time of the entry, the callsign, the position (as a string), altitude, speed and direction. I can clean them all up
flightphsall = ({Join[ToExpression[StringSplit[#[[1]], ","]], {ToExpression[#[[2]]]}], ToExpression[#[[3]]]} & /@ #[[2 ;;, {4, 5, 6}]] &) /@ flightdataall;
and then plot them together:
Show[Graphics3D[{Red, Thickness[0.004],
Line[{#[[1]], #[[2]], -#[[3]]/30000.} & /@ #[[All, 1]] & /@ flightphsall]}, Lighting -> {{"Ambient", White}},
ViewPoint -> {-10.`, 5.`, -5.`}, ViewVertical -> {0.8924410944866072`, -0.23945064940819427`, -7.766116131708949`}],
Graphics3D[{Texture[Image[GeoGraphics[{Opacity[0], GeoPath[GeoPosition[flightphs[[All, 1]]]]},
GeoBackground -> "Satellite", GeoRange -> {{Min[#[[All, 1, 1]]], Max[#[[All, 1, 2]]]}, {Min[#[[All, 2, 1]]], Max[#[[All, 2, 2]]]}} & @(GeoBounds[GeoPath@GeoPosition[#[[All, 1]]], Scaled[0.05]] & /@ flightphsall)]]],
Polygon[(PadRight[#, 3] & /@ Tuples[{{Min[#[[All, 1, 1]]], Max[#[[All, 1, 2]]]}, {Min[#[[All, 2, 1]]], Max[#[[All, 2, 2]]]}} & @(GeoBounds[
GeoPath@GeoPosition[#[[All, 1]]], Scaled[0.05]] & /@ flightphsall)])[[{1, 2, 4, 3}]], VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}],
ImageSize -> Full]
![enter image description here][13]
Note that I use ViewPoint and ViewVertical options. This is because without them, the orientation of the resulting 3D graphic is not optimal. So I plotted the image without the additional options and then rotated it until I was happy with the orientation. Then I use the function
extractViewPos[img_] := Flatten[Union[Extract[img, Position[img, #]] & /@ {ViewPoint -> _, ViewCenter -> _, ViewVertical -> _, ViewAngle -> _,ViewVector -> _, ViewRange -> _}]];
Just copy the image into the square brackets and execute:
extractViewPos[-Graphic goes here-]
and get
{ViewPoint -> {-10., 5., -5.}, ViewVertical -> {0.892441, -0.239451, -7.76612}}
This is not my function, but I found it online and have been using it ever since.
Animating a flight
------------------
Now we can mark the position of the aeroplane by a sphere and animate the flight:
backround3D2 =
Show[Graphics3D[{Red, Thick, Line[{#[[1]], #[[2]], -#[[3]]/30000.} & /@ flightphs[[All, 1]]]},Lighting -> {{"Ambient", White}},
ViewPoint -> {-10.`, 5.`, -5.`}, ViewVertical -> {0.8924410944866072`, -0.23945064940819427`, -7.766116131708949`}],
Graphics3D[{Texture[Image[GeoGraphics[{Opacity[0], GeoPath[GeoPosition[flightphs[[All, 1]]]]}, GeoBackground -> "Satellite"]]],
Polygon[(PadRight[#, 3] & /@ Tuples[GeoBounds[GeoPath@GeoPosition[flightphs[[All, 1]]], Scaled[0.05]]])[[{1, 2, 4, 3}]],
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}],ImageSize -> Full];
Manipulate[
Show[Graphics3D[{Red, Sphere[{#[[1]], #[[2]], -#[[3]]/30000.} & @flightphs[[k, 1]], 0.1]}, ViewPoint -> {-10.`, 5.`, -5.`},
ViewVertical -> {0.8924410944866072`, -0.23945064940819427`, -7.766116131708949`}, ImageSize -> Full], backround3D2], {k, 1, Length[flightphs],5}]
![enter image description here][14]
The multiple flights I have displayed above are the same route but executed by different aeroplanes. Later we will follow individual aeroplanes. But first we will look at the peculiar take-off and landing patterns.
Take-off and landing patterns
-----------------------------
When we look at the take-off and touch-down times we observe that there are two main directions for both starting and destination airports. What decides which direction the planes are taking?
Graphics3D[{Red, Thickness[0.004],
Line[{#[[1]], #[[2]], -#[[3]]/30000.} & /@ #[[All, 1]] & /@ flightphsall]}, Lighting -> {{"Ambient", White}},
ViewPoint -> {-10.`, 5.`, -5.`}, ViewVertical -> {0.8924410944866072`, -0.23945064940819427`, -7.766116131708949`}]
![enter image description here][15]
We first need to determine the wind direction in Frankfurt and Aberdeen on days with either of the two take-off/landing directions. First for Frankfurt.
frankfurttimeheading = Table[Select[flightdataall[[k]], #[[5]] > 4000 &][[1, {1, -1}]], {k, 1, 10}]
which gives
{{1488564623, 69}, {1488650932, 250}, {1488737193, 250}, {1488823517, 249}, {1488909842, 250}, {1488996665, 249}, {1489080927, 250}, {1489168646, 250}, {1489254863, 69}, {1489341257, 69}}
We see that there are two clusters, one at around 69 degrees and one at around 250 degrees:
fdates69 = FromUnixTime /@ Select[frankfurttimeheading, #[[2]] < 100 &][[All, 1]];
fdates250 = FromUnixTime /@ Select[frankfurttimeheading, #[[2]] > 100 &][[All, 1]];
The Wolfram Language knows the wind directions for those days:
WindDirectionData[Entity["Airport", "EDDF"], fdates69]
(*{Quantity[60., "AngularDegrees"], Quantity[70., "AngularDegrees"], Quantity[70., "AngularDegrees"]}*)
and
WindDirectionData[Entity["Airport", "EDDF"], fdates250]
{Quantity[250., "AngularDegrees"], Quantity[170., "AngularDegrees"], Quantity[-60., "AngularDegrees"], Quantity[210., "AngularDegrees"],
Quantity[200., "AngularDegrees"], Quantity[-70., "AngularDegrees"], Quantity[70., "AngularDegrees"]}
It knows the wind vector data; here we plot it for the two situations.
Graphics[Arrow[{{0, 0}, #}] & /@ QuantityMagnitude[WindVectorData[Entity["Airport", "EDDF"], fdates250]]]
![enter image description here][16]
Graphics[Arrow[{{0, 0}, #}] & /@ QuantityMagnitude[WindVectorData[Entity["Airport", "EDDF"], fdates69]]]
![enter image description here][17]
If we now average the data
Show[Graphics[{Red, Thick, Arrow[{{0, 0}, Mean[QuantityMagnitude[WindVectorData[Entity["Airport", "EDDF"], fdates250]]]}]}],
Graphics[{Green, Thick, Arrow[{{0, 0}, Mean[QuantityMagnitude[WindVectorData[Entity["Airport", "EDDF"], fdates69]]]}]}]]
![enter image description here][18]
We see that the wind direction seems to correlate with the take off direction at least for relatively strong winds. This is in agreement with [general advice of how to choose the runway][19]. We can now do the same for Aberdeen.
aberdeentimeheading = Table[Select[Reverse[flightdataall[[k]]], #[[5]] > 4000 &][[1, {1, -1}]], {k, 1, 10}];
We split the dates into two groups: smaller and larger than 200 degrees.
adates230 = FromUnixTime /@ Select[frankfurttimeheading, #[[2]] > 200 &][[All, 1]];
adates169 = FromUnixTime /@ Select[frankfurttimeheading, #[[2]] < 200 &][[All, 1]];
These are the respective vectors:
Graphics[Arrow[{{0, 0}, #}] & /@ QuantityMagnitude[WindVectorData[Entity["City", {"Dundee", "DundeeCity", "UnitedKingdom"}], adates169]]]
![enter image description here][20]
Graphics[Arrow[{{0, 0}, #}] & /@ QuantityMagnitude[WindVectorData[Entity["City", {"Dundee", "DundeeCity", "UnitedKingdom"}], adates230]]]
![enter image description here][21]
Now we can plot this for the different averaged directions.
Show[Graphics[{Red, Thick, Arrow[{{0, 0}, -Mean[QuantityMagnitude[WindVectorData[Entity["City", {"Dundee", "DundeeCity", "UnitedKingdom"}],adates169]]]}]}],
Graphics[{Green, Thick, Arrow[{{0, 0}, -Mean[QuantityMagnitude[WindVectorData[Entity["City", {"Dundee", "DundeeCity", "UnitedKingdom"}],adates230]]]}]}]]
![enter image description here][22]
The pattern here is not so clear. This could be because of low wind speeds.
Following individual aeroplanes (short haul)
--------------------------------------------
We can also follow an individual aeroplane (D-EACB) for, say, one month or so. Download the data and check that they are there:
FileNames["*", "/Users/thiel/Desktop/D-EACB/"]
![enter image description here][23]
Import the data and plot everything:
flightdataDEACB = Import /@ FileNames["*", "/Users/thiel/Desktop/D-EACB/"];
GeoGraphics[{Red, Thick, GeoPath@(ToExpression[#] & /@ Flatten[StringSplit[#, ","] & /@ #, 1]) & /@
flightdataDEACB[[All, 2 ;;]][[All, All, {4}]]}]
![enter image description here][24]
Of course, the same thing in 3D looks somewhat more impressive:
flightphsDEACB = ({Join[
ToExpression[
StringSplit[#[[1]], ","]], {ToExpression[#[[2]]]}],
ToExpression[#[[3]]]} & /@ #[[2 ;;, {4, 5, 6}]] &) /@
flightdataDEACB;
Show[Graphics3D[{Red, Thickness[0.004],
Line[{#[[1]], #[[2]], -#[[3]]/30000.} & /@ #[[All, 1]] & /@
flightphsDEACB]}, Lighting -> {{"Ambient", White}},
ViewPoint -> {-10.`, 5.`, -5.`},
ViewVertical -> {0.8924410944866072`, -0.23945064940819427`, \
-7.766116131708949`}],
Graphics3D[{Texture[
Image[GeoGraphics[{Opacity[0],
GeoPath@(ToExpression[#] & /@
Flatten[StringSplit[#, ","] & /@
flightdataDEACBjoin[[All, {4}]], 1])},
GeoBackground -> "Satellite",
GeoRange -> {{Min[#[[All, 1, 1]]],
Max[#[[All, 1, 2]]]}, {Min[#[[All, 2, 1]]],
Max[#[[All, 2, 2]]]}} & @(GeoBounds[
GeoPath@GeoPosition[#[[All, 1]]], Scaled[0.05]] & /@
flightphsDEACB), GeoProjection -> "Equirectangular"]]],
Polygon[(PadRight[#, 3] & /@
Tuples[{{Min[#[[All, 1, 1]]],
Max[#[[All, 1, 2]]]}, {Min[#[[All, 2, 1]]],
Max[#[[All, 2, 2]]]}} & @(GeoBounds[
GeoPath@GeoPosition[#[[All, 1]]], Scaled[0.05]] & /@
flightphsDEACB)])[[{1, 2, 4, 3}]],
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}],
ImageSize -> Full]
![enter image description here][25]
Following individual aeroplanes (long haul)
-------------------------------------------
All these flights are relatively short distance. I next choose a airbus A380 and look at its movements over a month or so.
flightdataGXLED = Import /@ FileNames["*", "/Users/thiel/Desktop/G-XLED/"];
GeoGraphics[{Red, Thick, GeoPath@(ToExpression[#] & /@ Flatten[StringSplit[#, ","] & /@ #, 1]) & /@
flightdataGXLED[[All, 2 ;;]][[All, All, {4}]]}, ImageSize -> Full]
![enter image description here][26]
Again a 3D representation makes the flight paths come out much better. First we prepare the data:
flightdataGXLEDjoin = Flatten[Select[flightdataGXLED[[All, 2 ;;]], Head[#] > 0 &], 1];
flightphsGXLED = Select[({Join[ToExpression[StringSplit[#[[1]], ","]], {ToExpression[#[[2]]]}], ToExpression[#[[3]]]} & /@ #[[2 ;;, {4, 5, 6}]] &) /@
flightdataGXLED, Length[#] > 0 &];
Then we plot:
Show[Graphics3D[{Red, Thickness[0.002], Line[{#[[1]], #[[2]], -#[[3]]/3000.} & /@ #[[All, 1]] & /@ flightphsGXLED]}, Lighting -> {{"Ambient", White}},
ViewPoint -> {-10.67632349817987`, 3.7276615038423772`, -4.664042818603161`}, ViewVertical -> {0.11539873519013898`, -0.022518333742098193`, -0.9930639740530294`}, ImagePadding -> None],
Graphics3D[{Texture[Image[GeoGraphics[{Opacity[0], GeoPath@(ToExpression[#] & /@
Flatten[StringSplit[#, ","] & /@ flightdataGXLEDjoin[[All, {4}]], 1])}, GeoBackground -> "Satellite", GeoRange -> {{Min[#[[All, 1, 1]]],
Max[#[[All, 1, 2]]]}, {Min[#[[All, 2, 1]]], Max[#[[All, 2, 2]]]}} & @(GeoBounds[GeoPath@GeoPosition[#[[All, 1]]], Scaled[0.05]] & /@
flightphsGXLED), GeoProjection -> "Equirectangular", ImagePadding -> None]]], Polygon[(PadRight[#, 3] & /@
Tuples[{{Min[#[[All, 1, 1]]], Max[#[[All, 1, 2]]]}, {Min[#[[All, 2, 1]]], Max[#[[All, 2, 2]]]}} & @(GeoBounds[GeoPath@GeoPosition[#[[All, 1]]], Scaled[0.05]] & /@ flightphsGXLED)])[[{1, 2, 4, 3}]], VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}], ImageSize -> Full, ImagePadding -> None]
![enter image description here][27]
Representing the flight paths on a sphere
-----------------------------------------
Note that I had to use the Equirectangular projection. Of course, particularly when looking at these long distances it would be more appropriate to represent the Earth as a sphere. We need to convert the coordinates and rescale the altitudes.
toCoordinates[coords_] := FromSphericalCoordinates[{#[[1]], Pi/2 - #[[2]], Mod[Pi + #[[3]], 2 Pi, -Pi]}] & /@ (Flatten[{1., #/360*2 Pi}] & /@ coords)
lengths[inputdata_] := 2.*(inputdata/Max[inputdata])
The representation of the path is somewhat related to [another representation I posted on this community][28].
myFlightPath[data_, radius_, scale_] :=
Show[SphericalPlot3D[radius, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[White, 10], Texture[Import["~/Desktop/backgroundimage.gif"]]],
Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", Boxed -> False, PlotPoints -> 100,
PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Full], Graphics3D[Flatten[{Green, Thickness[0.004],
Line[(radius + #[[2]]*scale)*#[[1]] & /@ Transpose[{toCoordinates[#[[All, 1]]], lengths[#[[All, 2]]]} &@({#[[1]], 1. #[[2]]} & /@ data)]]}]]]
Let's use that to plot one trajectory.
flightpath = {ToExpression[StringSplit[#[[4]], ","]], #[[6]]} & /@ flightdataGXLED[[2, 2 ;;]];
myFlightPath[flightpath, 2, 1/3.]
![enter image description here][29]
If we want to plot multiple flights we should modify the function slightly.
myFlightPathMulti[data_, radius_, scale_] :=
Show[SphericalPlot3D[radius, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[White, 10], Texture[Import["~/Desktop/backgroundimage.gif"]]],
Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", Boxed -> False, PlotPoints -> 100,
PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Full],
Graphics3D[Flatten[{RandomColor[], Thickness[0.004], Line[(radius + #[[2]]*scale)*#[[1]] & /@
Transpose[{toCoordinates[#[[All, 1]]], lengths[#[[All, 2]]]} &@({#[[1]], 1. #[[2]]} & /@ #)]]}] & /@ data]]
Let's prepare the data.
flightpathsmult =
Join[{{#[[1, 1]], 0.}}, #, {{#[[-1, 1]], 0.}}] & /@ Select[({ToExpression[StringSplit[#[[4]], ","]], #[[6]]} & /@ # & /@ flightdataGXLED[[All, 2 ;;]]), Length[#] > 1 &];
The trajectories seem to come out fine:
Graphics3D[
Flatten[{RandomColor[], Thickness[0.01], Line[(2. + #[[2]]*0.3)*#[[1]] & /@
Transpose[{toCoordinates[#[[All, 1]]], lengths[#[[All, 2]]]} &@({#[[1]], 1. #[[2]]} & /@ #)]]}] & /@ flightpathsmult[[1 ;; 10]]]
![enter image description here][30]
Note, that there are some "straight lines" in the trajectories. They correspond to a lack of data point over unpopulated areas. Plotting all trajectories on the globe looks like this:
myFlightPathMulti[flightpathsmult, 2., 1/3.]
![enter image description here][31]
Let's choose a black background:
myFlightPathMultiBlack[data_, radius_, scale_] :=
Show[SphericalPlot3D[radius, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[White, 10], Texture[Import["~/Desktop/backgroundimage.gif"]]],
Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", Boxed -> False, PlotPoints -> 100,
PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Full, Background -> Black],
Graphics3D[Flatten[{RandomColor[], Thickness[0.004], Line[(radius + #[[2]]*scale)*#[[1]] & /@
Transpose[{toCoordinates[#[[All, 1]]], lengths[#[[All, 2]]]} &@({#[[1]], 1. #[[2]]} & /@ #)]]}] & /@ data, Background -> Black]]
and plot:
myFlightPathMultiBlack[flightpathsmult, 2., 1/3.]
![enter image description here][32]
This gives the animation at the beginning of this post.
Further Information that we can extract from the data
-----------------------------------------------------
We can also use the data to get some information about the usage of aeroplanes. We can take the plane with the call sign D-EACB and check for the percentage of time that it is airborne. We first calculate the time window I have data for:
approxTimeWindowDEACB =
Differences[{Select[flightdataDEACB[[1]], #[[-3]] > 10 &][[1, 1]], Select[flightdataDEACB[[Length[flightdataDEACB]]], #[[-3]] > 10 &][[-1, 1]]}][[1]]
This gives 1046462 and is given in seconds. To compute the (approximate) time the plane is airborne we have to check for altitudes larger than some threshold.
approxTimeinAirDEACB =
Total[Flatten[Table[Differences@Reverse@Select[flightdataDEACB[[k]], #[[-3]] > 10 &][[All, 1]][[{1, -1}]], {k, 1, Length[flightdataDEACB]}]]]
which gives 247835 seconds. Now, we can calculate the respective fraction.
N[approxTimeinAirDEACB/approxTimeWindowDEACB]
which gives 0.236831. So this is approximately 24% of the time. Given that planes on short haul flights are mostly grounded over night and that they have substantial time at the airports this seems to be reasonable. Let's do the same for the A 380.
approxTimeWindowGXLED =
Differences[Flatten[Select[Table[Select[Select[flightdataGXLED, Length[#] > 1 &][[k]], #[[-3]] > 10 &], {k, 1, Length[Select[flightdataGXLED, Length[#] > 1 &]]}], Length[#] > 1 &], 1][[{1, -1}, 1]]][[1]]
which is 4258510, and
approxTimeinAirGXLED =
Total[Select[Flatten[Table[If[Length[Select[flightdataGXLED[[k]], #[[-3]] > 10 &][[All, 1]]] > 1,
Differences@Reverse@Select[flightdataGXLED[[k]], #[[-3]] > 10 &][[All, 1]][[{1, -1}]]], {k, 1, Length[flightdataGXLED]}]], NumberQ]]
which is 2445537. This gives
N[approxTimeinAirGXLED/approxTimeWindowGXLED]
so about 57%; hence a more efficient aeroplane use. We can now also determine the average speed when the plane is moving.
N@Mean[DeleteCases[Flatten[flightdataGXLED[[All, 2 ;;]], 1][[All, 6]],0]]
(*366.84*)
This is 367 kts or
UnitConvert[366.84 Quantity[1, "Knots"], Quantity[1, (("Kilometers")/("Hours"))]]
680 km/h. Note that this is a rather inappropriate estimate, because the data is not necessarily sampled uniformly and especially data from over the oceans might be missing. If we accept that issue we can calculate the histogram of the data:
Histogram[DeleteCases[Flatten[flightdataGXLED[[All, 2 ;;]], 1][[All, 6]], 0], Automatic, "PDF", FrameLabel -> {"Speed in kts", "Probablity"},
LabelStyle -> Directive[Bold, 16], ImageSize -> Large, PlotTheme -> "Marketing", ColorFunction -> "TemperatureMap"]
![enter image description here][33]
This graphic suggests that the fast speed flight time is vastly underestimated. The maximum speed is
Max@DeleteCases[Flatten[flightdataGXLED[[All, 2 ;;]], 1][[All, 6]], 0]
(*697*)
which is a ground speed of
N@UnitConvert[697 Quantity[1, "Knots"], Quantity[1, (("Kilometers")/("Hours"))]]
1290.84 km.h. We can compare this to the speed of sound in air.
UnitConvert[ThermodynamicData["Air", "SoundSpeed", {"Temperature" -> Quantity[20, "DegreesCelsius"], "Pressure" -> Quantity[1, "Atmospheres"]}], "Kilometers"/"Hours"]
which gives 1236.18 km/h. So the maximum speed is
1290.84/1236.16
104% of the speed of sound, or Mach 1 (at ground level), which is a bit on the high side. Note that the top speed of the A380 is given as 1020 km/h. The peak in the histogram at cruising speed is at around 490 kts which is in fact the maximal speed of the A380 as given in Wikipedia. The higher than expected ground speed might be due to the jet stream - even though speeds of more than Mach 1 seem to be unlikely. There are [some reports of this happening][34] though.
This is only a very brief description of what can be achieved with the fantastic data from flightradar24. I encourage everyone to join that community and contribute data. The data provided on that site and the power of the Wolfram Language will allow you to gain insight into what is going on in the skies.
Cheers,
Marco
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rotateEarth.gif&userId=48754
[2]: http://www.flightradar24.com
[3]: https://www.flightradar24.com/premium/
[4]: https://www.amazon.co.uk/NooElec-Receiver-Compatible-Packages-Guaranteed/dp/B009U7WZCA/
[5]: https://www.flightradar24.com/share-your-data
[6]: http://zadig.akeo.ie
[7]: http://tunecomp.net/disable-automatic-reboot-after-updates-installation-in-windows-10/
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.11.55.png&userId=48754
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.13.06.png&userId=48754
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.22.00.png&userId=48754
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Onepathrotate.gif&userId=48754
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.23.18.png&userId=48754
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.26.51.png&userId=48754
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=AnimatedFlight.gif&userId=48754
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.36.33.png&userId=48754
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.41.18.png&userId=48754
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.42.06.png&userId=48754
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.43.12.png&userId=48754
[19]: https://www.ivao.aero/training/documentation/books/PP_ADC_select_runway.pdf
[20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.45.55.png&userId=48754
[21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.46.44.png&userId=48754
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.48.26.png&userId=48754
[23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.49.31.png&userId=48754
[24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at23.59.09.png&userId=48754
[25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.00.08.png&userId=48754
[26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.01.39.png&userId=48754
[27]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.05.09.png&userId=48754
[28]: http://community.wolfram.com/groups/-/m/t/905016
[29]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.08.34.png&userId=48754
[30]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.11.21.png&userId=48754
[31]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.12.03.png&userId=48754
[32]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.13.55.png&userId=48754
[33]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at00.21.15.png&userId=48754
[34]: http://www.telegraph.co.uk/news/worldnews/northamerica/usa/11337617/Jet-stream-blasts-BA-plane-across-Atlantic-in-record-time.htmlMarco Thiel2017-04-25T23:26:29ZAnalysing "all" of the world's news - database of everything
http://community.wolfram.com/groups/-/m/t/1073879
There is a fantastic resource online - [The GDELT Project][1] http://gdeltproject.org/. On its front page it describes itself like this: "The GDELT Project is the largest, most comprehensive, and highest resolution open database of human society ever created". Since 2015 it has about 3/4 of a trillion emotional snapshots and more than 1.5 billion location references. It is free and open. There is a very convenient way to download all raw data files. The possibilities are endless and I guess that some version or subset of it would be a fantastic addition to the [Wolfram Data Repository][2]. The data is free to use and apparently can be redistributed.
I will show some basic analysis of the data and will produce graphics such as this one.
![enter image description here][3]
We will also "calculate how positive different countries are/see the world". This post serves only as a brief introduction to the dataset. Much more is possible and I hope to explore more in future posts.
Downloading the data
--------------------
First, I make a little script to download the data. The database is updated on a daily basis. So it is convenient to have a script to updates ones database. I create a Folder (on my Desktop) and then run this script. If you download the data for the first time this will take a while. You might want to only download parts of the database at once.
previousDownloads =
FileNameTake /@ FileNames["*", "~/Desktop/WorldEvents/"];
downloadList = Select[Import["http://data.gdeltproject.org/events/index.html", "Hyperlinks"], StringContainsQ[#, ".zip"] && ! StringContainsQ[#, "MASTERREDUCED"] && ! StringContainsQ[#, previousDownloads] &];
URLDownload[#, StringJoin["~/Desktop/WorldEvents/", FileNameTake[#]]] & /@ downloadList;
The good thing about this is that the download is incremental. If you execute these lines only new files will be downloaded and you can keep your database up to date. We should set the working directory like this:
SetDirectory[FileNameJoin[{NotebookDirectory[], "WorldEvents"}]]
I have downloaded a large set of files, the names of which I can read like this:
files = FileNames["*"];
At the time of writing these lines I have
files // Length
1596 files. That are
Total[FileByteCount /@ files]
(*23626922639*)
about 22.5 GB worth of data. This is a size where it might be useful to use the Wolfram Language's ability to interface with mySQL, but I will try to run some exploratory analysis purely in Mathematica. I will start with just one of the files:
dataworldevents = Import[files[[-2]], {Import[files[[-2]]], "TSV"}];
The first line of the data looks like this:
dataworldevents[[1]]
![enter image description here][4]
To make sense of this we download the header for the files
labels = Import["http://gdeltproject.org/data/lookups/CSV.header.dailyupdates.txt","TSV"][[1]]
![enter image description here][5]
and display one entry like this
TableForm[Transpose@{Range[Length[labels]], labels, dataworldevents[[33]]}]
![enter image description here][6]
There's is an incredible amount of information in these lines. Line one is an event id. Lines 2-5 provide information about the time the event took place; lines 6-15 provide information about the actor in the article, here it is Virgina in the US. 15-25 provide information about the second actor, here Cincinnati in the US. Line 26 gives information of whether this is a root event. Lines 27-29 give information about what happened. Here is a list of all the event codes:
eventcodes = Import["http://gdeltproject.org/data/lookups/CAMEO.eventcodes.txt", "TSV"];
To get a feeling for the codes I only want to display a random choice of event codes here:
TableForm[SortBy[RandomChoice[eventcodes, 10], First]]
![enter image description here][7]
Because I need this later, I will generate a list of rules, that links the event codes to the description of the events.
eventcoderules = Rule @@@ eventcodes[[2 ;;]];
The next important line of the data entry is line 31, which is the GoldsteinScale of the event. Each event code has a certain impact: positive or negative. The GoldsteinScale attaches an importance to the event.
goldsteinscale = Import["http://gdeltproject.org/data/lookups/CAMEO.goldsteinscale.txt", "TSV"];
Here is a table to explain what the Goldstein scale does:
Grid[Prepend[{#[[1]], #[[1]] /. eventcoderules, #[[2]]} & /@ RandomChoice[goldsteinscale, 10], {"Event code",
"Event description", "Goldstein value"}], Frame -> All, Alignment -> {{"Center", "Left", "Center"}}]
![enter image description here][8]
It becomes clear that negative numbers like -10. correspond to "bad" events - like "kill by physical assault" and positive numbers correspond to "positive" events like "offer diplomatic cooperation".
Lines 32-34 provide information on how often this event is cited. Line 35 is on the average tone of the news. Lines 36-55 give the information on the geolocation of the actors and the event. Line 57 is when the event was added and line 58 is a link to the actual article. Note that sometimes the source articles get deleted after a while.
Average tone of the articles
----------------------------
We can first look at the average tone of an article. The average tone is in column 35:
labels[[35]]
(*AvgTone*)
A histogram of this is readily calculated:
Histogram[dataworldevents[[All, 35]], 80, PlotTheme -> "Marketing", ImageSize -> Large, LabelStyle -> Directive[Bold, 16],
FrameLabel -> {"Average tone", "Number of reports"}]
![enter image description here][9]
The mean and median of the average tone are both negative:
Mean[dataworldevents[[All, 35]]]
(*-1.96202*)
Median[dataworldevents[[All, 35]]]
(*-1.69492*)
We can also fit a distribution to that:
dist = SmoothKernelDistribution[dataworldevents[[All, 35]]]
and plot it
Show[Histogram[dataworldevents[[All, 35]], 80, "PDF", PlotTheme -> "Marketing", ImageSize -> Large,
LabelStyle -> Directive[Bold, 16], FrameLabel -> {"Average tone", "Number of reports"}],
Plot[PDF[dist, x], {x, -20, 15}, PlotStyle -> Directive[Yellow, Thickness[0.01]]]]
![enter image description here][10]
Let's see what type of distribution this could be:
FindDistribution[RandomChoice[dataworldevents, 20000][[All, 35]]]
(*MixtureDistribution[{0.497244, 0.502756}, {LogisticDistribution[-3.67395, 2.14875], NormalDistribution[-0.3071, 2.5434]}]*)
In this particular case a mixture of a Logistic and Normal Distribution does appear to do the trick. We will later look at the average tone in different countries.
Geo-distribution of the articles/news
-------------------------------------
Let's look at where the news happens:
worldeventlocs = DeleteCases[dataworldevents[[All, {40, 41}]],List["",""]];
I will use a special GeoHistogram that I programmed for another post.
toCoordinates[coords_] :=
FromSphericalCoordinates[{#[[1]], Pi/2 - #[[2]], Mod[Pi + #[[3]], 2 Pi, -Pi]}] & /@ (Flatten[{1., #/360.*2 Pi}] & /@ coords)
lengths[inputdata_] := 2.*(inputdata/Max[inputdata])
myGeoHistogram[data_, radius_] :=
Show[SphericalPlot3D[radius, {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None, TextureCoordinateFunction -> ({#5, 1 - #4} &),
PlotStyle -> Directive[Specularity[White, 10], Texture[Import["~/Desktop/backgroundimage.gif"]]], Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip", Boxed -> False, PlotPoints -> 100, PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}, ImageSize -> Full], Graphics3D[Flatten[{Green, Thickness[0.00275],
Line[{#[[1]], (radius + #[[2]])*#[[1]]}] & /@ Transpose[{toCoordinates[#[[All, 1]]], lengths[#[[All, 2]]]} &@(data /. "" -> 1.)]}]]]
The background image is attached to the post. One more data cleaning step:
worldeventlocsplace = DeleteCases[dataworldevents[[All, {54, 55}]],List["",""]];
This is the resulting graph:
myGeoHistogram[Transpose@{worldeventlocsplace[[1 ;; 10000]], ConstantArray[1, 10000]}, 3.]
![enter image description here][11]
Searching the database
----------------------
Once the data is imported we can also look for particular key words and actors, such as former president Obama.
Select[dataworldevents[[All, {7, 17}]], MemberQ[#, "OBAMA"] &] // Length
There are 955 entries for that day. Here is a selection of the entries.
Select[dataworldevents[[All]], MemberQ[#, "OBAMA"] &][[1 ;; 5]] // TableForm
![enter image description here][12]
Because they are too rich to display properly we can look at the urls that are linked to get an idea of the content.
Select[dataworldevents[[All]], MemberQ[#, "OBAMA"] &][[1 ;; 5]][[All, -1]] // TableForm
![enter image description here][13]
We can see that all of them contain the name Obama. Interestingly, president Trump does not come up if we search like this.
Select[dataworldevents[[All]], MemberQ[#, "TRUM"] &] // Length
(*0*)
We can, however, go directly to the urls and find his name:
Select[dataworldevents, StringContainsQ[#[[-1]], "TRUMP", IgnoreCase -> True] &] // Length
(*11250*)
And here are the corresponding urls:
Select[dataworldevents, StringContainsQ[#[[-1]], "TRUMP", IgnoreCase -> True] &][[1 ;; 5]][[All, -1]] // TableForm
![enter image description here][14]
We can also search for particular types of events, such as event number 1823
Select[dataworldevents, #[[27]] == 1823 &] // Length
107 entries in the database. Many of which are repeated events.
Latest events
-------------
We can also look at some of the latest events. It turns out that there is a file with the images corresponding to the latest events. Here is an example of how to use that feature.
tmpfile = URLDownload[StringSplit[Import["http://data.gdeltproject.org/gdeltv2_cloudvision/lastupdate.txt"], " "][[-1]], NotebookDirectory[]];
imgdata = Import[tmpfile[[1]], "TSV"]; DeleteFile[tmpfile[[1]]];
We can look at some of these images. Also, all of them are labelled by a machine learning algorithm. This is what we get:
Grid[Table[{Import[imgdata[[k, 3]]], TableForm[(StringSplit[#, "<FIELD>"] & /@ StringSplit[imgdata[[k, 4]], "<RECORD>"])[[All, {1, 2}]]]}, {k,101, 108}], Frame -> All]
![enter image description here][15]
All images also contain information about where we find what. Here is one of the images:
imgperson = ImageResize[Import[imgdata[[114, 3]]], 200]
![enter image description here][16]
We can extract data from the annotation:
StringSplit[StringTake[StringSplit[imgdata[[114, 12]], "\"faceAnnotations\":"][[2]], 200], { "\"vertices\": [", ", \"fdBoundingPoly\""} ][[2]]
![enter image description here][17]
HighlightImage[imgperson, Polygon[{#[[1]] - ImageDimensions[imgperson][[1]], #[[2]]} & /@ {{ 89, 3}, { 413, 3 }, {413, 380 }, {89, 380 }}]]
![enter image description here][18]
Which in this case is the entire frame.
"Positivity-index"
------------------
We have two columns which give us information about how positive/negative a reported event is. Column 31 ("GoldsteinScale") and column 35 ("Average Tone"). We will also use the geo-coordinates.
labels[[{54, 55, 31, 35}]]
![enter image description here][19]
The following graphic shows the average tone of a news article (40000 or so of them):
GeoRegionValuePlot[GeoPosition[#[[1]]] -> #[[2, 2]] & /@ (DeleteDuplicatesBy[Select[Partition[#, 2] & /@
Cases[dataworldevents[[1 ;; 40000, {54, 55, 31, 35}]], {_?NumberQ, _?NumberQ, _?NumberQ, _?NumberQ}], ! (#[[1]] == {"", ""}) &], First]),
GeoBackground -> "Satellite", ImageSize -> Full, ColorFunctionScaling -> True, ColorFunction -> ColorData["TemperatureMap"],
PlotStyle -> Directive[Opacity[1.]]]
![enter image description here][20]
There are relatively few very positive reports but a number of very negative ones. Again, remember that the average tone is negative:
Histogram[Select[Partition[#, 2] & /@ dataworldevents[[1 ;; 40000, {54, 55, 31, 35}]], ! (#[[1]] == {"", ""}) &][[All, 2, 2]], 60, PlotTheme -> "Marketing", ImageSize -> Large, LabelStyle -> Directive[Bold, 16], FrameLabel -> {"Average tone", "Number of reports"}]
![enter image description here][21]
We can calculate how many negative pieces of news there are:
Select[Select[Partition[#, 2] & /@ dataworldevents[[1 ;; 40000, {54, 55, 31, 35}]], ! (#[[1]] == {"", ""}) &][[All, 2, 2]], # < 0 &] // Length
(*26093*)
and how many positive ones:
Select[Select[Partition[#, 2] & /@ dataworldevents[[1 ;; 40000, {54, 55, 31, 35}]], ! (#[[1]] == {"", ""}) &][[All, 2, 2]], # > 0 &] // Length
(*11965*)
You see that there more than twice as many negative reports than positive ones. We can also focus on individual countries:
GeoRegionValuePlot[
GeoPosition[#[[1]]] -> #[[2, 2]] & /@ DeleteDuplicatesBy[Select[Partition[#, 2] & /@ Cases[dataworldevents[[1 ;; 40000, {54, 55, 31, 35}]], {_?NumberQ, _?NumberQ, _?NumberQ, _?NumberQ}], ! (#[[1]] == {"", ""}) &], First], GeoBackground -> "Satellite", ImageSize -> Full, ColorFunctionScaling -> True,
ColorFunction -> ColorData["TemperatureMap"], PlotStyle -> Directive[Opacity[1.]], GeoRange -> Entity["Country", "India"]]
![enter image description here][22]
Column 52 shows the country code of an event. These are all the countries:
DeleteDuplicates[dataworldevents[[All, 52]]]
![enter image description here][23]
Let's build a look-up table for country names and codes:
Quiet[countryCodes =
SortBy[DeleteDuplicates[Rule @@@ Transpose[{StringTrim[StringSplit[dataworldevents[[All, 51]], ","][[All, -1]]] /. {} -> {"NA"},
dataworldevents[[All, 52]] /. "" -> "UNKNOWN"}]], First][[2 ;;]]];
countryCodes[[1 ;; 10]]
![enter image description here][24]
Using this table we can calculate the mean happiness in each country:
Monitor[countryHappiness =
SortBy[Table[{StringTrim[countryCodes[[i, 1]]], Mean[Select[dataworldevents[[All, {54, 55, 31, 35, 52}]], #[[-1]] == countryCodes[[i, 2]] &][[All, 4]]]}, {i, 1, Length[countryCodes]}], Last];, i]
This is the resulting table:
Grid[{TableForm /@ Partition[SortBy[#, First] &@Select[countryHappiness, ! (#[[1]] == "NA" || #[[1]] == "" || #[[1]] == "The") &], 76]}, Frame -> All,
Background -> LightGray]
![enter image description here][25]
Next we can try to make this into a geo-movie. We should first use the interpreter function to convert the country names into entities:
countryEntity = Interpreter["Country"][Select[countryHappiness, ! (#[[1]] == "NA" || #[[1]] == "" || #[[1]] == "The") &][[All, 1]]];
Not all of them will have worked, but the large ones are usually fine. So now we can create a lookup table again:
countryrules =
Rule @@@ Select[Transpose[{Select[countryHappiness, ! (#[[1]] == "NA" || #[[1]] == "" || #[[1]] == "The") &][[All, 1]], countryEntity}],
Head[#[[2]]] == Entity &];
With this we can plot a map:
GeoRegionValuePlot[Rule @@@ (countryHappiness /. countryrules), ColorFunction -> Function[{x}, ColorData["Temperature"][x]](*,ColorFunction-> "Rainbow"*), ImageSize -> Full, PlotRange -> {-3, 1}(*,PlotLegends\[Rule]Histogram*)]
![enter image description here][26]
For some countries we have no data; but we will change that now. First of all we will load all data:
dataworldeventsmult = Import[#, {Import[#], "TSV"}] & /@ files[[-3 ;; -2]];
We will calculate the country codes again:
countryCodes =
DeleteDuplicates[Rule @@@ Transpose[{StringTrim[StringSplit[dataworldevents[[All, 51]], ","][[All, -1]]] /. {} -> {"NA"},
dataworldevents[[All, 52]] /. "" -> "UNKNOWN"}]]
![enter image description here][27]
We can then generate all the happiness data for all times and countries:
countryHappinessmult = {}; Monitor[Table[dataworldeventsmult = Import[files[[Length[files] - j - 1]], {Import[files[[Length[files] - j - 1]]],"TSV"}];
AppendTo[countryHappinessmult, {#[[1, -1]] /. (Reverse /@ countryCodes), Mean[#[[All, 2]]]} & /@ GatherBy[dataworldeventsmult[[All, {31, 35, 52}]], Last]];, {j, 1,1000}], j]
This takes quite a while so we should better export the data:
Export["~/Desktop/countryhappinessresult.mx", countryHappinessmult];
With that we can calculate the mean happiness per country and rank them according to happiness:
meanhappinessmult = {#[[1, 1]], Mean[Select[#[[All, 2]], NumberQ]]} & /@ GatherBy[Flatten[countryHappinessmult[[1 ;; 700]], 1], First];
Grid[{TableForm /@ Partition[Reverse[SortBy[Select[meanhappinessmult, ! (#[[1]] == "NA" || #[[1]] == "" || #[[1]] == "The" || ! NumberQ[#[[2]]]) &], Last]], UpTo[87]]}, Frame -> All, Background -> LightGray]
![enter image description here][28]
So the West Bank, Syria, and the Gaza Strip have rather negative news and the Seychelles have rather good news. We can plot this for some countries:
DateListPlot[{Transpose[{Table[
DatePlus[DateObject[{2017, 2, 2}], 1 - i], {i, 1, 700}],
Table[Select[
countryHappinessmult[[k]], #[[1]] == "United States" &][[
1]], {k, 1, Length[countryHappinessmult]}][[1 ;; 700, 2]]}],
Transpose[{Table[
DatePlus[DateObject[{2017, 2, 2}], 1 - i], {i, 1, 700}],
Table[Select[
countryHappinessmult[[k]], #[[1]] == "United Kingdom" &][[
1]], {k, 1, Length[countryHappinessmult]}][[1 ;; 700, 2]]}],
Transpose[{Table[
DatePlus[DateObject[{2017, 2, 2}], 1 - i], {i, 1, 700}],
Table[Select[countryHappinessmult[[k]], #[[1]] == "Germany" &][[
1]], {k, 1, Length[countryHappinessmult]}][[1 ;; 700, 2]]}]},
PlotRange -> All, ImageSize -> Full,
PlotLegends -> {"United States", "United Kingdom", "Germany"},
LabelStyle -> Directive[Bold, 16]]
![enter image description here][29]
It is interesting that the curve for Germany has the strongest "dips". There is a clear dip in June (Brexit) and another one at the end of the year. The United Kingdom is the happiest of the three (with large positive spikes), the US is somewhat in the middle, and Germany is usually lowest with extremely low points. Does this reflect how people think? Do the negative articles make people more negative?
It is straight forward to make a little animation of the happiness over time geographically in the world.
Monitor[frames = Table[GeoRegionValuePlot[Rule @@@ ((Select[countryHappinessmult[[k]], ! (#[[1]] == "NA" || #[[1]] == "" || #[[1]] == "The" || ! NumberQ[#[[2]]]) &]) /. countryrules), ColorFunction -> Function[{x}, ColorData["Temperature"][x]](*,ColorFunction\[Rule]"Rainbow"*), ImageSize -> Full,
PlotRange -> {-3, 1}(*,PlotLegends\[Rule]Histogram*), Epilog -> {Black, Text[Style[DateString[DatePlus[DateObject[{2017, 2, 2}], 1 - k]], 22], {-120., -65.}]}, PlotLegends -> False, GeoCenter -> GeoPosition[{0., 0.}]], {k, 1, Length[countryHappinessmult]}];, k]
The movie can then be exported like so:
Monitor[Do[Export["~/Desktop/Worldeventsmovie/frame" <> ToString[1000 + k] <> ".jpg", frames[[k]], ImageResolution -> 100], {k, 1, Length[frames], 2}], k]
Here is a snapshot
![enter image description here][30]
The video is [uploaded to Youtube][31]. We can also do this a little bit more systematically by building time series:
countries = Select[Sort[DeleteDuplicates[Flatten[countryHappinessmult[[All, All, 1]]]]], StringLength[#] > 2 &];
Monitor[timeseries =
Table[(Reverse@Transpose[{Table[DatePlus[DateObject[{2017, 2, 2}], 1 - i], {i, 1, 700}], Table[Select[countryHappinessmult[[k]], #[[1]] == countries[[m]] &][[1]], {k, 1, Length[countryHappinessmult]}][[1 ;; 700, 2]]}]), {m, 1, Length[countries]}];, m]
Now we can conveniently plot that:
DateListPlot[timeseries[[1 ;; 5]], PlotLegends -> countries[[1 ;; 5]],ImageSize -> Large, LabelStyle -> Directive[Bold, 17]]
![enter image description here][32]
Or we can show random countries:
choice = RandomChoice[Range[Length[countries]], 5];
DateListPlot[timeseries[[choice]], PlotLegends -> countries[[choice]],ImageSize -> Large, LabelStyle -> Directive[Bold, 17]]
![enter image description here][33]
Having converted everything into times series would allow us to use all the powerful tools that the Wolfram Language offers to work with time series.
Events in time
--------------
I have not taken great care in this post to find optimal ways of cleaning the data; I have not defined nice functions. All of that can be achieved quite easily. Here I define some functions that allow us to download data "on the fly". The first one transforms a DateObject into a string which part of the respective file name.
dateString[date_DateObject] :=
FromDigits[Join[{2, 0}, Flatten[PadLeft[#, 2, 0] & /@ IntegerDigits /@ Drop[DateList[date], -1]], {0, 0}]]
The next one helps to import the respective file.
eventsImport[date_DateObject] := Import["http://data.gdeltproject.org/gdeltv2/" <> ToString[dateString[date]] <> ".export.CSV.zip", {{"*"}, "TSV"}][[1]]
This allows us to import the data for a particular date:
events = eventsImport[DateObject[{2017, 2, 2, 21, 30}]];
TableForm[Join[{labels}, events[[-10 ;;]]]]
![enter image description here][34]
The first couple of events will have an earlier date, because they predate the time when the article was added to the database.
Graphs and all that
-------------------
With the Wolfram Language it is incredibly easy to make Graphs using the data. This here for example is a network of "actors".
Graph3D[RandomChoice[Rule @@@ Select[dataworldevents[[All, {7, 17}]], ! MemberQ[#, ""] &], 5000],
ImageSize -> Full, VertexStyle -> Yellow, EdgeStyle -> Yellow, Background -> Black]
![enter image description here][35]
Also the country codes of the actors and actions are networked in an interesting way:
CommunityGraphPlot[RandomChoice[Rule @@@ Select[dataworldevents[[All, {38, 45}]], (! MemberQ[#, "" && #[[1]] != #[[2]]]) &], 1000]]
![enter image description here][36]
This is the largest component of the graph above
![enter image description here][37]
I suppose that all of this only gets truly interesting when we get to levels 6 or 7 of [Stephen Wolfram's data preparation scheme][38]; only then can we use the full information from the Wolfram language.
Conclusions
-----------
There is an awful lot to explore in this dataset. On the website of the GDELT project they show very nice representations, which can easily be reproduced with the Wolfram Language. Can you find any interesting links between events? Can you use the annotated images to train a useful neural network in Mathematica?
Because of the fact that this data set is freely available and that the terms of use are very permitting, I believe that this could be a brilliant addition to the Wolfram Data Repository. I think that one of the driving forces behind the WDR is [@Alan Joyce][at0]. Wouldn't it be nice to demonstrate the process to prepare data for the repository that [Stephen Wolfram describes in his latest Blog Post][39] on this data set?
Cheers,
Marco
[at0]: http://community.wolfram.com/web/alanj
[1]: http://www.gdeltproject.org
[2]: https://datarepository.wolframcloud.com
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Worldevents.gif&userId=48754
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.18.47.png&userId=48754
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.19.42.png&userId=48754
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=onedataentry.gif&userId=48754
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.27.46.png&userId=48754
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.30.21.png&userId=48754
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.32.10.png&userId=48754
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.34.32.png&userId=48754
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.41.30.png&userId=48754
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.42.56.png&userId=48754
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.44.06.png&userId=48754
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.46.44.png&userId=48754
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ImagesGDELT.gif&userId=48754
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.53.28.png&userId=48754
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.54.14.png&userId=48754
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.54.56.png&userId=48754
[19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.56.06.png&userId=48754
[20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.57.33.png&userId=48754
[21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at21.58.41.png&userId=48754
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.02.41.png&userId=48754
[23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.03.33.png&userId=48754
[24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.05.03.png&userId=48754
[25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=happinesstable.gif&userId=48754
[26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.11.14.png&userId=48754
[27]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.13.04.png&userId=48754
[28]: http://community.wolfram.com//c/portal/getImageAttachment?filename=worldhappinesstable.gif&userId=48754
[29]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.19.38.png&userId=48754
[30]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.27.32.png&userId=48754
[31]: https://youtu.be/0mG7jCkFFJM
[32]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.30.19.png&userId=48754
[33]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.31.27.png&userId=48754
[34]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.36.09.png&userId=48754
[35]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Networkactors.gif&userId=48754
[36]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.59.15.png&userId=48754
[37]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-26at22.59.59.png&userId=48754
[38]: http://blog.stephenwolfram.com/data/uploads/2017/04/Data-Hierarchy-Levels-Zoom1.png
[39]: http://blog.wolfram.com/2017/04/20/launching-the-wolfram-data-repository-data-publishing-that-really-works/Marco Thiel2017-04-26T22:03:26ZWhat are the options for OutputResponse?
http://community.wolfram.com/groups/-/m/t/1075991
Hi again!
OutputResponse or StateResponse are very convenient functions for simulating system models. I understand they are based on NDSolve and I thought that all options of NDSolve can be used in these functions but they cannot, am I right? For instance I wanted to avoid a change in step sign using Method -> {"StiffnessSwitching"} and I got the error "OutputResponse::method2: The method StiffnessSwitching is not a known method".
Why is that?
The test system is included in the attached notebook.
Regards
JesusJ Jesus Rico-Melgoza2017-04-28T04:31:56ZCreate a Step-by-step equation solver API?
http://community.wolfram.com/groups/-/m/t/1071854
Ok, the idea seems very weird...I know. I'm a very big noob at Mathematica, I downloaded it 2 weeks ago, but I think that's the most awesome software on earth. Anyway, I know that it's possible to get [Step-by-step solution][1] using Wolfram Alpha like this: `WolframAlpha["x^2=x+1"]`
And I also know that it's possible to deploy an API using the [Cloud Deploy][2] function, but I would like to create an API that when you input: `?q=x^2==x+1` returns a JSON array like this:
{
"1": {
"text": "Solve for x over the real numbers:",
"expression": "x^2==x+1"
},
"2": {
"text": "Subtract x+1 from both sides:",
"expression": "x^2-x-1==0"
},
"3": {
"text": "Add 1 to both sides:",
"expression": "x^2-x==1"
},
"4": {
"text": "Add 1/4 to both sides:",
"expression": "x^2-x+1/4==5/4"
},
"5": {
"text": "Write the left hand side as a square:",
"expression": "(x-1/2)^2==5/4"
},
"6": {
"text": "Take the square root of both sides:",
"expression": "x-1/2==Sqrt[5]/2 or x-1/2==-(Sqrt[5]/2)"
},
"7": {
"text": "Add 1/2 to both sides:",
"expression": "x==1/2+Sqrt[5]/2 or x-1/2==-(Sqrt[5]/2)"
},
"8": {
"text": "Add 1/2 to both sides:",
"expression": "x==1/2+Sqrt[5]/2 or x==1/2-Sqrt[5]/2"
}
}
Or something like this. I know that's it's ambitious, and I don't expect something with tons of options, as I said, I want something simple (if it's possible to do of course :) ). Thank you for taking your time reading my question, and I hope it's possible to do. You can see this as a challenge ;)
[1]: https://mathematica.stackexchange.com/questions/148/get-a-step-by-step-evaluation-in-mathematica
[2]: https://www.wolfram.com/language/fast-introduction-for-programmers/en/cloud-deployment/Arthur Guiot2017-04-25T11:20:34ZHow do I plot a solid bounded below by g(x,y) and above by h(x,y)?
http://community.wolfram.com/groups/-/m/t/1074028
Hi!
I'm not sure if this is the right place to ask this type of question, but how would I graph a solid bounded below by
g[x_, y_] = 9 - x^2 - 4 y^2
and above by
h[x_, y_] = 25 - 4 x^2 - 16 y^2
where the boundaries are given to be (|x| < 3 , |y| < 3 , 0 < z < 30)?
I'm required to use *RegionFunction[]* to limit the bounds by their intersection but when I did so, I got an odd looking graph.
Here's the relevant part of the code as well as the resulting graph.
g[x_, y_] = 9 - x^2 - 4 y^2;
h[x_, y_] = 25 - 4 x^2 - 16 y^2;
i[x_, y_] = h[x, y] - g[x, y];
p1 = Plot3D[g[x, y], {x, -3, 3}, {y, -3, 3},
PlotRange -> {0, 30},
Mesh -> None,
RegionFunction -> Function[{x, y, z}, g[x, y] < i[x, y] < h[x, y]]];
p2 = Plot3D[h[x, y], {x, -3, 3}, {y, -3, 3},
PlotRange -> {0, 30},
Mesh -> None,
RegionFunction -> Function[{x, y, z}, g[x, y] < i[x, y] < h[x, y]],
PlotStyle -> {Blue, Opacity[0.5]}];
Show[{p1, p2},
PlotLabel -> "Ideal Model for a Small Jet of Ionized Particles",
AxesLabel -> {"x", "y", "z"},
BoxRatios -> {1, 1, 1},
ImageSize -> Large]
![Overlaid Graphs][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture3.PNG&userId=1074014Phil .2017-04-27T01:36:36ZFinance - Pricing of Exotic Options - Problems with a triple integration
http://community.wolfram.com/groups/-/m/t/1075930
Hi,
I'm a new user of Mathematica and I'm writing a thesis on financial models to price options. I'm currently trying to calculate a triple integral in order to price an exotic call european option (basket option) on a basket of 3 financial assets (S1,S2 and S3) with weights of w1, w2 and w3. So my basket is w1.S1+w2.S2+w3.S3. Here is the formula :![enter image description here][1]
And this is the code that I tried (attached), but it finds a price that makes no sense...
(with Rf the risk free rate, dt the maturity, n the number of assets, Sigma1 the volatility of the 1st asset, K the strike of my option, ΩT.Ω = VCV the variance-covariance 3x3 matrix of the assets)
Thank you for your help !
Best regards,
Nicolas
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Captured%E2%80%99e%CC%81cran2017-04-27a%CC%8018.42.55.png&userId=1075399Nicolas BADUEL2017-04-27T23:47:33ZUse Assumptions and Integrate?
http://community.wolfram.com/groups/-/m/t/1074810
Mathematica 11.1
Can someone explain why in the following "Assumptions" does not work as expected:
Integrate[ Sin[n x]^2, {x, 0, 2 Pi}, Assumptions -> n \[Element] Integers]
This gives:
Pi - Sin[4 n Pi ]/(4 n)
The second part is clearly redundant, but not even "Simplify" or "FullSimplify" will eliminate it.Daniel Huber2017-04-27T09:03:47ZWolfram functions for the Raspberry Pi Sense Hat
http://community.wolfram.com/groups/-/m/t/786114
I clearly remember reading detailed instructions for accessing the Raspberry Pi Sense Hat using Wolfram language functions but I can't find them now. I've searched the Wolfram, Raspberry, and Adafruit sites and I have found anything. Can anyone point me in the right direction?
Just because I remember reading something doesn't mean I actually did. I may be misremembering the python instruction.
Thanks for any help you can provide.
~~Dan WheelerDan Wheeler2016-02-03T19:37:05Z[✓] Define the output of a function as a new function?
http://community.wolfram.com/groups/-/m/t/1069944
Hey Guys!
I've got the following problem. I have the function
f[a_,b_,c_]=a+b/c
Now I'd like to set a new function
g[a_,b_,c_]=D[f[a_,b_,c_],a_]
So the plan would be to have a new function which I can use to compute g for different a,b,c. For example I'd say `a=1 b=2 c=3` and Mathematica would tell me `g`. Obviously it does not work because i have the same variables on the right and on the left side. I've already googled my brain away but I found no solution. Do you have some advice for me?
I am sorry if I formatted something wrong, this is my first activity in the Wolfram community.
Thanks,
TobiasTobias Mitterdorfer2017-04-22T19:38:25Z[✓] Issue with label backgrounds in Graphics3D
http://community.wolfram.com/groups/-/m/t/1035985
A new, undesired, "feature" in MMA 11.1 is that labels in Graphics3D seems to always be rendered against a white background. These screenshots below are from a recent [Demonstration by Izidor Hafner][1]
MMA 10.4
![enter image description here][2]
MMA 11.1
![enter image description here][3]
[1]: http://demonstrations.wolfram.com/FourTheoremsOnSphericalTriangles/
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=MMA10.4.png&userId=93385
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=MMA11.1.png&userId=93385Hans Milton2017-03-20T19:20:57ZEvolution of Stars: Hertzsprung-Russell diagram
http://community.wolfram.com/groups/-/m/t/578543
Hi,
I just made a little Hertzsprung-Russell diagram for a class of mine. It's not quite perfect yet, but I wanted to post it anyway.
Mathematica (wikipedia?) knows what that diagram is:
WikipediaSearch["Hertzsprung Russell diagram"]
gives:
> <|"Title" -> "Hertzsprung-Russell diagram",
>
>"Snippet" -> "The
> Hertzsprung-Russell diagram, abbreviated H-R diagram or HRD, is
> a scatter graph of stars showing the relationship between the stars'
> absolute magnitudes or luminosities versus their spectral
> classifications or effective temperatures."|
All the data I need is in Mathematica.
stars = StarData[];
contains data for more than 107,000 stars. I will only download data for 10,000 stars as to not overload my final image.
starChoice = RandomChoice[stars, 10000];
starData = StarData[starChoice, {"Luminosity", "EffectiveTemperature", "Mass", "Radius", "BVColorIndex", "Color"}];
I access luminosity, surface temperature, mass, radius, and color data for the stars. I will want to use BubbleChart to generate the diagram. The position of the bubbles will be given by (the logarithms of) the luminosity and the surface temperature; note that the x-asis is reversed. The size of the bubbles will encode the radius and I would like to color the bubbles in a way that relates to their BVColorIndex. The most difficult issue is the colour. As a matter of fact, I will cheat a bit to make the colour distribution clearer. I use some formulas from this [website][1] for the conversion of BV to RGB colour.
{\[Lambda], x, y, z} = Import["http://www.cvrl.org/database/data/cmfs/ciexyzjv.csv"]//Transpose;
XYZ[t_] := Module[{h = 6.62607*10^-34, c = 2.998*10^8, k = 1.38065*10^-23}, {x, y, z}.((2 h c^2)/((-1 + E^((h c/k)/(t \[Lambda]*10^-9))) (\[Lambda]*10^-9)^5)) // #/#[[2]] &]
The plot is quite easy to generate from here:
normsun = QuantityMagnitude[StarData["Sun", "Luminosity"]];
BubbleChart[
Style[{Log[10, QuantityMagnitude[#[[2]]]], QuantityMagnitude[#[[1]]]/normsun, QuantityMagnitude[#[[4]]]},
ColorConvert[XYZColor @@ XYZ[4600*((1/(0.92 #[[5]] + 1.7)^2.4 + 1/(0.92 #[[5]] + 0.62)^2.4))], "RGB"]] & /@
Select[starData, FreeQ[#, Missing] &], ScalingFunctions -> {"Reverse", "Log"}, Background -> Black,
FrameLabel -> {"Log(Temperature)", "Log(Luminosity)"}, LabelStyle -> Directive[Bold, 15, White], ImageSize -> Full]
Note that there is a "fudge exponent" of 2.4 which exaggerates the colours. This gives:
![enter image description here][2]
If you compare this figure to the [corresponding images on the wikipedia page][3], you will note that is looks quite similar to the second figure. The first figure on that website, shows a fine structure of all the sequences Ia and Ib for the supergiants, II for the bright giants, III for giants, IV for subgiants, and V for the main sequence. Then there are the white dwarfs. It appears that our diagram shows a similar sub-structure, but I might be mistaken.
Our own sun is on the main sequence at the intersection at a horizontal line of normalised Log-luminosity 1. (The axis is normalised to our sun's luminosity.) So our sun is "yellow-white".
As we are already on it, we can also compare where our sun lies in terms of its mass. I therefore compute a SmoothHistogram of the masses of my 10000 stars.
SmoothHistogram[
Select[QuantityMagnitude[starData[[All, 3]]], NumberQ],
PlotRange -> {{0, 1.5*10^31}, All}, PlotTheme -> "Marketing",
FrameLabel -> {"Mass", "Density"}, ImageSize -> Full,
LabelStyle -> Directive[Bold, Medium],
Epilog -> {Red, {PointSize[0.02],
Point[{QuantityMagnitude[StarData["Sun", "Mass"]], 0}]}, Green,
Line[{{Median[
Select[QuantityMagnitude[starData[[All, 3]]],
NumberQ]], -0.1}, {Median[
Select[QuantityMagnitude[starData[[All, 3]]], NumberQ]],
7.5*10^-31}}], Yellow,
Line[{{Mean[
Select[QuantityMagnitude[starData[[All, 3]]],
NumberQ]], -0.1}, {Mean[
Select[QuantityMagnitude[starData[[All, 3]]], NumberQ]],
7.5*10^-31}}]}]
![enter image description here][4]
Our sun's mass is marked by the red dot on the x-axis. The green vertical line shows the median of the distribution and the yellow line the mean. I have truncated the diagram at the large masses. The following plot shows mass vs radius:
ListPlot[QuantityMagnitude /@ Select[starData[[All, {3, 4}]], FreeQ[#, Missing] &], PlotTheme -> "Marketing", LabelStyle -> Directive[Bold, 15, Black],FrameLabel -> {"Mass", "Radius"}]
![enter image description here][5]
Cheers,
Marco
[1]: http://mathematica.stackexchange.com/questions/57389/convert-spectral-distribution-to-rgb-color
[2]: /c/portal/getImageAttachment?filename=ScreenShot2015-10-09at23.18.53.png&userId=48754
[3]: https://en.wikipedia.org/wiki/Hertzsprung%E2%80%93Russell_diagram
[4]: /c/portal/getImageAttachment?filename=ScreenShot2015-10-09at23.27.04.png&userId=48754
[5]: /c/portal/getImageAttachment?filename=ScreenShot2015-10-09at23.39.24.png&userId=48754Marco Thiel2015-10-09T22:45:44ZImages in Datadrop/Databin not working?
http://community.wolfram.com/groups/-/m/t/1063747
I've been playing around with some experiments with Datadrops and I'm noticing that I am not able to submit images to a Databin from neither my raspberry pi, Mathematica Desktop 11.0 or from Wolfram Cloud. All three of them return the same error messages:
StringJoin:String expected at position 2 in
https://www.wolframcloud.com/objects/<>First[$Failed][UUID]
CloudObject:No CloudObject found at the given address
It does create an object in the DataDrop with some size (a couple hundred kilobytes) but the data is unusable and just displays $Failed.
This is the test code I'm using:
bin = CreateDatabin["Interpretation" -> {"img" -> "Image"}]
timage = ExampleData[{"TestImage", "Elaine"}]
DatabinAdd[bin, <|"img" -> timage|>]
I've tried a few variations like creating the Databin without a contract and simply doing DatabinAdd[bin, SomeImage] - all resulting in the same error.Jonathan Philpott2017-04-17T04:42:29ZDetermine Timing of Dynamic Refreshes?
http://community.wolfram.com/groups/-/m/t/1075337
How would one determine the efficiency of a code for which drawing a graphic is the most expensive step?
I am investigating various methods to change a graphics object in a Dynamic[Graphics[...]]
For example,
positions = RandomReal[{-1, 1}, {200, 2}];
colors = RandomColor[Length[positions]];
radii = RandomReal[{0, .1}, Length[positions]];
Dynamic[Graphics[MapThread[{#3,Disk[#1,#2]}&,{positions, radii, colors}]]
I am curious how much time each Dynamic refresh takes.
I tried using EvaluationData, but couldn't make it work. I wonder if there is a way to create a "DynamicEvaluationMonitor"?W. Craig Carter2017-04-27T15:08:50ZHelp understanding basic Mathematica function styles
http://community.wolfram.com/groups/-/m/t/1075498
I came across a code with a different format that I am accustomed to used for Function and its format. The original post is [here][1] and also in [here][2]
SphericalBesselI[0, 0] := SphericalBesselI[0, 0] = 1;
SphericalBesselI[l_, z_] := Sqrt[\[Pi]/(2 z)] BesselI[l + 1/2, z];
(*expansion coefficients for the Henyey-Greenstein phase function*)
\
\[Sigma][l_][g_] := g^l
(*diagonal matrix elements*)
h[l_][g_, \[Omega]_] :=
h[l][g, \[Omega]] = (2 l + 1) (1 - \[Omega] \[Sigma][l][g]);
FIRST LINE--- What is the purpose to use the build in function as the function name and then equal to one?This is confusing as I thought the function shall start with small cap and the equal to the right if further confusing.
FIFTH LINE: What is the meaning of having 2 square brackets in the function definition?`\[Sigma][l_][g_] := g^l`
[1]: https://plus.google.com/102818354642293979988/posts/3yFbCGa7vuZ
[2]: https://mathematica.stackexchange.com/questions/10767/fast-spherical-harmonics-radiative-transferJose Calderon2017-04-27T13:42:32Z[✓] NetTrain TargetDevice GPU error
http://community.wolfram.com/groups/-/m/t/902394
When I add the option `TargetDevice->"GPU"` to NetTrain in Mathematica 11.0.0.0 I get the error 'First argument to NetTrain should be a fully specified net'. Is this broken in 11.0.0.0?Gijsbert Wiesenekker2016-08-09T21:51:12ZHow to create a better planar graph layout?
http://community.wolfram.com/groups/-/m/t/1074975
*[This has been cross-posted to StackExchange](https://mathematica.stackexchange.com/q/144594/12)*
----
Mathematica has a layout algorithm [to plot planar graphs without edge crossings][1]. This typically produces an ugly triangular layout where some vertices and edges are nearly overlapping (even if technically they do not intersect).
Se use @JasonB posted this example in the StackExchange chatroom:
g = Graph[EdgeList@ChemicalData["FullereneC60", "StructureGraph"],
GraphLayout -> "PlanarEmbedding"]
![Mathematica graphics](http://i.stack.imgur.com/4ocQG.png)
**How can we create a more pleasing visualizaton of planar graphs than this?**
[`GraphData`](http://reference.wolfram.com/language/ref/GraphData.html) has the same fullerene graph with much nicer (probably manually chosen) vertex coordinates included:
GraphData[{"Fullerene", {60, 1}}]
![Mathematica graphics](http://i.stack.imgur.com/dFB2l.png)
How could we create something comparable (if not quite as symmetric) automatically?
I am looking for *practical* methods. They do not need to work on all planar graphs, and it is okay if they need manual tuning. But they should be practically useful for visualizing some large class of planar graphs.
----
## Example graphs
`GraphData["Planar"]` gives a long list of graphs that you can use for testing. `GraphData["Planar", 20]` gives some planar graphs with 20 vertices.
Some graphs will plot well (and without edge crossings) using a simple `SpringElectricalEmbedding`, even when the below method fails on them. An example is `GraphData[{"SierpinskiCarpet", 4}]`.
One particularly challenging graph is `GraphData[{"Apollonian", 5}]`. Can you plot this one nicely?
----
## My own imperfect attempt
One possibility is to first lay out the graph using Mathematica's `"PlanarEmbedding"`. This ensures no edge crossings, but the output is not pleasing. Then use [the Davidson–Harel algorithm](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.20.5663) through [IGraph/M](http://szhorvat.net/mathematica/IGraphM) to refine the result.
The Davidson–Harel algorithm uses simulated annealing to try to optimize the layout, and includes a penalty for edge crossings. On its own, it would not be able to disentangle the edges and eliminate all crossings. However, this implementation allows using existing coordinates as starting vertex positions through the `"Continue"` option (most IGraph/M layout algorithms have this). We use the coordinates from `"PlanarEmbedding"` and increase the penalty for edge crossings. It does not always work, but it tends to perform reasonably on not too large graphs.
### Demonstration
We start by selecting all planar graphs that have at least 15 vertices and are not trees or forests (i.e. they are acyclic). Trees are too easy to layout, thus boring.
gs = GraphData /@ GraphData["Planar"];
gs = Select[gs, VertexCount[#] > 15 && Not@AcyclicGraphQ[#] &];
Let us try the method on 20 random ones. In each box, the left figure shows the original layout in `GraphData`. This layout is often hand-made, and can be taken as a reference point for what sort of nice visualization is possible for the given graph. The right side shows the layout automatically computed by this method.
<<IGraphM`
SeedRandom[52];
IGSeedRandom[52];
Table[Framed@Grid@List@{
Graph[g, ImageSize -> Small],
IGLayoutDavidsonHarel[
SetProperty[g,
VertexCoordinates ->
Thread[VertexList[g] ->
Rescale@
GraphEmbedding[g,
"PlanarEmbedding"]]],
"Continue" -> True, "EdgeCrossingWeight" -> 1000,
ImageSize -> Small]}, {g, RandomSample[gs, 20]}] //
Multicolumn[#, 3] &
[![enter image description here][3]][3]
Unfortunately, on larger graphs, it won't work quite as well, even after tuning the parameters. There is clearly plenty of room for improvement, **so I am still looking for alternative answers**, including simulated annealing implementations in pure Mathematica.
gs = GraphData /@ GraphData["Planar"];
gs = Select[gs, VertexCount[#] > 59 && Not@AcyclicGraphQ[#] &];
SeedRandom[52];
IGSeedRandom[52];
Table[Framed@
Grid@List@{Graph[g, ImageSize -> Small],
IGLayoutDavidsonHarel[
SetProperty[g,
VertexCoordinates ->
Thread[VertexList[g] ->
2 Rescale@
GraphEmbedding[g,
"PlanarEmbedding"]]],(*unpack to work around bug*)
"Continue" -> True, "EdgeCrossingWeight" -> 50000,
MaxIterations -> 100, ImageSize -> Small]}, {g,
RandomSample[gs, 9]}] // Multicolumn[#, 3] &
[![enter image description here][4]][4]
[1]: https://mathematica.stackexchange.com/a/18578/12
[2]: https://chat.stackexchange.com/transcript/message/36972459#36972459
[3]: https://i.stack.imgur.com/OlHqr.png
[4]: https://i.stack.imgur.com/I6Po2.pngSzabolcs Horvát2017-04-27T10:55:28ZCreating a new GraphStyle—possible?
http://community.wolfram.com/groups/-/m/t/1073625
Hello everyone,
I found this feature example page, which unfortunately seems to be empty in all versions I have installed.
https://reference.wolfram.com/language/example/CreateYourOwnGraphStyle.html
I was wondering if this meant that it was possible to create a custom `GraphStyle` that can then be easily re-used.
I know that I could use an explicit option list with `{VertexStyle -> ..., EdgeStyle -> ..., ...}`. After finding this example page, I simply became curious if there was a builtin feature to give a set of styles a name.Szabolcs Horvát2017-04-26T13:15:13ZAvoid problems with Dynamic Updating?
http://community.wolfram.com/groups/-/m/t/1074905
Hello everyone,
I am learning the Wolfram Mathematica language doing some simple programs but i got stuck.
I was writing code that show a parametric curve and its derivate, with a tangent vector for each one and the module of vector velocity.
The problem is that when i enable dynamic updating the yellow dot on the icon of Wolfram in the application bar starts blinking red and the module of the vector change even if the vector is still.
It's the first time i get this errors, and i don't know why. If someone could help me, i left the code here, i hope it's well written.
Thank you.
Module[
{f, g},
Manipulate[
f[x_] := x Cos[x];
g[x_] := x Sin[x];
plot1 = Graphics[
{
{Blue, Arrow[{{0, 0}, {f[n], g[n]}}]},
{Orange, Arrow[{{0, 0}, {f'[n], g'[n]}}]},
{Red, Arrow[{{f[n], g[n]}, {f'[n] + f[n], g[n] + g'[n]}}]},
{Purple, Arrow[{{f'[n], g'[n]}, {f'[n] + f''[n], g'[n] + g''[n]}}]}
}];
plot2 = ParametricPlot[
{
{f[x], g[x]},
{f'[x], g'[x]}
},
{x, 0, 2 Pi}
];
Show[{
plot1,
plot2
},
Axes -> {True, True}, PlotRange -> {{-5, 9}, {-7, 9}}
],
{n, 0, 2 Pi}, Delimiter,
Dynamic@
Style["T =" <> ToString[NumberForm[N[Sqrt[(f'[x])^2 + (g'[x])^2]], 3]],
FontFamily -> "Arial", FontSize -> Medium, FontColor -> Col]
]
]Riccardo Lombardi2017-04-27T07:55:40ZSetting vertex coordinates on a graph
http://community.wolfram.com/groups/-/m/t/1074915
The following bug caused me some headache, so I thought I would share the workaround.
Sometimes trying to set `VertexCoordinates` on a graph failed mysteriously, at other times it worked fine. I could not figure out why. <del>It turns out that it does not like packed arrays.</del>
This fails:
g = GraphData[{"BananaTree", {4, 5}}];
SetProperty[g, VertexCoordinates -> RandomReal[1, {21, 2}]]
<del>This works:</del>
SetProperty[g,
VertexCoordinates ->
Developer`FromPackedArray@RandomReal[1, {21, 2}]]
**Update:** This does not work either. I did not pay attention. The command does not "fail", but the coordinates are not set.
The following really does work:
SetProperty[g, VertexCoordinates -> Thread[VertexList[g] -> RandomReal[1, {21, 2}]]]
I am not sure why this is necessary as even the first command works just fine on `RandomGraph[{21,50}]`. Now you can see how frustrating it is to try to write robust packages that use graphs. You never know when you'll bump into yet another weird failure.Szabolcs Horvát2017-04-27T08:25:29ZWhere to find the old featured examples?
http://community.wolfram.com/groups/-/m/t/1073609
In version 10.x, there were many featured examples in the documentation for several application areas (see screenshots below).
Where can I find these collections in version 11.x? The individual pages still seem to be present, but I cannot find a table of contents to them. This makes them nearly undiscoverable.
![enter image description here][1]
![enter image description here][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2017-04-2614.23.38.png&userId=38370
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2017-04-2614.23.17.png&userId=38370Szabolcs Horvát2017-04-26T12:25:12ZRecreate snapchat filters with the Wolfram Language?
http://community.wolfram.com/groups/-/m/t/1074283
So, I am trying to recreate the filters from the snapchat app, I started with the filter that switches faces, but I can only get one face to switch. I attached everything I have so farRamon Diah2017-04-27T04:23:40ZAutomate camera with RunScheduleTask command h?
http://community.wolfram.com/groups/-/m/t/1071391
I am trying to automate the camera to take an image every 3 seconds for the next 30 seconds and then to append the image to list.
dev = DeviceOpen["Camera"]
DeviceRead[dev]
AppendTo[snapshots, DeviceRead[dev]]
RunScheduledTask[AppendTo[snapshots, DeviceRead[dev]], {3, 10}]
But the code is not responding as wanted.Jose Calderon2017-04-24T23:09:18Z[✓] Use differentiation operator "D" for trigonometric functions?
http://community.wolfram.com/groups/-/m/t/1073811
Hello,
I am using Mathematica to calculate metric tensors. I am finding that Mathematica is returning unexpected results when I try to take derivative of Rho*sin(Theta)*cos(Phi) with respect to Rho.
In Mathematica I enter:
D[\[Rho]*sin (\[Theta])*cos (\[Phi]), \[Rho]]
Results is:
cos sin \[Theta] \[Phi]
but it should be:
cos(Theta)*sin(Phi)
Any ideas?Motaz Al-Hasan2017-04-26T18:28:00Z[✓] Avoid differences between solutions by NDsolve and by OutputResponse?
http://community.wolfram.com/groups/-/m/t/1072551
Dear Members of the of the community
I have written a very simple piece of code to dynamically calculate Fourier coefficients of a signal. The code is something like this
f = 60;
h = 6;(*Harmonic number*)
u1[t_] = Sin[2 \[Pi] f t] + 5 Sin[2 \[Pi] 3 f t] +
0.8 Cos[2 \[Pi] 6 f t] + 5;
tau = 1/f;m2 = NDSolve[{
ff1'[t] == u1[t] Cos[2 \[Pi] 6 f t], ff1[t /; t <= 0] == 0.0,
f2'[t] == ff1'[t - tau], f2[t /; t <= 0] == 0}, {ff1[t],
f2[t]}, {t, 0, 3 tau}];
Plot[Evaluate[{2 f (ff1[t] - f2[t])} /. m2], {t, 0, 3 tau},
PlotRange -> All]
For a signal
u1[t_] = Sin[2 \[Pi] f t] + 5 Sin[2 \[Pi] 3 f t] +
0.8 Cos[2 \[Pi] 6 f t] + 5;
The plot would be
![enter image description here][1]
After a transient the output converges to 0.8, that is the coefficient of the sixth harmonic in u[t]. I have try the same defining a model by StateSpaceModel and solving with OutputResponse.
m1 = StateSpaceModel[{ff1'[t] == signal[t] Cos[2 \[Pi] h f t],
f2'[t] == ff1'[t - tau]}, {ff1[t],
f2[t]}, {signal[t]}, {2 f (ff1[t] - f2[t])}, t];
y1 = OutputResponse[m1, u1[t], {t, 0, 3 tau}];
Plot[y1, {t, 0, 3 tau}]
In such a case the output is .
![enter image description here][2]
It seems to me that both models are equivalent and should produce same results but they don't!.
Could anybody give a hint on what I am doing wrong?
Cheers
Jesus Rico
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=harmonic.gif&userId=67240
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=harmonic2.gif&userId=67240J Jesus Rico-Melgoza2017-04-25T18:22:22ZAvoid errors with CUDAFunctionLoad in Mathematica 11.1.0.0?
http://community.wolfram.com/groups/-/m/t/1034615
Before with Mathematica 11.0.1.0 my CUDA was working fine.
Now with Mathematica 11.1.0.0, CUDAFunctionLoad gives errors.
Take this simple example from Mathematica documentation:
Needs["CUDALink`"]
code = "
__global__ void addTwo(mint * in, mint * out, mint length) {
int index = threadIdx.x + blockIdx.x*blockDim.x;
if (index < length)
out[index] = in[index] + 2;
}";
cudaFun =
CUDAFunctionLoad[code,
"addTwo", {{_Integer, _, "Input"}, {_Integer, _,
"Output"}, _Integer}, 256]
This is gives issues with StringJoin, StringTrim and an internal error
CCompilerDriver`CCompilerDriverBase`InvokeCompiler::cmdstr: An internal error occurred while generating compilation commands. The InputForm of the generated command list is StringTrim[StringJoin["\n\n", CCompilerDriver`CCompilerDriverBase`BaseDriver["CreateExecutableCommands"][CUDAFunctionLoad, <<20>>, {"CreateBinary" -> True, "CUDAArchitecture" -> {}, "Defines" -> {"USING_CUDA_FUNCTION" -> 1, <<2>>, "USING_DOUBLE_PRECISIONQ" -> 1}, <<17>>, "XCompilerInstallation" -> Automatic}], "\n"]]
CUDAFunctionLoad::cmpf: The kernel compilation failed. Consider setting the option "ShellOutputFunction"->Print to display the compiler error message.
This is with CUDA paclet 10.5.0 still based on the old CUDA 7.5.18 toolkit in stead of CUDA 8.0. Compiler is from Microsoft Visual Studio 2015 Community Edition. OS is Windows 10. nVIDIA driver is latest 378.78 with CUDA 8.0 in the driver.
Update 27/03/2017:
In the meantime I also have Mathematica 11.1.0.0 running in CentOS 7.3 x86_64 linux with gcc 4.8 as compiler and latest nVIDIA driver 375.39. I can confirm the same string errors happen. It seems internal Mathematica processing that goes wrong.Bert Aerts2017-03-18T20:06:59Z