Meu teste numérico da hipótese de Taxas Absolutas

Olá Habr!

Esta publicação me pareceu interessante: obtemos taxas de câmbio absolutas a partir de taxas de câmbio cruzadas e eu queria testar a capacidade de encontrar essa taxa de câmbio absoluta por meio de modelagem numérica, geralmente abandonando a álgebra linear.



Os resultados foram interessantes.

O experimento será pequeno: 4 moedas, 6 pares de moedas. Para cada par, uma medição de curso.

Então vamos começar


A hipótese é que o valor de qualquer moeda pode ser expresso como um valor que levará em conta o valor de outras moedas nas quais é cotado, enquanto outras moedas serão expressas no valor de todas as outras moedas. Esta é uma tarefa recursiva interessante.

Existem 4 moedas:

  • usd
  • eur
  • chf
  • gbp

Para eles, os pares de moedas foram discados:

  • eurusd
  • gbpusd
  • eurchf
  • eurgbp
  • gbpchf
  • usdchf

Observe que, se o número de moedas for n = 4, o número de pares será k = (n ^ 2 - n) / 2 = 6. Não faz sentido procurar usdeur se eurusd for citado ...

No momento t, a taxa de câmbio de um dos provedores foi medida:



Os cálculos serão realizados para esses valores.

Matemática


Eu resolvo o problema tomando analiticamente o gradiente da função de perda, que é essencialmente um sistema de equações.

O código da experiência estará em R:

#set.seed(111) usd <- runif(1) eur <- runif(1) chf <- runif(1) gbp <- runif(1) # snapshot of values at time t eurusd <- 1.12012 gbpusd <- 1.30890 eurchf <- 1.14135 eurgbp <- 0.85570 gbpchf <- 1.33373 usdchf <- 1.01896 ## symbolic task ------------ express <- expression( (eurusd - eur / usd) ^ 2 + (gbpusd - gbp / usd) ^ 2 + (eurchf - eur / chf) ^ 2 + (eurgbp - eur / gbp) ^ 2 + (gbpchf - gbp / chf) ^ 2 + (usdchf - usd / chf) ^ 2 ) eval(express) x = 'usd' D(express, x) eval(D(express, x)) 

R permite usar stats :: D para obter uma derivada de uma função. Por exemplo, se queremos diferenciar pela moeda USD, obtemos a expressão:
2 * (eur / usd ^ 2 * (eurusd - eur / usd)) + 2 * (gbp / usd ^ 2 * (gbpusd -
gbp / usd)) - 2 * (1 / chf * (usdchf - usd / chf))
Para reduzir o valor da função express, realizaremos a descida do gradiente e fica imediatamente claro (vemos diferenças quadradas) que o valor mínimo será zero, que é o que precisamos.

 -deriv_vals * lr 

O passo de descida do gradiente será controlado pelo parâmetro lr e tudo isso é tomado com um sinal negativo.

Ou seja, em palavras humanas, selecionamos as taxas de 4 moedas para que todos os pares de moedas no experimento recebam valores iguais aos valores iniciais desses pares. Mmm, vamos resolver o quebra-cabeça - na testa!

Resultados


Para não esticar, informarei imediatamente o seguinte: o experimento como um todo foi bem-sucedido, o código funcionou, o erro foi próximo, próximo de zero. Mas então eu notei que os resultados são sempre diferentes.

Uma pergunta para os conhecedores: parece que esta tarefa tem um número ilimitado de soluções, mas nisto sou um zero completo, acho que eles me dirão nos comentários.

Para verificar a (des) estabilidade da solução, simulei 1000 vezes sem fixar a semente PRNG para os valores iniciais dos valores da moeda.

E aqui vem a imagem do kata: o erro chega a 0,00001 e menos (a otimização é definida dessa maneira) sempre, enquanto os valores das moedas flutuam no diabo, sabe onde. Acontece que sempre há uma decisão diferente, senhores!

Mais uma vez, esta imagem, eixo y nas unidades originais (não registradas):



Para que você possa repetir isso, abaixo estou anexando o código completo.

