Absolute currency exchange rate

abs_curr.R

currs <- c(
    'usd',
    'eur',
    'chf',
    'gbp',
    'cad'
)

pairs <- c(
    'eurusd',
    'gbpusd',
    'eurchf',
    'eurgbp',
    'gbpchf',
    'usdchf',
    'cadchf',
    'gbpcad',
    'usdcad',
    'eurcad'
)


## download and bind historic rates for pairs --------------

hist_day_length <- 180L

day_seq <- seq.Date(
    from = as.Date(Sys.Date() - hist_day_length)
    , to = as.Date(Sys.Date() - 1L)
    , by = 1
)

rate.env <- new.env()

for(x in pairs){
    quantmod::getFX(
        toupper(
            paste0(substr(x, start=1, stop=3)
                   , '/'
                   , substr(x, start=4, stop=6)
            )
        )
        , from = day_seq[1]
        , to = day_seq[length(day_seq)]
        , env = rate.env
    )
}

obs_rates = as.data.frame(as.list(rate.env))

currency_names = toupper(currs)
loss = function(matr, rates, alfa = 0){
    # restore matrix
    matr = matrix(matr, nrow = nrow(rates))
    colnames(matr) = currency_names
    delta_squares = numeric(nrow(matr))
    for(each in names(rates)){
        first = substr(each, 1, 3)
        second = substr(each, 5, 7)
        delta_squares = delta_squares + (rates[[each]] - matr[,first]/matr[,second])^2
    }
    # последняя компонента - фиксация курса доллара в первый момент времени - потом я от этой идеи отказался
    # делим, чтобы была MSE
    # (sum(delta_squares) + sum(alfa*matr^2) + (1- matr[1,1])^2)/length(matr) 
    # теперь идея, чтобы среднее значение абсолютных курсов за все время было близко к единице
    # (sum(delta_squares) + sum(alfa*matr^2) + (1- mean(matr))^2)/length(matr)
    # среднее в каждый момент времени было близко единице
    (sum(delta_squares) + alfa*sum(matr^2) + sum((1- rowMeans(matr))^2))/length(matr)
}

set.seed(1)
initial = matrix(
    runif(nrow(obs_rates)*length(currs), 0.5, 1.5), 
    nrow = nrow(obs_rates),
    ncol = length(currs)
)
res = optim(initial, loss, 
            rate = obs_rates, 
            alfa = 0, 
            method = "BFGS",
            control = list(trace = 1, maxit = 10000)
            )
res$value # MSE результата
res$convergence # 0 если оптимизация сошлась
res_df = as.data.frame(matrix(res$par, nrow = nrow(obs_rates)))
colnames(res_df) = currency_names
# оценка средней абсолютной погрешности
for(each in names(obs_rates)){
    first = substr(each, 1, 3)
    second = substr(each, 5, 7)
    cat(each, ":", mean(abs(obs_rates[[each]] - res_df[[first]]/res_df[[second]])), "\n")
}
head(res_df)
# для графика
res_long = stack(res_df)
res_long$period = rownames(obs_rates)
library(ggplot2)
ggplot(res_long) +
    facet_wrap(~ind, 
               nrow = length(currency_names),
               scales = 'free') +
    geom_line(aes(x = as.numeric(as.factor(period)), y = values))