Analysis.Rmd

---
title: "Analysis"
author: "asitav"
date: "22/04/2021"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
library(lubridate)
library(survival)
library(triangle)
library(imfr)
library(pec)
```



```{r}
ndt<-read.csv("./data/transactions.csv")
```


```{r}

ndt<-
ndt%>%
  mutate(
    origination_date=ymd(origination_date),
    maturity_date=ymd(maturity_date),
    report_date=ymd(report_date)
  )

dataset<-
ndt%>%
  mutate(age_of_asset_months=round(as.numeric(report_date-origination_date)/30))%>%
  mutate(loan_tenure_months=round(as.numeric(maturity_date-origination_date)/30))%>%
  group_by(id)%>%
  arrange(report_date)%>%
  mutate(cum_default=cumsum(default_flag),
         bureau_score_lag=ifelse(is.na(lag(bureau_score_orig,1)),
                                 bureau_score_orig,lag(bureau_score_orig,1)))%>%
  mutate(bureau_score_delta=bureau_score_lag-bureau_score_orig)%>%
  mutate(qtr = paste0(year(report_date),"-Q",quarter(report_date)))%>%
  dplyr::select(-bureau_score_orig)



databaseID <- "IFS"
startdate = min(ndt$report_date)
enddate = max(ndt$report_date)
checkquery = FALSE

imf.data<-imf_data(
  databaseID,
  c("AIP_IX", 
    "PCPI_IX"),
  country = "IN",
  start = startdate,
  end = enddate,
  freq = "Q",
  return_raw = FALSE,
  print_url = T,
  times = 3
)

tryCatch({
  
},
 error = function(e)
 print("You can't calculate the log of a character"))


dataset_with_eco<-
dataset%>%
  left_join(imf.data, by=c("qtr"="year_quarter")) %>% 
  rename(gdp=NGDP_R_K_IX, prices=PCPI_IX)%>%
  select(-iso2c) %>% 
  group_by(id)%>%
  mutate(gdp_lag=lag(gdp,1), prices_lag=lag(prices,1))%>%
  dplyr::select(-qtr)%>%
  dplyr::select(-c(gdp,prices))
  
dataset_with_eco<-dataset_with_eco[!is.na(dataset_with_eco$gdp_lag) & !is.na(dataset_with_eco$prices_lag), ]

df<-dataset_with_eco%>%
  dplyr::select(!where(is.Date))
lenun<- function(x){
  length(unique(x))
}
df<-df%>%
  select(-names(which(apply(df, 2, lenun)==1)))

df$asset_type<-as.factor(df$asset_type)
df$supplier<-as.factor(df$supplier)
df$customer_type<-as.factor(df$customer_type)




dt<-imf_codes("CL_INDICATOR_IFS")
dt %>% 
  DT::datatable()
```







```{r}

# some cleaning
                         variables<-colnames(df)[!colnames(df) %in% c("id","age_of_asset_months","loan_status")]
form<-as.formula(paste0("Surv(age_of_asset_months, loan_status) ~",paste(variables,collapse = "+")))
                         surv.res<-coxph(form, data = df, id=id)
                         res<-as.data.frame(summary(surv.res)$coefficients)
                         selvars<-
                             res%>%
                             filter(is.finite(`Pr(>|z|)`))%>%
                           filter(is.finite(z)) %>% 
                             rownames()
                         for(j in 1:length(variables)) {
                             selvars[grep(pattern = variables[j],selvars)]<-variables[j]
                         }
                         selvars<-unique(selvars)
                         
                         form<-as.formula(paste0("Surv(age_of_asset_months, loan_status) ~",paste(selvars,collapse = "+")))

                         scores<-rep(NA,5)
                         variables<-selvars
                         a<-length(variables)
                         f<-vector(mode = "list", length = a)
                         scores = vector(length = a)
                         for(i in 1:a){
                             v<-variables[i:a]
                             #n<-paste0("form",i)
                             f[[i]]<-coxph(as.formula(paste0("Surv(age_of_asset_months, loan_status) ~",paste(v,collapse = "+"))),
                                           data = df, id=id,x=T, y=T)
                             perror<-pec(object = f[[i]],formula = form, splitMethod = "cvK5", data=df)
                             scores[i]<-1-ibs(perror)["coxph",]/ibs(perror)["Reference",]
                         }
                         
                         final.model<-f[[which(scores==max(scores, na.rm = T))]]


