The CuRious Financial Risk ManageR

Shiny portfolio

Tue, 03 Jan 2023 00:00:00 +0000

I will use this post as repository of all the publicly available shiny dashboards I have developed through time.

All the investment banks in the world must submit the information about their trades to a trade repository called DTCC. We report the anonymysed version of such data as published by DTCC here (https://pddata.dtcc.com/gtr/cftc/dashboard.do) in a dashboard that tracks the evolution through time of the global investments in a specific trade called “interest rate swaps”.

We report the global amounts traded by currency, split the type of swap (OIS or Libor)for each day since the beginning of 2021. We also provide snapshots of the full data used at any date, which can be selected by the dashboard user.

Interactive Dashboard on Covid19 data in Italy

An interactive dashboard to track the evolution of the Covid19 contagion in Italy. Data is automatically sourced from the official Italian Government Covid Data repository (https://github.com/pcm-dpc/COVID-19) on a daily basis. The data reported in the dashboard is fully dependant on the original source and no additional post-processing is applied to the raw data by the author of the Dashboard.

Interactive Dashboard on Covid19 data in Ireland

An interactive dashboard to track the evolution of the Covid19 contagion in Ireland. Data is sourced both from the Irish Government open data website (https://data.gov.ie/blog/coronavirus-covid-19) and by scraping the epidemiological pdf reports published by the Health Protection Surveillance Centre (https://www.hpsc.ie/a-z/respiratory/coronavirus/novelcoronavirus/casesinireland/). The data reported in the dashboard is fully dependant on the original source and no additional post-processing is applied to the raw data by the author of the Dashboard.

Vessels Dashboard

An interactive dashboard that tracks the position and the movement over a 2 hours window of a vast number of vessels in the Baltic Sea.

Online Interest Rate Swap Monitor

An online application developed using R shiny to monitor in realtime the change in the the Interest Rate Swap market by scraping the web. Source data is automatically scraped from a third party website .

SURE programme: a detailed financial analysis

Wed, 07 Jul 2021 00:00:00 +0000

The EU is set to become the largest supranational bond issuer in the world thanks to its €90bn billion instrument for temporary Support to mitigate Unemployment Risks in an Emergency (SURE) and €750bn Next Generation EU (NGEU) recovery fund.

If we look at the distribution of bond notional issued by the European Union outstanding as at the end of June and we divide it between SURE, NGEU and legacy programmes (mainly for loans to Ireland and Portugal during the last debt crisis) we can see that the SURE programme (now concluded) represents almost 50% of total with NGEU already representing 20%.

This significant amount of new bond issued on the market doesn’t present a material liquidity spread if we compare the Legacy vs the SURE yield structures.

Because of its material significance in terms of notional issued, we will analyse the financial aspect of the SURE program in the rest of the article. The plans to mitigate Unemployment Risks in an Emergency financed through the SURE program nor the social characteristics of the bonds issued will be part of an upcoming article.

The SURE instrument was created by the European Union (EU) to help Member States protect workers’ jobs and income during pandemic. It gave such a financial assistance in the form of loans with favorable conditions to the Member States. Each Member State that benefits from financial assistance under SURE was in fact required to sign a loan agreement with the Commission laying down the characteristics of the loan. Most of the loan agreements were signed in the third quarter of 2020, which enabled the Commission to issue SURE bonds starting from October 2020.

The agreements guarantee that the loans between the Commission and the Member States are in back-to-back, meaning that the Commission borrows on behalf of the Union and then lends to Member States at the same conditions. In the tables below we report the results of the Commission borrowing (table on the top) and how the proceedings have been distributed to the different member states.

From the table we can notice that:

The first SURE transaction represented largest ever order book (€233 billion) for any deal in the history of the global bond markets.
The major beneficiaries of the SURE program were Italy (€27.44bn) and Spain (€21.32bn) who have borrowed almost 55% of the total funds available
The average duration of the loans between each Member State and the European Commission is around 15 years with only Czechia having borrowed at 10 year
The countries whose debt trades at yields below the European Union one (eg. Germany, Austria, Netherlands) or the ones that have a very similar level of yields (eg. France) have not accessed the programme because it was not financially advantageous for them
The bonds have attracted a significant of interest from the investors, especially for the first tranches: a very healthy average bid-to-cover ratios around 10 highlights the appetite for a AAA security that prices higher yields than Germany. The biggest majority of the investors where fund managers, as described in the graph below

Because of the back-to-back lending structure, the loans disbursed under SURE generated interest rate savings for the vast majority of the Member States as the Commission was able to obtain favorable terms on the capital markets. To compute the savings, it is assumed that, in the absence of loans from SURE, Member States would have issued bonds with the same characteristics (i.e. maturity and coupon) as the EU SURE bonds on the day the loans were disbursed. The difference in yield between the government bond on the secondary market and the bond issued by the Commission is multiplied by the maturity of the bond and the notional of the back-to-back loan. We summarise the results of the analysis in the table below.

Here are the main takeaways from the table:

Italy saves the most interest rates (€4.32bn). This amount represents half of the total savings locked through the SURE financing project by all the Member States.
The country that saves the most interest rate as a percentage of the amount disbursed is Romania. This is because it received only a 15 year €3bn back-to-back loan. On the long maturities, total interest savings tend to be higher than the product of the average spread and the average maturity. The spread and the maturity are generally positively correlated, i.e. EU SURE yield curves tend to be flatter than national yield curves.
The Member States that benefited more from the SURE programme were Italy, Spain, Romania and Greece. Looking at the programme from this perspective evidences in a very effective way that this was first time a EU programme is directed not proportionally to the population of the and addresses the Countries most in need.

The SURE programme hence represents a win-win for the European Union (who has now established more firmly its presence on the capital markets) and the Member States (who have recorded significant interest rate gains). It paved the way to an instrument like the NGEU which is going to re-interpret the back-to-back lending structure in light of the new grants offered to Member States. “The successful SURE programme which served as a kind of test run makes us confident that the NGEU bonds will meet both our and the investors’ expectations” said Johannes Hahn, European Commissioner for Budget and Administration. We’ll analyse the NGEU programme in future articles.

Multi Currency Swap Pricing with SwapPricer

Tue, 10 Sep 2019 00:00:00 +0000

I have released a new version of the package SwapPricer on GitHub here.

As we are now at version 1.0.1 the toolbox is able to price using just a one-curve framework but is able to price multiple currencies (ie. CHF, EUR, GBP, JPY and USD) and any convention in terms of coupon frequency, day count convention.

We are working to introduce OIS Discounting in the next releases

SwapPricer: instructions for use

To run a multi-currency swap portfolio valuation you need the following three “ingredients”:

A table with the characteristics of the swap, like the following one

Table 1: Swap portfolio
ID	currency	notional	start.date	maturity.date	strike	type	standard	time.unit.pay	time.unit.receive	dcc.pay	dcc.receive
Swap 25y	EUR	10,000,000	19/01/2007	19/01/2032	0.06%	receiver	TRUE	NA	NA	NA	NA
Swap 30y	GBP	1,000,000	24/04/2012	24/04/2042	1.00%	payer	TRUE	NA	NA	NA	NA
Swap 10y	USD	2,000,000	21/02/2012	21/02/2022	0.25%	receiver	TRUE	NA	NA	NA	NA
Swap 2y16y	GBP	7,500,000	14/04/2021	14/04/2037	1.50%	receiver	TRUE	NA	NA	NA	NA
Swap non standard	EUR	15,000,000	26/05/2014	26/05/2039	2.00%	payer	FALSE	12	3	act/365	act/365
Swap 10y semi fixed	EUR	10,000,000	26/05/2014	26/05/2024	0.10%	payer	FALSE	6	6	act/365	act/365
Swap 30y quarter floating	GBP	1,000,000	24/04/2012	24/04/2042	2.00%	receiver	FALSE	3	12	act/360	act/365
Swap 10y irregular	USD	2,000,000	21/02/2012	21/02/2022	0.25%	receiver	FALSE	6	12	act/365	act/365
Swap 2y16y	EUR	7,500,000	14/04/2021	14/04/2037	1.50%	payer	FALSE	12	12	act/365	act/360

These are the columns that have to be in the

ID (character) is a custom ID for the swap
currency (character) as per the ISO 4217 standard
notional (numeric)
start.date (Date)
maturity.date (Date)
strike (numeric)
type (string) either payer or receiver. It is not case-sensitive.
standard (logical)

Only if the field standard is set to FALSE then we need four additional fields.

An example of portfolio is provided with the package and is called swap.basket.

time.unit.pay and time.unit.receive (integer) are the number of months for the frequency of the leg (ie. monthly would have a time.unit of 1, quarterly of 3, semiannual of 6 and annual of 12)
dcc.pay and dc..receive (character) as per the fmdates helper

The date at which the swaps are being priced
As many interest rate lists as per the currencies in the swap portfolio. The list is made of a string with the code of the currency and a with a tibble with the discounting factor curve with two columns: Dates and Discount Factors (df). Here is the structure of interest rate object:
```
str(SwapPricer::EUR.curves)
```
```
## List of 2
##  $ currency: chr "EUR"
##  $ discount:Classes 'tbl_df', 'tbl' and 'data.frame':    26 obs. of  2 variables:
##   ..$ Date: Date[1:26], format: "2019-04-15" ...
##   ..$ df  : num [1:26] 1 1 1 1 1 ...
```
Where the discount tibble of the list has the same characteristics of the df.table object described in this post For your reference, I provided three curve objects with the package: EUR.curves, GBP.curves and USD.curves

Now we can price our test multi-currency and non-standard swap portfolio by simply running SwapPortfolioPricing function with the three items in the order of description and appending as many curves as the number of currencies in the book.

A sample code is shown here:

today <- lubridate::ymd(20190414)

results <- SwapPricer::SwapPortfolioPricing(SwapPricer::swap.basket, 
                                            today, 
                                            SwapPricer::EUR.curves, 
                                            SwapPricer::GBP.curves, 
                                            SwapPricer::USD.curves)

and these are the results in table format:

Table 2: Pricing results
swap.id	currency	clean.mv	dirty.mv	accrual.pay	accrual.receive	par	pv01
Swap 25y	EUR	-881,814.61	-874,994.31	5,441.11	1,379.18	0.77%	-12,393.65
Swap 30y	GBP	105,100.47	104,668.39	-4,712.33	4,280.26	1.54%	1,948.54
Swap 10y	USD	-119,319.88	-126,214.04	-7,630.28	736.11	2.43%	-548.15
Swap 2y16y	GBP	-94,850.43	-94,850.43	-0.00	0.00	1.59%	-10,393.05
Swap non standard	EUR	-2,591,763.24	-2,861,567.21	-263,835.62	-5,968.36	1.07%	27,917.04
Swap 10y semi fixed	EUR	-16,340.53	-29,897.79	-3,808.22	-9,749.04	0.07%	5,132.42
Swap 30y quarter floating	GBP	88,255.22	105,650.31	-2,056.96	19,452.05	1.55%	-1,941.05
Swap 10y irregular	USD	-119,595.14	-126,677.82	-7,795.01	712.33	2.44%	-546.46
Swap 2y16y	EUR	-361,098.10	-361,098.10	-0.00	0.00	1.18%	11,170.90

So long RQuantLib

Apart from the new definition of the curve object, most of the changes have happened “behind the scenes”. One thing that I had to do to make the deployment easier on all the OSs was to remove any reference to Quantlib. I am a huge fan of the RQuantLib package, but I realised I was using it just for adjusting dates for holidays. So I decided to take a different approach:

I downloaded all the holidays and saved it as internal objects in my package
I created a very simple routine to adjust for holidays, as in the following piece of code:

AdvanceDate <- function(dates, currency, eom.check) {
  holiday <- holidays[[currency]]
  check <- TRUE %in% ((dates %in% holiday) |
                        (weekdays(dates) %in% "Saturday") |
                        (weekdays(dates) %in% "Sunday"))
  if (check) {
    repeat {
      if (eom.check) {
        dates <- dplyr::case_when((dates %in% holiday) ~ dates - 1,
                                      (weekdays(dates) %in% "Saturday") ~ dates - 1,
                                      (weekdays(dates) %in% "Sunday") ~ dates - 2,
                                      TRUE ~ dates)
      } else {
        dates <- dplyr::case_when((dates %in% holiday) ~ dates + 1,
                                      (weekdays(dates) %in% "Saturday") ~ dates + 2,
                                      (weekdays(dates) %in% "Sunday") ~ dates + 1,
                                      TRUE ~ dates)
      }
      check <- TRUE %in% ((dates %in% holiday) |
                            (weekdays(dates) %in% "Saturday") |
                            (weekdays(dates) %in% "Sunday"))
      if (!check) {
        return(dates)
      }
    }
  } else {
    return(dates)
  }
}

You can see that adjusting for holidays is a recursive exercise: let’s assume we have Easter Sunday in the cashflow schedule. It automatically gets adjusted to Monday, but isince Easter Monday is also an holiday, the function will run a second time to further advance to Tuesday.

The performance of the function is guaranteed by the fact that the dplyr::case_when function is vectorised. In fact, the overall procedure takes almost the same time to run as with the RQuantLib function.

SwapPricer is on Github

Mon, 29 Jul 2019 00:00:00 +0000

In the previous posts we have seen how easy it is to price interest rate swaps using R. I am honoured to announce that I have decided to put all the functions I have described together into a package that is called…SwapPricer!

Ok, the name is not super original, but it should at least be easy to remember.

You can install it as follows:

# library(devtools)
devtools::install_github("DavideMagno/SwapPricer")

The package is still unfortunately not on CRAN but it has an official hexagon. Here it is:

Let me know if you like it in the Disqus form below in the post.

In order to price a swap you just need to run the following code.

library(SwapPricer)
portfolio <- SwapPricer::swap.basket %>% 
  dplyr::filter(grepl("EUR", .$currency))
SwapPortfolioPricing(portfolio, lubridate::ymd(20190414), SwapPricer::EUR.curves)

## # A tibble: 4 x 8
##   swap.id currency clean.mv dirty.mv accrual.pay accrual.receive     par
##   <chr>   <chr>       <dbl>    <dbl>       <dbl>           <dbl>   <dbl>
## 1 Swap 2… EUR       -8.82e5  -8.75e5       5441.           1379. 7.71e-3
## 2 Swap n… EUR       -2.59e6  -2.86e6    -263836.          -5968. 1.07e-2
## 3 Swap 1… EUR       -1.63e4  -2.99e4      -3808.          -9749. 6.82e-4
## 4 Swap 2… EUR       -3.61e5  -3.61e5          0               0  1.18e-2
## # … with 1 more variable: pv01 <dbl>

You can see that I have used two objects that are delivered with the package:

swap.basket which consists in a 5 swaps portfolio that can be referenced as blueprint for your swap portfolio
EUR.curves this is the discount curve downloaded from Bloomberg as at the 14th of April 2019

We have tested the package using a 500 swaps portfolio and the results, in terms of performance are very encouraging. We analyse them using the amazing profvis tool.

The results are quite interesting as they show we can split the code in three parts:

The first one converts the inputs in tabular form into list of lists of the same format as we described in this post.
The second one is the one that takes the biggest amount of time and it corresponds to the CashFlowPricing function. We have described this function in detail in this post. If we dig into the profvis output, we can notice that the function that takes the most time is the RQuantlib::advance one. Unfortunately, this great function doesn’t have a vectorised version hence we need to use functional programming like map to calculate multiple future cashflows. Also the RQuantlib::yearFraction function doesn’t have a vectorised version hence I have preferred using another function that does the same but in a vectorised way. This function is fmdates::year_frac. The difference in performance is sizeable, as you can see from the microbenchmark test below:

today <- Sys.Date()
test <- seq(from = 3, to = 50*12, by = 3)
cashflows <- today + months(test)

microbenchmark::microbenchmark(
  "Rquantlib" = mapply(function(x) RQuantLib::yearFraction(today, x, 2), cashflows),
  "fmdates" = fmdates::year_frac(today, cashflows, "act/365")
)

## Unit: microseconds
##       expr      min       lq      mean    median        uq       max neval
##  Rquantlib 2915.595 3024.081 3907.1323 3128.7220 3242.4630 51671.770   100
##    fmdates  214.594  255.556  341.3879  292.0515  349.7035  4353.642   100

The difference in pricing is quite striking. I have submitted an issue request on the Github page of RQuantLib, let’s hope they’ll want to implement a vectorised version of their cashflow functions.

The actual pricing of the 500 swaps takes around 1 second. This is very encouraging because when it will come to curve optimisation (formerly known as bootstrapping) or risk sensitivities and scenarios, parts 1 and 2 will be run once at the beginning of the process while part 3 will be run multiple times.

Finally, I want to warn you: the package is still in a very early version, this is just v0.1.0, hence it is able to price just:

EUR swaps that pay semi-annually on the floating leg
Using a one-curve framework

We are working to improve the toolbox in the next releases

This is the plan of improvements (after I’ll submit the current version on CRAN for everybody to more easily access it - I am thinking, for example, to corporate networks that have the ports to Github blocked):

Extend to all the other currencies, custom frequencies and conventions
Introduce OIS discounting
Calculate additional risk measures like DV01, bucketed DV01 and Convexity

It’s going to be an interesting and long ride, you are welcome on-board!

Pricing floating legs of interest rate swaps

Mon, 08 Jul 2019 00:00:00 +0000

In this post we will close the trilogy on (old style) swap pricing. In particular, we will look at how downloading the data for the variable rate needed to calculate the variable leg accrual.

Part 1 gave the general idea behind tidy pricing interest rate swaps using a 7 lines pipe
Part 2 went much more into detail and priced some real world contract comparing the results obtained vs Bloomberg and showing significantly good results.

The only part missing was calculating the accrual for the floating leg. To do this we need the information about the historical level of the interest rate to which the leg is linked.

For standard EUR contracts, this rate is the 6 months’ EURIBOR. For those of you who are interested in understanding more what this rate is can go this link

Sourcing the data is not a problem, but doing it the R way (ie. for free), can be.

Luckily the awesome Quandl data provider actually provides the information we need. Quandl is a premier source for financial, economic, and alternative datasets, serving investment professionals. Quandl’s platform is used by over 400,000 people, including analysts from the world’s top hedge funds, asset managers and investment banks.

Pulling data from Quandl is very easy using the Quandl package available on CRAN Its logic is quite simple:

Quandl::Quandl(code, start_date, end_date)

where code is a unique identifier that can be sourced from the Quandl website.

In particular, we shoudl be grateful to the Bank of France which provides all the interest rate information we need. Going on their page we can in fact find that the code for the 6 months EURIBOR rate is “BOF/QS_D_IEUTIO6M”.

Let’s then see what the output of this very simple function is with our code:

rates <- Quandl::Quandl("BOF/QS_D_IEUTIO6M", 
               start_date = lubridate::dmy("01-01-2018"), 
               end_date = lubridate::dmy("31-12-2018"))

rates %>% 
  knitr::kable(caption = "Output from Quandl", "html") %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>% 
   kableExtra::scroll_box(height = "500px")

Table 1: Output from Quandl
Date	Value
2018-12-31	-0.237
2018-12-27	-0.237
2018-12-24	-0.237
2018-12-21	-0.238
2018-12-20	-0.238
2018-12-19	-0.238
2018-12-18	-0.238
2018-12-17	-0.237
2018-12-14	-0.238
2018-12-13	-0.239
2018-12-12	-0.241
2018-12-11	-0.244
2018-12-10	-0.245
2018-12-07	-0.246
2018-12-06	-0.246
2018-12-05	-0.246
2018-12-04	-0.247
2018-12-03	-0.248
2018-11-30	-0.251
2018-11-29	-0.253
2018-11-28	-0.256
2018-11-27	-0.256
2018-11-26	-0.256
2018-11-23	-0.257
2018-11-22	-0.257
2018-11-21	-0.257
2018-11-20	-0.257
2018-11-19	-0.257
2018-11-16	-0.257
2018-11-15	-0.257
2018-11-14	-0.257
2018-11-13	-0.257
2018-11-12	-0.257
2018-11-09	-0.257
2018-11-08	-0.257
2018-11-07	-0.258
2018-11-06	-0.258
2018-11-05	-0.257
2018-11-02	-0.258
2018-11-01	-0.258
2018-10-31	-0.259
2018-10-30	-0.259
2018-10-29	-0.259
2018-10-26	-0.259
2018-10-25	-0.259
2018-10-24	-0.259
2018-10-23	-0.259
2018-10-22	-0.261
2018-10-19	-0.262
2018-10-18	-0.265
2018-10-17	-0.266
2018-10-16	-0.265
2018-10-15	-0.266
2018-10-12	-0.267
2018-10-11	-0.267
2018-10-10	-0.268
2018-10-09	-0.268
2018-10-08	-0.267
2018-10-05	-0.267
2018-10-04	-0.268
2018-10-03	-0.267
2018-10-02	-0.268
2018-10-01	-0.268
2018-09-28	-0.268
2018-09-27	-0.268
2018-09-26	-0.267
2018-09-25	-0.267
2018-09-24	-0.267
2018-09-21	-0.268
2018-09-20	-0.268
2018-09-19	-0.267
2018-09-18	-0.268
2018-09-17	-0.268
2018-09-14	-0.269
2018-09-13	-0.269
2018-09-12	-0.269
2018-09-11	-0.269
2018-09-10	-0.269
2018-09-07	-0.269
2018-09-06	-0.269
2018-09-05	-0.269
2018-09-04	-0.269
2018-09-03	-0.268
2018-08-31	-0.268
2018-08-30	-0.268
2018-08-29	-0.266
2018-08-28	-0.266
2018-08-27	-0.265
2018-08-24	-0.266
2018-08-23	-0.266
2018-08-22	-0.266
2018-08-21	-0.266
2018-08-20	-0.266
2018-08-17	-0.266
2018-08-16	-0.266
2018-08-15	-0.266
2018-08-14	-0.266
2018-08-13	-0.266
2018-08-10	-0.267
2018-08-09	-0.266
2018-08-08	-0.268
2018-08-07	-0.268
2018-08-06	-0.268
2018-08-03	-0.268
2018-08-02	-0.269
2018-08-01	-0.269
2018-07-31	-0.268
2018-07-30	-0.268
2018-07-27	-0.269
2018-07-26	-0.269
2018-07-25	-0.269
2018-07-24	-0.269
2018-07-23	-0.269
2018-07-20	-0.269
2018-07-19	-0.269
2018-07-18	-0.269
2018-07-17	-0.269
2018-07-16	-0.269
2018-07-13	-0.268
2018-07-12	-0.271
2018-07-11	-0.271
2018-07-10	-0.269
2018-07-09	-0.270
2018-07-06	-0.270
2018-07-05	-0.269
2018-07-04	-0.269
2018-07-03	-0.270
2018-07-02	-0.269
2018-06-29	-0.270
2018-06-28	-0.270
2018-06-27	-0.270
2018-06-26	-0.270
2018-06-25	-0.269
2018-06-22	-0.268
2018-06-21	-0.268
2018-06-20	-0.268
2018-06-19	-0.268
2018-06-18	-0.268
2018-06-15	-0.268
2018-06-14	-0.268
2018-06-13	-0.268
2018-06-12	-0.267
2018-06-11	-0.267
2018-06-08	-0.267
2018-06-07	-0.269
2018-06-06	-0.269
2018-06-05	-0.269
2018-06-04	-0.269
2018-06-01	-0.269
2018-05-31	-0.269
2018-05-30	-0.269
2018-05-29	-0.269
2018-05-28	-0.269
2018-05-25	-0.271
2018-05-24	-0.271
2018-05-23	-0.270
2018-05-22	-0.271
2018-05-18	-0.271
2018-05-17	-0.270
2018-05-16	-0.272
2018-05-15	-0.271
2018-05-14	-0.271
2018-05-11	-0.271
2018-05-10	-0.271
2018-05-09	-0.269
2018-05-08	-0.269
2018-05-07	-0.269
2018-05-04	-0.269
2018-05-03	-0.269
2018-05-02	-0.269
2018-04-30	-0.269
2018-04-27	-0.269
2018-04-26	-0.269
2018-04-25	-0.270
2018-04-24	-0.270
2018-04-23	-0.270
2018-04-20	-0.271
2018-04-19	-0.270
2018-04-18	-0.271
2018-04-17	-0.270
2018-04-16	-0.270
2018-04-13	-0.271
2018-04-12	-0.271
2018-04-11	-0.270
2018-04-10	-0.271
2018-04-09	-0.270
2018-04-06	-0.270
2018-04-05	-0.271
2018-04-04	-0.271
2018-04-03	-0.270
2018-03-29	-0.271
2018-03-28	-0.271
2018-03-27	-0.271
2018-03-26	-0.271
2018-03-23	-0.270
2018-03-22	-0.271
2018-03-21	-0.272
2018-03-20	-0.273
2018-03-19	-0.272
2018-03-16	-0.272
2018-03-15	-0.271
2018-03-14	-0.271
2018-03-13	-0.271
2018-03-12	-0.271
2018-03-09	-0.271
2018-03-08	-0.272
2018-03-07	-0.272
2018-03-06	-0.271
2018-03-05	-0.272
2018-03-02	-0.271
2018-03-01	-0.271
2018-02-28	-0.270
2018-02-27	-0.271
2018-02-26	-0.271
2018-02-23	-0.271
2018-02-22	-0.270
2018-02-21	-0.271
2018-02-20	-0.273
2018-02-19	-0.274
2018-02-16	-0.274
2018-02-15	-0.276
2018-02-14	-0.276
2018-02-13	-0.276
2018-02-12	-0.278
2018-02-09	-0.278
2018-02-08	-0.278
2018-02-07	-0.278
2018-02-06	-0.279
2018-02-05	-0.278
2018-02-02	-0.278
2018-02-01	-0.278
2018-01-31	-0.279
2018-01-30	-0.278
2018-01-29	-0.278
2018-01-26	-0.278
2018-01-25	-0.278
2018-01-24	-0.278
2018-01-23	-0.276
2018-01-22	-0.277
2018-01-19	-0.276
2018-01-18	-0.275
2018-01-17	-0.274
2018-01-16	-0.272
2018-01-15	-0.274
2018-01-12	-0.271
2018-01-11	-0.271
2018-01-10	-0.271
2018-01-09	-0.271
2018-01-08	-0.271
2018-01-05	-0.271
2018-01-04	-0.271
2018-01-03	-0.271
2018-01-02	-0.271

We now have to incorporate this code into the overall coding strategy described in the previous post

Before we dive in how I coded this, let’s see how I changed the data structure of how a swap is defined:

swap.25y <- list(notional = 10000000,
                  start.date = lubridate::ymd(20070119),
                  maturity.date = lubridate::ymd(20320119), 
                  strike = 0.00059820,
                  type = "receiver", 
                  time.unit = list(pay = 6, receive = 12), 
                  dcc = list(pay = 0, receive = 6), 
                  calendar = "TARGET")

This new data structure now allows to define - as it should be - different characteristics (like coupon frequency or day count convention) for the different legs (payer and receiver) of the swap. In particular, we can specify in the type variable whether the swap is a receiver or a payer one.

Let’s look atthe code now. The function that gets modified the most is the SwapCashflowYFCalculation which I have re-named as CashFlowPricing one which now looks as follows:

CashFlowPricing  <- function(today, start.date, maturity.date, type,
                                     time.unit, dcc, calendar) {
  # Part 1: Calculate the whole cashflow dates
  cashflows <- seq(from = 0,
                   to = (lubridate::year(maturity.date) -
                           lubridate::year(start.date)) * 12,
                   by = time.unit) %>%
    purrr::map_dbl(~RQuantLib::advance(calendar = calendar,
                                       dates = start.date,
                                       n = .x,
                                       timeUnit = 2,
                                       bdc = 1,
                                       emr = TRUE)) %>%
    lubridate::as_date() %>%
    {if (start.date < today) append(today, .) else .}

  # Part 2: calculate accrual and rate fixing days
  accrual.date <- cashflows[today - cashflows > 0]

  if (!identical(as.double(accrual.date), double(0))) {
    accrual.date  %<>%  max()
    if (stringr::str_detect(type, "floating")) {
      fixing.date <- accrual.date %>%
        {RQuantLib::advance(calendar = calendar,
                            dates = .,
                            n = -2,
                            timeUnit = 0,
                            bdc = 1,
                            emr = TRUE)}
    } else {
      fixing.date <- NULL
    }
    accrual.yf <- accrual.date %>%
      {RQuantLib::yearFraction(today, ., dcc)} %>%
      `*`(-1)
  } else {
    fixing.date <- NULL
    accrual.yf <- 0
  }

  # Part 3: Tidy and return the list of relevant dates
  cashflows %<>%
    purrr::map_dbl(~RQuantLib::yearFraction(today, .x, dcc)) %>%
    tibble::tibble(yf = .) %>%
    dplyr::filter(yf >= 0)

  return(list(cashflows = cashflows, accrual.yf = accrual.yf,
              fixing.date = fixing.date))
}

Let’s analyise the code:

Part 1 is actually the core of the code previously described
Part 2 is the new code. accrual.date is the date from which the accrual starts to be calculated. This gets converted into a year fraction and saved into accrual.yf. The if statement calculates the date at which the floating EURIBOR rate has to be snapped from Quandl only for the floating rate. This date is stored in the fixing.date variable and it considers a 2 days lag which is standard for the European market.
Part 3 finally converts and returns all the future cashflows in terms of year fraction

You can note that we now calculate the cashflows for the floating leg even if it will note be used by the OLDParSwapRate function. This will be needed for future developments when we will introduce the OIS discounting…(stay tuned!!)

I can now calculate the accrual and for this purpose I developed a brand new function called CalculateAccrual

CalculateAccrual <- function(swap.dates, leg.type, swap, direction) {
  # Part 1: calculate the accrual rate
  if (!is.null(swap.dates$fixing.date)) {
    rate <- Quandl::Quandl("BOF/QS_D_IEUTIO6M",
                           start_date = swap.dates$fixing.date,
                           end_date = swap.dates$fixing.date) %>%
      tibble::as_tibble(.) %>%
      dplyr::select(Value) %>%
      as.double %>%
      `/`(100)
  } else {
    rate <- swap$strike
  }
  # Part 2: Calculate the value of the accrual
  swap.dates %>%
    purrr::pluck("accrual.yf") %>%
    `*`(swap$notional * rate * switch(leg.type, "pay" = -1, "receive" = 1))
}

This is smaller and easier function:

Part 1: for floating legs we use Quandl to download the needed data and extract the rate information. For the fixed one, we just use the strike of the swap.
Part 2: we calculate the actual accrual amount using the classical function

Let’s see the final result on the 25 years’ swap we use as test:

## # A tibble: 1 x 8
##   swap.id currency clean.mv dirty.mv accrual.pay accrual.receive     par
##   <chr>   <chr>       <dbl>    <dbl>       <dbl>           <dbl>   <dbl>
## 1 Swap 2… EUR      -881815. -874994.       5441.           1379. 0.00771
## # … with 1 more variable: pv01 <dbl>

Let’s compare the result with the Bloomberg screenshot

You can see that we now perfectly price also the receiving accrual and, of course, also the total one.

Real world tidy interest rate swap pricing

Thu, 25 Apr 2019 00:00:00 +0000

In this post I will show how easy is to price a portfolio of swaps leveraging the purrr package and given the swap pricing functions that we introduced in a previous post. I will do this in a “real world” environment hence using real market data as per the last 14th of April.

Import the discount factors from Bloomberg

Let’s start the pricing of the swap portfolio with purrr by loading from an external source the EUR discount factor curve. My source is Bloomberg and in particular the SWPM page, which allows all the Bloomberg users to price interest rate sensitive instruments. It also contains a tab with the curve information, which is the source of my curve. It is partly represented in the screenshot below and also as per the following table.

today <- lubridate::ymd(20190414)

ir_curve <- readr::read_csv(here::here("csv/Basket of IRS/Curve at 140419.csv"))

ir_curve %>% 
  knitr::kable(caption = "Input from Bloomberg", "html") %>% 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>% 
  kableExtra::scroll_box(width = "750px", height = "200px")

Table 1: Input from Bloomberg
Maturity Date	Market Rate	Shifted Rate	Zero Rate	Discount	Source
04/15/2019	-0.364000	-0.364000	-0.3640000	1.0000000	CASH
04/23/2019	-0.378000	-0.378000	-0.3780000	1.0000735	CASH
05/16/2019	-0.367000	-0.367000	-0.3670000	1.0003059	CASH
07/16/2019	-0.310000	-0.310000	-0.3100000	1.0007842	CASH
10/16/2019	-0.232000	-0.232000	-0.2320000	1.0011807	CASH
04/16/2020	-0.227000	-0.227000	-0.2293661	1.0023373	FRA
10/16/2020	-0.191000	-0.191000	-0.2164290	1.0033115	FRA
04/16/2021	-0.199250	-0.199250	-0.1992838	1.0039976	SWAP
04/19/2022	-0.130500	-0.130500	-0.1306045	1.0039393	SWAP
04/17/2023	-0.039750	-0.039750	-0.0398284	1.0015958	SWAP
04/16/2024	0.055250	0.055250	0.0554430	0.9972325	SWAP
04/16/2025	0.154250	0.154250	0.1550852	0.9907452	SWAP
04/16/2026	0.256500	0.256500	0.2584914	0.9820912	SWAP
04/16/2027	0.357250	0.357250	0.3609696	0.9715859	SWAP
04/18/2028	0.458250	0.458250	0.4644039	0.9591332	SWAP
04/16/2029	0.552400	0.552400	0.5615329	0.9455427	SWAP
04/16/2030	0.638500	0.638500	0.6510037	0.9311096	SWAP
04/16/2031	0.716500	0.716500	0.7326481	0.9161298	SWAP
04/17/2034	0.901000	0.901000	0.9281277	0.8705738	SWAP
04/18/2039	1.071000	1.071000	1.1106319	0.8017461	SWAP
04/19/2044	1.134000	1.134000	1.1759181	0.7464983	SWAP
04/20/2049	1.152000	1.152000	1.1905737	0.7010373	SWAP
04/16/2054	1.150000	1.150000	1.1826028	0.6626670	SWAP
04/16/2059	1.140249	1.140249	1.1661657	0.6289098	SWAP
04/16/2064	1.131000	1.131000	1.1512813	0.5974307	SWAP
04/16/2069	1.120999	1.120999	1.1359681	0.5684840	SWAP

We now wrangle this data in order to get a two columns tibble containing the time to maturity and the discount factors for each pillar points on the curve. We us a 30/360 day count convention because it is the standard for the EUR swaps.

df.table <- ir_curve %>% 
  dplyr::mutate(`Maturity Date` = lubridate::mdy(`Maturity Date`)) %>% 
  dplyr::rowwise(.) %>% 
  dplyr::mutate(t2m = RQuantLib::yearFraction(today, `Maturity Date`, 6)) %>% 
  na.omit %>% 
  dplyr::select(t2m, Discount) %>%
  dplyr::rename(df = Discount) %>% 
  dplyr::ungroup(.) %>% 
  dplyr::bind_rows(c(t2m = 0,df = 1)) %>% 
  dplyr::arrange(t2m)

ggplot2::ggplot(df.table, ggplot2::aes(x = t2m, y = df)) + 
  ggplot2::geom_point() +
  ggplot2::geom_line(colour = "blue") +
  ggplot2::ggtitle("Discount Factor curve at 14th of April 2019") +
  ggplot2::xlab("Time to maturity") +
  ggplot2::ylab("Discount Factor")

Interest Rate Swap pricing functions

I am now going to re-use the pricing functions that have been already described in a previous post. I have tidied them up a bit and given proper names, but the description still fully holds.

Let’s start from the one that calculates the swap cashflows.

SwapCashflowYFCalculation  <- function(today, start.date, maturity.date,
                                       time.unit, dcc, calendar) {
  0:((lubridate::year(maturity.date) - lubridate::year(start.date)) *
       (4 - time.unit)) %>% 
    purrr::map_dbl(~RQuantLib::advance(calendar = calendar,
                                       dates = start.date,
                                       n = .x,
                                       timeUnit = time.unit,
                                       bdc = 1,
                                       emr = TRUE)) %>%
    lubridate::as_date() %>%
    {if (start.date < today) append(today, .) else .} %>%
    purrr::map_dbl(~RQuantLib::yearFraction(today, .x, dcc)) %>% 
    tibble::tibble(yf = .) 
}

You may have noticed that I added one row {if (start.date < today) append(today, .) else .}. This allows to properly manage the pricing of swaps with a starting date before today.

I now proceed with calculating the actual par swap rate, which is a key input to the pricing formula. You can notice in the function below that I use a linear interpolation on the log of the discount factors. This is in line with one of the Bloomberg options. It is proven that it:

provides step constant forward rates
locally stabilises the bucketed sensitivities

Also the (old) swap rate pricing function is the same, we only filter for future cashflows as we want to be able to price swaps with a starting date before today.

OLDParSwapRate <- function(swap.cf){
  swap.cf %<>% 
    dplyr::filter(yf >= 0)
    
  num <- (swap.cf$df[1] - swap.cf$df[dim(swap.cf)[1]])
  annuity <- (sum(diff(swap.cf$yf)*swap.cf$df[2:dim(swap.cf)[1]]))
  return(list(swap.rate = num/annuity,
              annuity = annuity))
}

ParSwapRateCalculation <- function(swap.cf.yf, df.table) {
  swap.cf.yf  %>% 
    dplyr::mutate(df = approx(df.table$t2m, log(df.table$df), .$yf) %>%
                    purrr::pluck("y") %>% 
                    exp) %>%
    OLDParSwapRate
}

I now want to introduce two new functions which are needed for calculating the actual market values:

the first one extracts the year fraction for the accrual calculation
the second one calculates the main characteristics of a swap:
- the par swap rate
- the pv01 (or analytic delta)
- the clean market value
- the accrual for the fixed rate leg

I have defined a variable direction which represents the type of swap:

if it is equal to 1 then it is a receiver swap
if it is equal to -1 then it is a payer swap

CalculateAccrual <- function(swap.cf){
  swap.cf %>% 
    dplyr::filter(yf < 0) %>% 
    dplyr::select(yf) %>% 
    dplyr::arrange(dplyr::desc(yf)) %>% 
    dplyr::top_n(1) %>% 
    as.double %>% 
    {if (is.na(.)) 0 else .}
}

SwapCalculations <- function(swap.cf.yf, notional, strike, direction, df.table) {
  swap.par.pricing <- ParSwapRateCalculation(swap.cf.yf, df.table)
  
  mv <- notional * swap.par.pricing$annuity * (strike - swap.par.pricing$swap.rate) *
    direction
    
  accrual.fixed <- swap.cf.yf %>% 
    CalculateAccrual %>% 
    `*`(notional * strike * direction * -1)
  
  pv01 <- notional/10000 * swap.par.pricing$annuity * direction
  
  list(clean.mv = mv, accrual.fixed = accrual.fixed, par = swap.par.pricing$swap.rate, 
       pv01 = pv01)
}

We then put everything together with the following pricing pipe:

SwapPricing <- function(today, swap, df.table) {
  SwapCashflowYFCalculation(today, swap$start.date, 
                                       swap$maturity.date, swap$time.unit, 
                                       swap$dcc, swap$calendar) %>% 
    SwapCalculations(swap$notional, swap$strike, swap$direction, df.table)
}

Pricing a swap

It’s showtime! :-) Let’s test our pricing function on a swap that we define as a list. This is a EUR 10m notional receiver swap starting on the 19th of January 2007 with 25 years of maturity. The paying dates are calculated using the modified following rule and the day count convention is 30/360.

swap.25y <- list(notional = 10000000,
                 start.date = lubridate::ymd(20070119),
                 maturity.date = lubridate::ymd(20320119),
                 strike = 0.00059820,
                 direction = 1,
                 time.unit = 3,
                 dcc = 6,
                 calendar = "TARGET")


SwapPricing(today, swap.25y, df.table)

## $clean.mv
## [1] -881814.6
## 
## $accrual.fixed
## [1] 1379.183
## 
## $par
## [1] 0.007713252
## 
## $pv01
## [1] 12393.65

We can compare the results with the actual Bloomberg output:

You can notice that:

the par rate is exact to less than 1bp
the clean market price difference is less than 0.2 dv01s

We can therefore say that the pricing functions have been validated.

Pricing a basket of swaps

With purrr it is very easy to vectorise the SwapPricing hence the pricing of a portfolio of swaps is seemingless.

I firstly have to define a number of different contracts, including a forward starting one. I then combine all of them in a list and let the power of map.df do the magic.

swap.30y <- list(notional = 10000000,
                 start.date = lubridate::ymd(20120424),
                 maturity.date = lubridate::ymd(20420424),
                 strike = 0.01,
                 direction = -1,
                 time.unit = 3,
                 dcc = 6,
                 calendar = "TARGET")

swap.10y <- list(notional = 20000000,
                 start.date = lubridate::ymd(20120221),
                 maturity.date = lubridate::ymd(20220221),
                 strike = 0.0025,
                 direction = 1,
                 time.unit = 3,
                 dcc = 6,
                 calendar = "TARGET")

swap.2y.16y <- list(notional = 7500000,
                 start.date = lubridate::ymd(20210414),
                 maturity.date = lubridate::ymd(20370414),
                 strike = 0.015,
                 direction = 1,
                 time.unit = 3,
                 dcc = 6,
                 calendar = "TARGET")
swaps <- list(swap.25y = swap.25y, swap.30y = swap.30y, swap.10y = swap.10y, 
     swap.2y.16y = swap.2y.16y) 


pricing.result <- swaps %>% 
  purrr::map_df(~SwapPricing(today, .x, df.table)) %>% 
  dplyr::mutate(swap.id = names(swaps)) %>% 
  dplyr::select(swap.id, dplyr::everything())

Table 2: Pricing results
swap.id	clean.mv	accrual.fixed	par	pv01
swap.25y	-881,814.61	1,379.18	0.77%	12,393.65
swap.30y	233,691.75	-97,222.22	1.11%	-20,867.00
swap.10y	222,083.28	7,361.11	-0.14%	5,724.42
swap.2y.16y	360,095.21	-0.00	1.18%	11,163.37

This is it for today. In the next post I will finish the pricing of this book of swaps calculating the accrual of the floating leg - which requires a bit of web scraping. Stay tuned.

Using the tidyverse for swap pricing

Sun, 31 Mar 2019 00:00:00 +0000

Introduction

I am a big passionate of the tidyverse packages: I think they make the code very clean and clear. In particular, I like the lubridate packages for managing and making operations with dates but its major drawback is that it doesn’t manage financial holidays, which are key when projecting financial cashflows linked to instruments like interest rte swaps.

In this case, I prefer to use the RQuantLib package.

I will show how these packages can interact quite well by pricing a simple 7 years forward starting interest rate swap.

A simplified interest rate environment

Let’s firstly define a simplified market with flat zero rates at 2.5% (after all, not much different to the USD swap curve at the time of writing this post).

The discount factors formula can be found here and it is used as per the code below:

Today <- lubridate::ymd(20190329) # curve snap date
R <- 0.025 # zero rate
T2M <- seq(0,10) # sequential time to maturity
DF <- 1/(1 + R)^T2M # discount factors
DF_Table <- tibble::tibble(T2M = T2M, DF = DF) # discount factors table

Pricing a forward starting swap

Let’s now consider a forward starting swap that settles on the 31st of May 2019 and that has got 7 years of maturity.

The advance function in the RQuantLib package allows to calculate a date in the future given:

a calendar with the set of holidays well defined
a starting date
the number of time units to move forward
the basic time unit to move forward (days, weeks, months…)
a business day convention (please refer to the help page of the function for more info ?RQuantLib::advance )
whether the end-of-month rule applies (ie. if the starting date is the last business date of the month and the time unit is monthly or yearly, the forward date has to be the last date of the target month, net of business day adjustment)

The code below shows how to use this function:

RQuantLib::advance(calendar = "UnitedStates", 
                   dates = lubridate::ymd(20190531), 
                   n = 1, 
                   timeUnit = 3, 
                   bdc = 2, 
                   emr = TRUE)

## [1] "2020-05-29"

It is extremely simple for us to extend this for all the future dates in the next 7 years, using the purrr function map_dbl. We also prepend the starting date of the swap.

library(magrittr)
Start_Date <- lubridate::ymd(20190531)
Swap_Dates <- purrr::map_dbl(1:7,~RQuantLib::advance(calendar = "UnitedStates",
                                       dates = Start_Date,
                                       n = .x, 
                                       timeUnit = 3, 
                                       bdc = 2, 
                                       emr = TRUE)) %>% 
  lubridate::as_date() %>% 
  append(Start_Date, ., after = 1)

Swap_Dates

## [1] "2019-05-31" "2020-05-29" "2021-05-28" "2022-05-31" "2023-05-31"
## [6] "2024-05-31" "2025-05-30" "2026-05-29"

You can immediately see that the advance function automatically manages the weekends adjusting the final dates.

We should now convert these dates into time to maturities by using the day count convention ACT/360 (value 0 for the DayCounter parameter in the function). Again, I use the RQuantLib function yearFraction in conjunction with the map_dbl to programatically operate on all the dates as follows:

Swap <- purrr::map_dbl(Swap_Dates, ~RQuantLib::yearFraction(Today, .x, 0)) %>% 
  tibble::tibble(Swap_YF = .)

We now interpolate the original discount factor curve linearly over these year fractions. We use the approx function together with the pluck one from purrr as follows:

Swap %<>% 
  dplyr::mutate(DF = approx(DF_Table$T2M, DF_Table$DF, .$Swap_YF) %>% 
                  purrr::pluck("y"))

We can now price the swap rate using the old fashion formula which can be found here.

We code the formula in the following function:

OLD_Swap_Rate_Calculation <- function(Swap){
  num <- (Swap$DF[1] - Swap$DF[dim(Swap)[1]])
  annuity <- (sum(diff(Swap$Swap_YF)*Swap$DF[2:dim(Swap)[1]]))
  return(num/annuity)
}

OLD_Swap_Rate_Calculation(Swap)

## [1] 0.02500193

Having the forward exactly equal to 2.5% (net of a small effect due to the ACT/360 day count convention) confirms that the calculation is performed correctly.

Below you can find the code in its entirety (we using the ACT/ACT day count convention to show that the actual result is equal to 2.5% to 1/1000th of bp):

## Interest Rate Setting
Today <- lubridate::ymd(20190329) # curve snap date
R <- 0.025 # zero rate
T2M <- seq(0,10) # sequential time to maturity
DF <- 1/(1 + R)^T2M # discount factors
DF_Table <- tibble::tibble(T2M = T2M, DF = DF) # discount factors table

## Swap Pricing
Swap_Start_Date <- lubridate::ymd(20190531)
Swap_Rate <- purrr::map_dbl(1:7,~RQuantLib::advance(calendar = "UnitedStates",
                                       dates = Swap_Start_Date,
                                       n = .x, 
                                       timeUnit = 3, 
                                       bdc = 2, 
                                       emr = TRUE)) %>% 
  lubridate::as_date() %>% 
  append(Swap_Start_Date, ., after = 1) %>% 
  purrr::map_dbl(~RQuantLib::yearFraction(Today, .x, 2)) %>% 
  tibble::tibble(Swap_YF = .) %>% 
  dplyr::mutate(DF = approx(DF_Table$T2M, DF_Table$DF, .$Swap_YF) %>% 
                  purrr::pluck("y")) %>% 
  OLD_Swap_Rate_Calculation

Swap_Rate

## [1] 0.02499993

You can notice how easy it was to price the swap using only 5 tidyverse functions, 2 RQuantLib ones and a bespoke one!

Spoiler on the next post

The function we described will be the starting point for the natural extension of the study:

we will use a real market consistent discount factor curve to test the pricing and
we will programatically extend the function for it to price potentially an infinite number of contracts at the same time

US Federal Spending Analysis

Mon, 11 Feb 2019 00:00:00 +0000

This week's #TidyTuesday is about federal spending.

I was interested in understanding if spending had shifted towards clean energy sub-agencies in the last 20 years. Spoiler alert: unfortunately no! 😰#Rstats #tidyverse cc @thomas_mock @R4DScommunity pic.twitter.com/AbQzheSagU
— Davide Magno (@DavideMagno) February 12, 2019

Geospatial Analysis on Housing Price Index

Sun, 10 Feb 2019 00:00:00 +0000

Here's my #TidyTuesday submission.I studied the total increase in the housing index for each US State compared to the US federal index. No surprise in California house price has increased much more than the rest of US.The #mapdata library was 👍🏼@thomas_mock @R4DScommunity #rstats pic.twitter.com/sYI1zKhIpC
— Davide Magno (@DavideMagno) February 10, 2019

My First #TidyTuesday Submission

Sun, 03 Feb 2019 00:00:00 +0000

Finally my first #TidyTuesday submission! 🎊🎉I am starting from week 1 2019 but I will catch up soon😉When do people submit their visualisations?Mostly on Tuesday and Wednesday afternoon, but also on Monday before the new set is released #rstats #ggplot @rstats4ds @thomas_mock pic.twitter.com/pKZAyL8vp1
— Davide Magno (@DavideMagno) February 3, 2019

Convert foreign currency valuations

Wed, 14 Feb 2018 00:00:00 +0000

One of the most common problems when dealign with financial data is to have assets (or liabilities) denominated in a currency that is different from the domestic one.

I propose a tidy solution to this problem that involves no use of for cycles.

The principle of the solution is that converting each currency can be done in parallel using the map function while the consolidation of the results will be done using the reduce logic.

I am a big fan of the tidyverse and therefore I will start loading the required packages

library(purrr)
library(stringr)
library(tibble)
library(magrittr)
library(dplyr)

I suppose to have a very simple investment dataset made of two fields:

a column with the currency of the investment (local currency being EUR)
a column with the market value of the investment in local currency

Investments <- tibble(ccy = c(rep("EUR",2), rep("JPY",3), rep("GBP",3)),
                      local_MV = c(1.5e6,1.2e6,2e8,1.5e8,3e8,1e6,1.5e6,2e6)) %>% 
  mutate(local_MV = as.double(local_MV)) %>% 
  mutate(EUR_MV = local_MV)

Investments

## # A tibble: 8 x 3
##   ccy    local_MV    EUR_MV
##   <chr>     <dbl>     <dbl>
## 1 EUR     1500000   1500000
## 2 EUR     1200000   1200000
## 3 JPY   200000000 200000000
## 4 JPY   150000000 150000000
## 5 JPY   300000000 300000000
## 6 GBP     1000000   1000000
## 7 GBP     1500000   1500000
## 8 GBP     2000000   2000000

I then store in a list the current currency FX rates

FX <- list("JPY" = 130, "GBP" = 0.8)

The first part of the algorithm consists in finding the rows of the Investments database which are subject to FX conversion for each of the currencies that are stored in the FX list using the stringr function str_which.

This is the “parallel” part of the algorithm because it can be done currency by currency independently. We therefore use the map function of the purrr package.

pos_ccy <- map(names(FX), ~str_which(Investments$ccy,.)) %>% 
  set_names(names(FX))

pos_ccy

## $JPY
## [1] 3 4 5
## 
## $GBP
## [1] 6 7 8

This list contains the row numbers for which there is an investment denominated in each of the currencies in the FX universe. We then use this information together with the actual FX rate to convert the investments’ local market value. We now use the map2 function.

converted_MV <- map2(pos_ccy, FX ,~Investments$local_MV[.x]/.y)

converted_MV

## $JPY
## [1] 1538462 1153846 2307692
## 
## $GBP
## [1] 1250000 1875000 2500000

We can notice that we now have a list made by two different vectors of converted market values. We need to consolidate those into the EUR_MV column in the Investments dataset.

This is the second step of the algorithm that uses the reduce function of purrr

Investments$EUR_MV[pos_ccy %>% reduce(c)] <- converted_MV %>% 
  reduce(c)

Investments

## # A tibble: 8 x 3
##   ccy    local_MV   EUR_MV
##   <chr>     <dbl>    <dbl>
## 1 EUR     1500000 1500000 
## 2 EUR     1200000 1200000 
## 3 JPY   200000000 1538462.
## 4 JPY   150000000 1153846.
## 5 JPY   300000000 2307692.
## 6 GBP     1000000 1250000 
## 7 GBP     1500000 1875000 
## 8 GBP     2000000 2500000

This function modifies rows of the EUR_MV field by reducing the lists from the map functions into vectors.

We can notice that the EUR positions have not changed their market value.

Generate scenarios correlated to existing ones

Mon, 29 Jan 2018 00:00:00 +0000

In quantitative finance we often look at simulations of some market risk factors like equity returns or interest rate changes.

There are many third party companies who specialize in the historical calibration of such variables and provide simulations of future expected outcomes to the companies who require them.

For example, let’s suppose that we receive the expected returns of the Google shares as per the following distribution

# This modelling is given by the third party and in theory we don't know it
google <- rnorm(10000, mean = 0.01, sd = 0.20) %>% 
  tibble(google_returns = .)

ggplot(data = google, aes(x = google_returns)) + 
  geom_density() +
  scale_x_continuous(labels = percent) + 
  labs(title = "Google Shares",
        subtitle = "One Year forward distribution") +
  xlab("One year forward return") + 
  ylab("Density")

We now want to simulate the distribution of another risk factor which is not provided by the third party but that is usefull for us. Let’s say it is the distribution of the Facebook shares which we imagine to:

be distributed as a normal random variable
have a 5% expected return and
being quite volatile (30% annual volatility)
have the same number of points as the simulations provided by the third party (10000 points)

We model therefore the distribution as follows:

# This modelling is our internal one and we can therefore control it
fb <- rnorm(10000, mean = 0.05, sd = 0.30) %>% 
  tibble(fb_returns = .)

ggplot(data = fb, aes(x = fb_returns)) + 
  geom_density() +
  scale_x_continuous(labels = percent) + 
  labs(title = "Facebook Shares",
        subtitle = "One Year forward distribution") +
  xlab("One year forward return") + 
  ylab("Density")

Let’s now look at the correlation between the two variables:

Returns <- google %>% 
  cbind(fb) %>% 
  as.tibble()

## Warning: `as.tibble()` is deprecated, use `as_tibble()` (but mind the new semantics).
## This warning is displayed once per session.

cor(Returns$fb_returns, Returns$google_returns)

## [1] 0.0166395

We can notice that performing the simple simulation doesn’t allow us to impose a correlation structure with the data provided by the third party provider.

How can we generate a random variable with a defined correlation to an existing one? A very elegant solution was provided by user whuber at the following link https://stats.stackexchange.com/a/313138 and by using the following function

complement <- function(y, rho, x) {
  if (missing(x)) x <- rnorm(length(y)) # Optional: supply a default if `x` is not given
  y.perp <- residuals(lm(x ~ y))
  rho * sd(y.perp) * y + y.perp * sd(y) * sqrt(1 - rho^2)
}

In this function x is our Facebook uncorrelated scenario , rho is the correlation level and y is the Google scenario as provided by the third party.

We apply this function imposing an 80% correlation

Returns %<>%  
  mutate(fb_correlated = complement(.$google_returns,0.8, .$fb_returns))

cor(Returns$google_returns, Returns$fb_correlated)

## [1] 0.8

There is just one last thing to do: compare the distributions of the two Facebook simulations

Returns %>% 
  select(contains("fb")) %>% 
  gather(simulation_type, simulation_value) %>% 
  ggplot(aes(x = simulation_value, colour = simulation_type)) +
  geom_density() +
  scale_x_continuous(labels = percent) + 
  labs(title = "Facebook Shares' simulations") +
  xlab("One year forward return") + 
  ylab("Density")

We can notice that the marginal distribution of the correlated scenario is much different from the original one.

There is therefore one additional step before we finish: we need to rescale the marginal distribution.

Rescaled_fb_correlated <- Returns %>%
  select(contains("correlated")) %>%
  scale() %>% 
  multiply_by(0.3) %>% 
  add(0.05)

Returns %<>% 
  mutate(fb_correlated_scaled = Rescaled_fb_correlated)

We can now check that the the marginals are comparable and that the correlation structure is still at the desired level

Returns %>% 
  select(contains("fb")) %>% 
  gather(simulation_type, simulation_value) %>% 
  ggplot(aes(x = simulation_value, colour = simulation_type)) +
  geom_density() +
  scale_x_continuous(labels = percent) + 
  labs(title = "Facebook Shares' simulations") +
  xlab("One year forward return") + 
  ylab("Density")

cor(Returns$google_returns, Returns$fb_correlated)

## [1] 0.8

The new Facebook scenario is now both correlated and in line with the density we want.