Código
 # clear environment rm(list = ls()); gc() ## load libs library(data.table) library(ggplot2) library(magrittr) ## set WD -------------------------------- # your dir here ... ## set vars ------------- currs <- c( 'usd', 'eur', 'chf', 'gbp' ) ############ ## RUN SIMULATION LOOP ------------------------------- simuls <- 1000L simul_dt <- data.table() for( s in seq_len(simuls) ) { #set.seed(111) usd <- runif(1) eur <- runif(1) chf <- runif(1) gbp <- runif(1) # snapshot of values at time t eurusd <- 1.12012 gbpusd <- 1.30890 eurchf <- 1.14135 eurgbp <- 0.85570 gbpchf <- 1.33373 usdchf <- 1.01896 ## symbolic task ------------ express <- expression( (eurusd - eur / usd) ^ 2 + (gbpusd - gbp / usd) ^ 2 + (eurchf - eur / chf) ^ 2 + (eurgbp - eur / gbp) ^ 2 + (gbpchf - gbp / chf) ^ 2 + (usdchf - usd / chf) ^ 2 ) ## define gradient and iterate to make descent to zero -------------- iter_max <- 1e+3 lr <- 1e-3 min_tolerance <- 0.00001 rm(grad_desc_func) grad_desc_func <- function( lr, curr_list ) { derivs <- character(length(curr_list)) deriv_vals <- numeric(length(curr_list)) grads <- numeric(length(curr_list)) # symbolic derivatives derivs <- sapply( curr_list, function(x){ D(express, x) } ) # derivative values deriv_vals <- sapply( derivs, function(x){ eval(x) } ) # gradient change values -deriv_vals * lr } ## get gradient values ---------- progress_list <- list() for( i in seq_len(iter_max) ) { grad_deltas <- grad_desc_func(lr, curr_list = currs) currency_vals <- sapply( currs , function(x) { # update currency values current_val <- get(x, envir = .GlobalEnv) new_delta <- grad_deltas[x] if(new_delta > -1 & new_delta < 1) { new_delta = new_delta } else { new_delta = sign(new_delta) } new_val <- current_val + new_delta if(new_val > 0 & new_val < 2) { new_val = new_val } else { new_val = current_val } names(new_val) <- NULL # change values of currencies by gradient descent step in global env assign(x, new_val , envir = .GlobalEnv) # save history of values for later plotting new_val } ) progress_list[[i]] <- c( currency_vals, eval(express) ) if( eval(express) < min_tolerance ) { break('solution was found') } } ## check results ---------- # print( # paste0( # 'Final error: ' # , round(eval(express), 5) # ) # ) # # print( # round(unlist(mget(currs)), 5) # ) progress_dt <- rbindlist( lapply( progress_list , function(x) { as.data.frame(t(x)) } ) ) colnames(progress_dt)[length(colnames(progress_dt))] <- 'error' progress_dt[, steps := 1:nrow(progress_dt)] progress_dt_melt <- melt( progress_dt , id.vars = 'steps' , measure.vars = colnames(progress_dt)[colnames(progress_dt) != 'steps'] ) progress_dt_melt[, simul := s] simul_dt <- rbind( simul_dt , progress_dt_melt ) } ggplot(data = simul_dt) + facet_wrap(~ variable, scales = 'free') + geom_line( aes( x = steps , y = value , group = simul , color = simul ) ) + scale_y_log10() + theme_minimal() 


O código para 1000 simulações funciona por cerca de um minuto.

Conclusão


Aqui está o que ainda não está claro para mim:

  • É possível estabilizar a solução de uma maneira matemática complicada;
  • se haverá uma convergência com mais moedas e pares de moedas;
  • se não houver estabilidade, para cada novo instantâneo de dados, nossas moedas seguirão como desejarem, se você não corrigir a semente PRNG, e isso é uma falha.

A idéia toda parece muito vaga na ausência de quaisquer pré-requisitos e limitações inteligíveis. Mas foi interessante!

Bem, eu também queria dizer que você pode ficar sem o OLS quando os dados são complicados, as matrizes são singulares, bem, ou quando a teoria é pouco conhecida (ehh ...).

Obrigado eavprog pela mensagem inicial.

Tchau!

Source: https://habr.com/ru/post/pt450874/


All Articles