Most econometric models used in financial institutions are adapted to work with highly summarized data. For example, liquidity risk control (cash flow), profit risk analysis ect. are based on a daily summarized data. In reports to central institutions a usual time lag is either one month or quarter or one year. Similar time lag is used in macroeconometrics.
In many different fields of applied statistics an object of interest is depending on some continuous parameter. Typical examples in finance are implied volatility functions, yield curves or risk-neutral densities. Due to the different market conventions and further technical reasons, these objects are observable only on a discrete grid, e.g. for a grid of strikes and maturities for which the trade has been settled at a given time-point. By collecting these functions for several time points (e.g. days) or for different underlyings, a bunch (sample) of functions is obtained – a functional data set. (M.Sc. Michal Benko)
This project tries to scratch a surface of what functional data analysis (FDA) is. The objective of this project is a study of dairy farmer payments using a high frequency data. Treating week time series as random functions in a space spanned by finite dimensional functional bases, we are able to explore some of the methods of functional data analysis. The data provided presents historical one year (52 weeks) of payments to the dairy farmers which are made by their clients.
rm(list=ls())
options(warn=-1)
if(!("devtools" %in% installed.packages()[,1])){install.packages("devtools")}
if(!("rio" %in% installed.packages()[,1])){install.packages("rio")}
rio::install_formats()
#> [1] TRUE
if(!("lubridate" %in% installed.packages()[,1])){install.packages("lubridate")}
if(!("ggplot2" %in% installed.packages()[,1])){install.packages("ggplot2")}
if(!("missForest" %in% installed.packages()[,1])){install.packages("missForest")}
if(!("ddalpha" %in% installed.packages()[,1])){install.packages("ddalpha")}
if(!("fda.usc" %in% installed.packages()[,1])){devtools::install_github("moviedo5/fda.usc")}
if(!("ftsa" %in% installed.packages()[,1])){install.packages("ftsa")}
if(!("DepthProc" %in% installed.packages()[,1])){install.packages("DepthProc")}
suppressMessages({
library(devtools)
library(rio)
library(lubridate)
library(ggplot2)
library(missForest)
library(ddalpha)
library(fda.usc)
library(ftsa)
library(DepthProc)
})
data_microfinance <- import("databank/farmers_salary_transactions.csv")
names(data_microfinance) <- tolower(names(data_microfinance))
names(data_microfinance) <- gsub("\\.","",names(data_microfinance))
names(data_microfinance) <- gsub(" ","_",names(data_microfinance))
data_microfinance <- as.data.frame(lapply(data_microfinance, function(v) as.numeric(gsub(",","", v))))
data_microfinance <- as.data.frame(t(data_microfinance))
names(data_microfinance) <- paste("farmer_no",data_microfinance[1,],sep="_")
data_microfinance <- data_microfinance[-1,]
set.seed(153243)
data_microfinance <- missForest(data_microfinance, maxiter = 3, ntree = 5)$ximp
#> removed variable(s) 141 1131 due to the missingness of all entries
#> missForest iteration 1 in progress...done!
#> missForest iteration 2 in progress...done!
#> missForest iteration 3 in progress...done!
data_microfinance$week <- rownames(data_microfinance)
rownames(data_microfinance) <- NULL
data_microfinance <- data_microfinance[,c(1274,1:1273)]
data_microfinance$week <- gsub("week","",data_microfinance$week)
data_microfinance$week <- as.Date(paste(2021, data_microfinance$week, 1, sep="-"), "%Y-%U-%u")
data_sum <- as.data.frame(sapply(data_microfinance[,2:1274],sum))
colnames(data_sum) <- "value"
data_sum$farmer <- rownames(data_sum)
data_sum <- data_sum[,c(2,1)]
farmer_min <- data_sum[data_sum$value %in% min(data_sum$value),]
farmer_max <- data_sum[data_sum$value %in% max(data_sum$value),]
farmer_min <- data_microfinance[,c("week",farmer_min$farmer)]
farmer_min$payment <- c(0,diff(farmer_min$farmer_no_403))
brks <- farmer_min$week[seq(1, length(farmer_min$week), 1)]
lbls <- tsibble::yearweek(farmer_min$week)
ggplot(farmer_min, aes(week, payment)) +
geom_area() +
scale_x_date(breaks=brks, labels=lbls) +
theme(axis.text.x = element_text(angle=90)) +
labs(title="Area Chart",
subtitle = "First difference in payment",
y="Payment",
caption="Source: Microdinance Loan")
farmer_max <- data_microfinance[,c("week",farmer_max$farmer)]
farmer_max$payment <- c(0,diff(farmer_max$farmer_no_440))
brks <- farmer_max$week[seq(1, length(farmer_max$week), 1)]
lbls <- tsibble::yearweek(farmer_max$week)
ggplot(farmer_max, aes(week, payment)) +
geom_area() +
scale_x_date(breaks=brks, labels=lbls) +
theme(axis.text.x = element_text(angle=90)) +
labs(title="Area Chart",
subtitle = "First difference in payment",
y="Payment",
caption="Source: Microdinance Loan")
data_microfinance_fts <- rainbow::fts(x = data_microfinance$week, y = as.matrix(data_microfinance[,-1]))
data_microfinance_fts <- sfts(ts(as.numeric(data_microfinance_fts$y),
frequency = 52),
xname = "Week",
yname = "Microfinance Loan")
Estimate FTSM - classical
T_stationary(sample = data_microfinance_fts$y)
#>
#> Monte Carlo test of stationarity of a functional time series
#>
#> null hypothesis: the series is stationary
#>
#> p-value = 0.027
#> N (number of functions) = 1273
#> number of MC replications = 1000
Estimate FTSM - classical
data_microfinance_fts_classical <- ftsm(y = data_microfinance_fts,
order = 6,
method = "classical",
weight = FALSE)
summary(data_microfinance_fts_classical)
#> Functional time series model
#>
#> Call: ftsm(y = data_microfinance_fts, order = 6, method = "classical", weight = FALSE)
#>
#> Main effects: Mean
#> Order of interaction: 6
#> y: Microfinance Loan
#> x: Week
#>
#> Averages across x:
#> ME MSE MPE MAPE
#> -3.361000e-02 2.471314e+08 Inf Inf
#>
#> Averages across time:
#> IE ISE IPE IAPE
#> -1.718580e+00 1.167597e+10 3.794169e+01 6.135335e+01
plot(residuals(data_microfinance_fts_classical),
type = "fts",
xlab = "Week",
ylab = "Microfinance Loan")
Estimate FTSM - M
data_microfinance_fts_m <- ftsm(y = data_microfinance_fts,
order = 6,
method = "M",
weight = FALSE)
summary(data_microfinance_fts_m)
#> Functional time series model
#>
#> Call: ftsm(y = data_microfinance_fts, order = 6, method = "M", weight = FALSE)
#>
#> Main effects: Mean
#> Order of interaction: 6
#> y: Microfinance Loan
#> x: Week
#>
#> Averages across x:
#> ME MSE MPE MAPE
#> -8.280371e+01 3.032129e+08 Inf Inf
#>
#> Averages across time:
#> IE ISE IPE IAPE
#> -4.726036e+03 1.432469e+10 3.050039e+01 4.884808e+01
plot(residuals(data_microfinance_fts_m),
type = "fts",
xlab = "Week",
ylab = "Microfinance Loan")
Estimate FTSM - rapca
data_microfinance_fts_rapca <- ftsm(y = data_microfinance_fts,
order = 6,
method = "rapca",
weight = FALSE)
summary(data_microfinance_fts_rapca)
#> Functional time series model
#>
#> Call: ftsm(y = data_microfinance_fts, order = 6, method = "rapca", weight = FALSE)
#>
#> Main effects: Mean
#> Order of interaction: 6
#> y: Microfinance Loan
#> x: Week
#>
#> Averages across x:
#> ME MSE MPE MAPE
#> -6.088056e+01 3.568711e+08 Inf Inf
#>
#> Averages across time:
#> IE ISE IPE IAPE
#> -3.662121e+03 1.649619e+10 3.725205e+01 5.924189e+01
plot(residuals(data_microfinance_fts_rapca),
type = "fts",
xlab = "Week",
ylab = "Microfinance Loan")