summary(final.model, newdata=df, se.fit = TRUE, conf.int = 0.95, times=50)

imf.data$year_quarter<-zoo::as.yearqtr(imf.data$year_quarter, format="%Y-Q%q")
ga<-imf.data[,c(2,3)]
minqg<-min(imf.data$year_quarter)
gats<-ts(ga$NGDP_R_K_IX, start = minqg, frequency = 4)

fit.gdp <- forecast::auto.arima(gats, seasonal=FALSE)
fit.gdp
gdp.forecast<-fit.gdp %>% forecast::forecast(h=60)
gdp.forecast<-as.data.frame(gdp.forecast)%>%
  mutate(qtr=rownames(.)) %>% 
  mutate(stringr::str_replace(qtr, " ","-"))

imf.data$year_quarter<-zoo::as.yearqtr(imf.data$year_quarter, format="%Y-Q%q")
gp<-imf.data[,c(2,4)]
pats<-ts(gp$PCPI_IX, start = minqg, frequency = 4)
fit.pats <- forecast::auto.arima(gats, seasonal=FALSE)
fit.pats
pats.forecast<-fit.pats %>% forecast::forecast(h=60)
pats.forecast<-as.data.frame(pats.forecast)%>%
  mutate(qtr=rownames(.)) %>% 
  mutate(stringr::str_replace(qtr, " ","-"))
