Pair monthly data with daily data

Question

I need to pair 30-year treasury yield data (only available monthly) to S&P500 data of the same dates.

Treasury data WolframAlpha accesses from the St. Louis Federal Reserve comes down with dates in a DateList format.

tb = WolframAlpha["United States 30 year treasury bond monthly", {{"History:Treasury:EconomicData", 1}, "TimeSeriesData"}];

Length@tb
460

As the S&P monthly data comes down with first of month data and the treasury data comes down with end of month data, I down load daily S&P data and convert the TimeSeries formatted dates to DateList format with the following function:

getSPData[dateStart_, dateEnd_, type_] := Module[{data, dates},
  data = FinancialData["SP500", {dateStart, dateEnd, type}];
  dates = DateList[#] & /@ data["Dates"];
  Transpose[{dates, data["Values"]}]]

sp = getSPData["Jan. 1, 1978", "Jan. 1, 2023", "Daily"];

Length@sp
11349

The Intersection of the dates gives me:

Intersection[tb[[All, 1]], sp[[All, 1]]];
Length@%
287

I can't remember and can't find how to use the Intersection of the dates to extract the S&P prices to pair them with the treasury data yields for the simulation I then need to run.

I came down with Covid the first of the year, and it has left me with some brain fog.

Suggestions appreciated.

Answer 1

Assuming each dataset does not have duplicate dates:

DeleteCases[GroupBy[Join[tb, sp], First -> Last], {_}] // Length // RepeatedTiming

(* Out: {0.0143332, 287} *)

Select[GroupBy[Join[tb, sp], First -> Last], Length[#] == 2 &] // Length // RepeatedTiming

(* Out: {0.0195033, 287} *)

Or with Association (without assumption, first duplicate entries will be discarded):

tba = AssociationThread @@ Transpose @ tb;
spa = AssociationThread @@ Transpose @ sp;

DeleteCases[Merge[{tba, spa}, Join], {_}] // Length // RepeatedTiming

(* Out: {0.0131367, 287} *)

Answer 2

Below we define the variables tb and sp500 that correspond to the t-bills and the S&P 500 data, respectively:

tb = WolframAlpha["United States 30 year treasury bond monthly",{{"History:Treasury:EconomicData", 1}, "TimeSeriesData"}];
sp500 = FinancialData["SP500", {"Jan. 1, 1978", "Jan. 1, 2023", "Daily"}];

Running some diagnostic tests on them, to get acquainted with the data, yields

The main take-away from this preliminary review of the data is that

1. the t-bills (tb) have significantly fewer data points (460 vs 11.349) however
2. they cover a slightly wider time range (approx. 45 years vs 44 years) also
3. they are shaped as a list of Quantity values ("Percent" or "%") while the S&P 500 data come in a TemporalData object (prob. a TimeSeries)

With that in mind, we should consider two possible ways forward: if we use the "Times" of tb as a pivot, then the sp500 will have to extrapolate its values outside its time range (remember how the sp500 has a narrower time range) and if we don't know how to extrapolate or if we don't want to, we'll have to restrict ourselves to the (marginally) shorter time span of tb.

Before treating each case separately, we will bundle the data together into a TemporalData object:

paths={tb[[All,-1]]//QuantityArray/*QuantityMagnitude,sp500["Values"]};
times={{tb[[All,1]]},{sp500["Times"]}};
td=TemporalData[paths,times,"MetaInformation"->{"Series"->{"tb","sp500"}}];

A quick view of our data does not seem to contradict our preliminary analysis:

td // separatePlot/*(Row[#, Spacer[10]] &)

Case 1. - Pivot on tb, extrapolate sp500

Evaluating the following lines will produce several InterpolatingFunction::dmval Messages letting us know how Input value {xxxx} lies outside the range of data in the interpolating function. Extrapolation will be used; this should come as no surprise since we're using TimeSeriesResample[#,{"Times",1}]& which pivots on the times of series component 1 ie tb, which covers a wider range than sp500 (remember our preliminary diagnostics).

tdR1=td//(TimeSeriesResample[#,{"Times",1}]&)/*(TemporalData[#,"MetaInformation"->{"Series"->(#["Series"]//Map[StringJoin[#,"-","R1"]&])}]&)

tdR1//separatePlot(tdR1["Series"]//Map[style])->(tdR1["Components"]//Apply[runDiagnostics/*Values])//AssociationThread/*(TakeDrop[#,1]&)/*Map[Dataset]/*(Row[#,Spacer[10]]&)

Looking at the diagnostics, we can verify that both series have the same number of observations (460), the span the same time range (approx. 46 years) and have the same time increment (2.592.000 or 60x60x24x30 s or 30 days).

Case 2. - Intersection

This time, there are no Messages generated since no extrapolation is required. TimeSeriesResample[#,"Intersection"]& uses the intersection of times present in the two series. However, since the time span of the sp500 is slightly shorter than the one for tb, the new range is shorter than the one in Case 1. Also, both series have significantly less observations (287 instead of 460).

tdR2=td//(TimeSeriesResample[#,"Intersection"]&)/*(TemporalData[#,"MetaInformation" -> {"Series" -> (#["Series"] // Map[StringJoin[#, "-", "R2"] &])}] &)
tdR2//separatePlot(tdR2["Series"]//Map[style])->(tdR2["Components"]//Apply[runDiagnostics/*Values])//AssociationThread/*(TakeDrop[#,1]&)/*Map[Dataset]/*(Row[#,Spacer[10]]&)

---

Diagnostics

runDiagnostics recursively runs diagnostics on its arguments and reports the result.

ClearAll[runDiagnostics]
SetAttributes[runDiagnostics,HoldAll]
runDiagnostics[]:=<||>
runDiagnostics[expr_,rest___]:=Join[<|diagnostics[expr]|>,runDiagnostics[rest]]

diagnostics delivers a number of tests on a data object it operates on; its arguments so far can be lists of time-value lists or TemporalData objects. It performs the tests by applying diagf which in turn depends on fs for the actual content of the tests to deliver.

ClearAll[diagnostics]
SetAttributes[diagnostics,HoldFirst]
With[{color=ColorData[97,"ColorList"][[1]]},
 diagnostics[expr_,style_:(Style[#,Bold,color]&)]:=Through[Rule[Identity/*style,ReleaseHold/*diagf][HoldForm@expr]]
]

The purpose of diagf is to act as an appropriate container for the functions in fs.

ClearAll[diagf]
diagf=Function[expr,expr//(Through[ReleaseHold[fs][#]]&)/*(Thread[fs->#]&)/*Association,HoldFirst];

fs holds a List of the auxiliary functions, defined in the section below; it is used in diagf above.

fs={HoldForm@Length[Data],HoldForm@TemporalRegularity[Data],HoldForm@Missing[Data],MinimumTimeIncrement,HoldForm@First[Time],HoldForm@Last[Time],HoldForm@Range[Time],HoldForm@First[Value],HoldForm@Last[Value]};

Auxiliary definitions

The following definitions are mostly UpValues defined for the symbol Time; they evaluate to different functions, depending on the Head of their input expression; they are designed to operate on Lists and TemporalData, for the time being.

ClearAll[Time]
Time/:First[Time]:=(#//Switch[#,_List,First/*First,_TemporalData,(Construct[#,"FirstTime"]&)/*DateList])&
Time/:Last[Time]:=(#//Switch[#,_List,Last/*First,_TemporalData,(Construct[#,"LastTime"]&)/*DateList])&

range=(Through[{First/*First,Last/*First}[#]]&)/*Apply[DateDifference[##,{"Year","Month","Day","Hour"}]&];
Time/:Range[Time]:=(#//Switch[#,_List,range,_TemporalData,(Construct[#,"Paths"]&)/*Map[range]])&

ClearAll[Data]
Data/:Length[Data]:=(#//Switch[#,_List,Dimensions,_TemporalData,(Construct[#,"Paths"]&)/*Map[Dimensions]])&
Data/:TemporalRegularity[Data]:=(#//Switch[#,_List,Missing["NotApplicable"],_TemporalData,RegularlySampledQ])&

count=Count[#,_?(Not[FreeQ[#,Missing]]&)]&;
Data/:Missing[Data]:=(#//Switch[#,_List,count,_TemporalData,(Construct[#,"Paths"]&)/*Map[count]])&

ClearAll[Value]
Value/:First[Value]:=(#//Switch[#,_List,First/*Last,_TemporalData,(Construct[#,"FirstValue"]&)])&
Value/:Last[Value]:=(#//Switch[#,_List,Last/*Last,_TemporalData,(Construct[#,"LastValue"]&)])&

The following are used for plotting data:

style=Style[#,Bold,ColorData[97,"ColorList"][[1]]]&;
epilog=(#["Path"]&)/*(Select[#,(FreeQ[#,Missing]&)]&)/*TimeSeries/*(MovingMap[Mean,#,{{12,"Month"},Center},"Fixed"]&)/*({Red,Opacity[.65],Line[#["Path"]]}&);
plot=DateListPlot[#1,Epilog->(#//epilog),FrameTicks->{{None,All},{Automatic,None}},ImageSize->Medium,PlotLabel->(#2//style)]&;
separatePlot=(Through[{Construct[#,"Components"]&,Construct[#,"Series"]&}[#]]&)/*(MapThread[plot,#]&);