Category Archives: mathematica

Solar Eclipse visit planning with Mathematica

A total solar eclipse will cross much of the United States, plus parts of Canada and Mexico on April 8, 2024. If you’ve never seen a solar eclipse, you should, and if you’re in North America, this is a great chance. Mathematica can help.

Mathematica includes significant data about the eclipse, including when it happens and where it will be.

nextSolarEclipseDate = DateObject[{2024, 4, 8}];

SolarEclipse[nextSolarEclipseDate]


And to visualize that…

a = GeoGraphics[{GeoStyling[None], Opacity[.2], Red,
SolarEclipse[nextSolarEclipseDate, "PartialPhasePolygon",
EclipseType -> "Total"]}];
b = GeoGraphics[{GeoStyling[None],
SolarEclipse[nextSolarEclipseDate, "TotalPhaseCenterLine",
EclipseType -> "Total"]}];
c = GeoGraphics[{GeoStyling[None], Opacity[.4], Red,
SolarEclipse[nextSolarEclipseDate, "TotalPhasePolygon",
EclipseType -> "Total"]}];;
Show[a, b, c,
GeoCenter -> Entity["City", {"Chicago", "Illinois", "UnitedStates"}],
GeoRange -> Quantity[2500, "Miles"]]

Virtually everybody in North America will get at least a partial eclipse, and everybody along that darker band in the middle will get to see a total eclipse. Sorry, Alaska!

Where best to view the thing? In theory one ought to be able to get a list of every city near the center line with this Mathematica code:

eclipseCenter =
SolarEclipse[nextSolarEclipseDate, "TotalPhaseCenterLine",
EclipseType -> "Total"]
;

GeoNearest["City", eclipseCenter, {All, 0}, TimeConstraint -> Infinity]

But this timed out or gave a server error, so I broke the problem into small pieces. First we identify all the states and provinces through which the center line passes. Ideally, we would do this with GeoEntities[SolarEclipse[nextSolarEclipseDate, "TotalPhaseCenterLine", EclipseType -> "Total"], "AdministrativeDivision"], but this gives an empty list. And if we replace the CenterLine with the CenterPolygon, the number of AdministrativeDivisions (which includes not merely states but also counties and other units of government) becomes unwieldy. So we break the problem into pieces, identifying just the states and provinces through which the center line passes:

adminEntitiesPoly =
GeoEntities[
SolarEclipse[nextSolarEclipseDate, "TotalPhasePolygon",
EclipseType -> "Total"], "AdministrativeDivision"];
statesAndProvinces =
EntityValue[Entity["Country", "UnitedStates"],
"AdministrativeDivisions"]~Join~
EntityValue[Entity["Country", "Canada"],
"AdministrativeDivisions"]~Join~
EntityValue[Entity["Country", "Mexico"], "AdministrativeDivisions"];
eclipseStates = Intersection[adminEntitiesPoly, statesAndProvinces];

Then, for each of these states and provinces, we identify every city Mathematica knows about, strip out the small ones, and from the rest identify those through which the center line passes. For sorting, I also compute the distance from New York City (where I hang my hat).

nyc = Entity["City", {"NewYork", "NewYork", "UnitedStates"}];