maxdate<-max(ndt$report_date)
z<-
  df%>%
  group_by(id)%>%
  slice_max(age_of_asset_months,n=1) %>% 
  ungroup()%>%
  mutate(emi=balance/(unique(loan_tenure_months)-unique(age_of_asset_months)))%>%
  mutate(balance.original=balance) %>%
  mutate(age.original=age_of_asset_months) %>% 
  mutate(risk_current=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
  mutate(balance=balance-emi*12) %>% 
  mutate(age_of_asset_months=age_of_asset_months+12) %>% 
  mutate(gdp_lag=gdp.forecast[gdp.forecast$qtr==zoo::as.yearqtr(maxdate+months(11)),]$`Point Forecast`,
         prices_lag=pats.forecast[pats.forecast$qtr==zoo::as.yearqtr(maxdate+months(11)),]$`Point Forecast`) %>%
  mutate(risk_1yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
  mutate(balance=balance-emi*12) %>% 
  mutate(age_of_asset_months=age_of_asset_months+12) %>% 
  mutate(gdp_lag=gdp.forecast[gdp.forecast$qtr==zoo::as.yearqtr(maxdate+months(23)),]$`Point Forecast`,
         prices_lag=pats.forecast[pats.forecast$qtr==zoo::as.yearqtr(maxdate+months(23)),]$`Point Forecast`) %>%
  mutate(risk_2yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
  mutate(balance=balance-emi*12) %>% 
  mutate(age_of_asset_months=age_of_asset_months+12) %>% 
  mutate(gdp_lag=gdp.forecast[gdp.forecast$qtr==zoo::as.yearqtr(maxdate+months(35)),]$`Point Forecast`,
         prices_lag=pats.forecast[pats.forecast$qtr==zoo::as.yearqtr(maxdate+months(35)),]$`Point Forecast`) %>%
  mutate(risk_3yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
  mutate(balance=balance-emi*12) %>% 
  mutate(age_of_asset_months=age_of_asset_months+12) %>% 
  mutate(gdp_lag=gdp.forecast[gdp.forecast$qtr==zoo::as.yearqtr(maxdate+months(47)),]$`Point Forecast`,
         prices_lag=pats.forecast[pats.forecast$qtr==zoo::as.yearqtr(maxdate+months(47)),]$`Point Forecast`) %>%
  mutate(risk_4yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
  mutate(balance=balance-emi*12) %>% 
  mutate(age_of_asset_months=age_of_asset_months+12) %>% 
  mutate(gdp_lag=gdp.forecast[gdp.forecast$qtr==zoo::as.yearqtr(maxdate+months(59)),]$`Point Forecast`,
         prices_lag=pats.forecast[pats.forecast$qtr==zoo::as.yearqtr(maxdate+months(59)),]$`Point Forecast`) %>%
  mutate(risk_5yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
  group_by(id)%>%
  tidyr::pivot_longer(cols = c("risk_current", "risk_1yr", "risk_2yr", "risk_3yr", "risk_4yr", 
                               "risk_5yr")) %>% 
  mutate(r_n=row_number())%>%
  mutate(t.emi=emi+emi*12*(r_n-1))%>%
  mutate(balance=ifelse(t.emi==max(emi),balance,balance-t.emi))%>%
  mutate(balance=ifelse(balance<=0,0,balance))%>%
  filter(t.emi>0)

# z<-
# df%>%
#   group_by(id)%>%
#   slice_max(age_of_asset_months,n=1)%>%
#   ungroup()%>%
#   mutate(a_in_mon=age_of_asset_months)%>%
#   mutate(risk_current=1-exp(-predict(final.model, ., type="expected", collapse = id)))%>%
#   mutate(age_of_asset_months=ifelse(age_of_asset_months<loan_tenure_months, age_of_asset_months+12,0))%>%
#   mutate(risk_1yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
#   mutate(age_of_asset_months=ifelse(age_of_asset_months<loan_tenure_months, age_of_asset_months+24,0))%>%
#   mutate(risk_2yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
#   mutate(age_of_asset_months=ifelse(age_of_asset_months<loan_tenure_months, age_of_asset_months+36,0))%>%
#   mutate(risk_3yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
#   mutate(age_of_asset_months=ifelse(age_of_asset_months<loan_tenure_months, age_of_asset_months+48,0))%>%
#   mutate(risk_4yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>% 
#   mutate(age_of_asset_months=ifelse(age_of_asset_months<loan_tenure_months, age_of_asset_months+60,0))%>%
#   mutate(risk_5yr=1-exp(-predict(final.model, ., type="expected", collapse = id))) %>%
#   mutate(age_of_asset_months=ifelse(age_of_asset_months<loan_tenure_months, loan_tenure_months,0))%>%
#   mutate(risk_till_end=1-exp(-predict(final.model, ., type="expected", collapse = id)))%>%
#   group_by(id)%>%
#   tidyr::pivot_longer(cols = c("risk_current", "risk_1yr", "risk_2yr", "risk_3yr", "risk_4yr", 
#                                "risk_5yr"))%>%
#   mutate(emi=unique(balance)/(unique(loan_tenure_months)-unique(a_in_mon)))%>%
#   mutate(r_n=row_number())%>%
#   mutate(t.emi=emi+emi*12*(r_n-1))%>%
#   mutate(balance=ifelse(t.emi==max(emi),balance,balance-t.emi))%>%
#   mutate(balance=ifelse(balance<=0,0,balance))%>%
#   filter(t.emi>0)


z%>%
  group_by(name)%>%
  #summarise(pd.me=median(value), pd.min=quantile(value,0.05), pd.max=quantile(value, 0.95))%>%
  slice_head(n=6)%>%
  mutate(name=factor(name, levels = c("risk_current", "risk_1yr", "risk_2yr", "risk_3yr", "risk_4yr", 
                               "risk_5yr")))%>%
  filter(!is.na(name))%>%
  ggplot(aes(x=name, y=value, fill=name))+
  geom_violin()+
  geom_boxplot(width=0.1, color="black", alpha=0.2)+
  labs(x="",
       y="Probability",
       title = "Probability of default")+
  theme_bw()+
  theme(legend.title = element_blank(), legend.position = "bottom")


```


```{r}

collateral<- read.csv("./data/collateral.csv")

# Exposure at Default
discount_rate_pa<-0.02
z%>%
  mutate(pv.balance=balance/(1+discount_rate_pa)^(r_n-1))%>%
  mutate(exposure_on_default=pv.balance*value)%>%
  group_by(name)%>%
  summarise(pv.balance=sum(pv.balance), exposure_on_default=sum(exposure_on_default))%>%
  mutate(name=factor(name, levels = c("risk_current", "risk_1yr", "risk_2yr", "risk_3yr", "risk_4yr", 
                               "risk_5yr")))%>%
  pivot_longer(cols=c("pv.balance","exposure_on_default"), names_to="type", values_to="amount")%>%
  ggplot(aes(x=name, y=amount/1000000, fill=type, label=paste0(round(amount/1000000)," M")))+
  geom_col(position = "dodge")+
  geom_text(aes(y=(amount/1000000)+5), position = position_dodge(width = 1))+
  labs(x="",
       y="Amount",
       title = "Exposure on default",
       subtitle = "Amounts discounted")+
  theme_bw()+
  theme(legend.title = element_blank(), legend.position = "bottom")
```



```{r}
# Loss given default

c.value.mp<- -0.3
c.value.min<- -1
c.value.max<- 0

z%>%
  group_by(id)%>%
  mutate(pv.balance=balance/(1+discount_rate_pa)^(r_n-1))%>%
  mutate(exp_loss=value*pv.balance)%>%
  left_join(collateral, by="id")%>%
  mutate(dep=rtriangle(1, a=c.value.min, b=c.value.max,c=c.value.mp))%>%
  mutate(colla.val=collateral*(1+dep*(r_n-1)))%>%
  mutate(colla.val=ifelse(colla.val<0,0,colla.val))%>%
  mutate(lgd=(pv.balance-colla.val)/pv.balance)%>%
  mutate(lgd=ifelse(pv.balance==0 | exp_loss==0, 0, lgd))%>%
  mutate(ecl=value*pv.balance*lgd)%>%
  group_by(name)%>%
  summarise(ecl=sum(ecl))%>%
  mutate(name=factor(name, levels = c("risk_current", "risk_1yr", "risk_2yr", "risk_3yr", "risk_4yr", 
                               "risk_5yr")))%>%
  ggplot(aes(x=name, y=ecl/1000000, label=paste0(round(ecl/1000000,2)," M")))+
  geom_col()+
  geom_text(aes(y=(ecl/1000000)+(ecl/1000000)*0.2), position = position_dodge(width = 1))+
  labs(x="",
       y="Amount",
       title = "Expected Credit Loss",
       subtitle = "Amount in present value")+
  theme_bw()+
  theme(legend.title = element_blank(), legend.position = "bottom")
```


```{r}
#scenario

zz <-
  z %>%
  ungroup() %>%
  group_by(id) %>%
  mutate(pv.balance = balance / (1 + discount_rate_pa) ^ (r_n - 1)) %>%
  left_join(collateral, by = "id") %>%
  ungroup() %>%
  select(name, pv.balance, value, collateral)



sim.t <- data.frame(matrix(ncol = 1000, nrow = nrow(zz)))
colnames(sim.t) <- paste0("sim", seq(1:1000))
sim.col.prob <-
  (1 - rtriangle(1000, a = c.value.min, b = c.value.max, c = c.value.mp))
for (i in 1:1000) {
  sim.t[, i] <-
    round(zz$value * (zz$pv.balance - zz$collateral * sim.col.prob[i]), 2)
}
sims.a <- colSums(sim.t)
sim.d <- cbind(zz, sim.t)
sim.d %>% select(matches("sim?"))
hist.pro <- density(colSums(sim.t))
pro_dens <- data.frame(hist.pro$x, hist.pro$y)

pro_dens %>%
  filter(hist.pro.x > 1)

ggplot(pro_dens,
       aes(
         x = hist.pro.x,
         y = hist.pro.y,
         ymin = 0,
         ymax = max(hist.pro.y)
       )) + geom_area(aes(y = hist.pro.y))

df%>%
  mutate(amount=x*y) %>% 
  group_by(r) %>% 
  summarise(amount=sum(amount))
names(ndt$"id")
x$"ID"<-as.character(x$"ID")
x
imgurl <- png::readPNG("minionw.png")
g<-grid::rasterGrob(imgurl, interpolate=TRUE)
sticker(g, package="IFRSassistant", p_size=6,  s_width=2, s_height= 0.75, h_fill = "grey9", h_color = "white",
         p_color = "white", url = "www.asitavsen.com", u_color = "white",
         filename="logo3.png", spotlight = T, l_height = 1, l_x=0.275, l_y=0.75, s_x=1, s_y=1.3, p_x=1,p_y=0.6, l_alpha = 0.6)

```