allCities =
Union[Flatten[Map[GeoEntities[#, "City"] &, eclipseStates]]];
allCitiesOfSize = Select[allCities,
QuantityMagnitude[CityData[#, "Population"]] > 50000 &];
eclipseCitiesOnPath = Select[allCitiesOfSize,
QuantityMagnitude[GeoDistance[#, eclipseCenter]] < 1 &];

eclipseCitiesWithPop = SortBy[Map[<|"city" -> #, "pop" -> CityData[#, "Population"], "distance from home" -> GeoDistance[#, nyc]|> &, eclipseCitiesOnPath], Last];
Dataset[eclipseCitiesWithPop]

That’s manageable! And wow, the kids at UI Bloomington are lucky. Let’s see these cities on a map:

d = GeoGraphics[GeoMarker[eclipseCitiesOnPath]]; Show[a, b, c, d,
GeoCenter -> Entity["City", {"Chicago", "Illinois", "UnitedStates"}],
GeoRange -> Quantity[2500, "Miles"],
GeoProjection -> "Equirectangular"]

You see only three markers above rather than four because Cheektowaga is a suburb of Buffalo and their markers overlap. For me, Buffalo is the obvious destination. Let’s examine the eclipse’s path through that town in detail.

GeoGraphics[{GeoStyling[None], Red, Opacity[0.3], Thickness[0.1],
SolarEclipse[nextSolarEclipseDate, "TotalPhaseCenterLine",
EclipseType -> "Total"]}, GeoRange -> Quantity[8, "Miles"],
GeoCenter -> Entity["City", {"Buffalo", "NewYork", "UnitedStates"}],
ImageSize -> Full]

There you have it. The centerline passes about 2.5 miles south of downtown. Weather permitting, everybody here is going to get a great view.

Historical global Big Mac prices

Somewhere in the world a hedge fund manager has bought a Ferrarri with trading profits made possible by the following data:

indices = {"BIGMUS", "BIGMBZ", "BIGMMX"};
data = Map[
msBBGhistory[# <> " Index", "Px_Last", {1997, 1, 1}, "",
"Monthly"] &, indices];
DateListPlot[data, PlotStyle -> {Red, Blue, Purple},
PlotRange -> {1.1, 6.4}, Frame -> {True, True, False, False},
PlotLabel -> "Global Big Mac Prices (USD)",
Epilog -> {(Text[Style["U.S.", FontFamily -> "Calibri", FontSize -> 10, Red], {{2012, 1, 10}, 3.8(*vertical position*)}]), (Text[Style["Brazil", FontFamily -> "Calibri", FontSize -> 10, Blue], {{2011, 11, 1}, 4.9(*vertical position*)}]), (Text[Style["Mexico", FontFamily -> "Calibri", FontSize -> 10, Purple], {{2012, 1, 10}, 2.4(*vertical position*)}])}, ImageSize -> Large]

Historical big mac prices, U.S., Mexico and Brazil

Visualizing relationships between dynamic variables, part iii

Principal component analysis can be a powerful tool for detecting similarity between time series, and whether a series ceases to resemble one group of signals and begins to resemble another. I extract three principal components and create a three-dimensional dot plot. My function msPCABoxNF3[] used to label each dot with an Epilog, but with Mathematica 11.3 it became possible to use Callout[]s instead.

msPCABoxNF3[allChNF3sA, "names" -> "names", ImageSize -> Large]

We can show the evolution of these relationships over time using Manipulate[] (a snapshot of the tool is shown below)

msEvolvingPCABoxNF3[allChNF3sA, 20, "spacing" -> 200, "names" -> "tickers", ImageSize -> Large]

Mathematica can also export videos of these things, as shown below. The following runs a bit quicker than I would like but I’m not going to solve the problem for the sake of this post.

Visualizing relationships between dynamic variables, part ii

Mathematica’s Correlation[] tool is handy. I created a wrapper that adds labels and makes it a bit more convenient with the sort of data I use.

msCorrelationMatrix[allChNF3sA, "noisy" -> False]

I often like to consider correlation together with r^2, p-value and criticality tests. The following function runs these things simultaneously for convenience.

msCorrelationMatrix[allChNF3sA, "noisy" -> False]

These functions can also weigh recent events more highly than events in the distant past, which is typically how I use them, though this is not demonstrated above.

When sharing results with others, I find Weighted Adjacency Graphs to be useful, and I will often create tools that allow the user to scroll through time, watching given securities change what other instruments they most resemble. It can be particularly interesting to see ostensibly market-neutral hedge funds start to track the equity markets as their managers take on more beta. This often happens as assets under management increase and/or the markets have been performing well.

Here are three “snapshots” from such a tool for the securities above. You can see that at first, equity hedge funds are a sort of island that don’t track the performance of anything else in the graph. Then in 2005 we enter a regime in which equity hedge funds track the S&P, which in turn resembles other equity series, but credit and commodities follow their own path. The graph continues to evolve (I show only a few states below), but by the end we are in the current world of nearly all risky assets moving together, and nearly everything cross-correlating.

timePasses = Table[Map[msChangeChar[#, "data" -> EventSeries[Take[#["Path"], UpTo[i]]]] &, allChNF3sA], {i, 100, Length[allChNF3sA[[1]]["Path"]], 10}];
wags = Map[msWeightedAdjacencyGraph[#, .3, "time weights" -> Automatic, PlotLabel -> #[[1]]["LastDate"], ImageSize -> Large] &, timePasses];
Manipulate[wags[[i]], {i, 1, Length[wags], 1}]

Dec 2004

Jan 2008

May 2008

July 2012

It stays like that to the current day.

Tomorrow, principal component analysis.

Visualizing relationships between dynamic variables, part i

I frequently have to compare data series that evolve over time, looking in particular for how similar they are to each other, whether or not the behavior of a given variable changes over time, as well as the overall rate of increase, volatility-adjusted returns, and other metrics. A few thoughts below.

First, let’s load up the historical performance of an equity hedge fund index and a number of other financial time series (the S&P500, Barclay’s Global Credit Index, MSCI Daily Total Return Net World, etc.). Since I know I’m going to need it later, I’ll also compute the daily changes in these time series, and I’ll “align” them by selecting only the dates that all these series have in common.


totalReturnBenchmarkTickers = {"DJSMT Index", "XAU Curncy", "RU10GRTR Index", "LGDRTRUU Index", "SPXT Index",
"NDDUWI Index"}; hfNF3 =
msBBGhistory["HFRXEH Index", "Px_Last", DateObject[{2000, 1, 1}], "", "Day", "name" -> msBBGcurrent["HFRXEH Index", "Name"], "use DPDF" -> True];
bogiesNF3 = Map[msBBGhistory[#, "Px_Last", DateObject[{2000, 1, 1}], "", "Day", "name" -> msBBGcurrent[#, "Name"], "use DPDF" -> True] &, totalReturnBenchmarkTickers];
allNF3s = Prepend[bogiesNF3, hfNF3];
hfChNF3 = msChanges[hfNF3];
bogiesChNF3 = msChanges /@ bogiesNF3;
allChNF3s = Prepend[bogiesChNF3, hfChNF3];
allNF3sA = msIntersectionData[allNF3s];
allChNF3sA = msIntersectionData[allChNF3s];

As a first check, it makes sense to graph these against each other, normalizing so that they all start from the same place. I’m going to use Mathematica’s built-in DateListPlot[] function, including its built-in PlotLegends.
DateListPlot[msStartFrom1 /@ allNF3s, PlotRange -> All, PlotLegends -> Map[#["name"] &, allNF3s], PlotLabel -> "As a colorblind person, I hate graphs like this.\nEspecially if the legend goes to two columns."]

Edward Tufte recommends tagging each line with its own legend, which can be easily done using the Epilog option when graphing. It’s built-in to my function msEndTagPlotNF3[] (which also removes unnecessary extra framing and does other Tufte-like things.

msEndTagPlotNF3[msStartFrom1 /@ Take[allNF3s, 5], "rightpadding" -> 29, PlotLabel -> "I wrote this function years ago;\nit's better than Legend when the series don't end up near each other"]

msEndTagPlotNF3[msStartFrom1 /@ allNF3s, "rightpadding" -> 29, PlotLabel -> "But not great if the names start to land on each other"]

DateListPlot[Map[Callout[#, #["name"]] &, msStartFrom1 /@ allNF3s], Joined -> True, PlotRange -> All, Frame -> {True, True, False, False}, PlotLabel -> "Since Mathematica 11, I've often used Callout[] instead."]

Enough for today. Tomorrow I’ll show some tools for illustrating correlations and other descriptive statistics.