Herramientas/Código R para crear gráficos de ganancia/pérdida-asimetría

Question

El asimetría de ganancia/pérdida es un hecho estilizado bien conocido: básicamente afirma que las series temporales financieras reales tardan más en subir que en bajar.

Para detectarlo se necesita una pesada maquinaria estadística: Desfilar la serie temporal, calcular la estadística inversa, normalizar la distribución, ajustar una distribución Gamma Generalizada... por nombrar algunas.

El resultado son gráficos como estos (de http://papers.ssrn.com/sol3/papers.cfm?abstract_id=844364 ):

Mi pregunta
Quiero reproducir esos gráficos. ¿Conoces algún software, herramienta y/o preferiblemente código/paquete de R con el que se pueda hacer esto? Cualquier pequeña pista puede ser útil - Gracias.

Answer 1

Escribí una función de R para crear esos gráficos:

library(quantmod)

getSymbols("^GSPC", from = "1950-01-01")
## [1] "GSPC"

inv_stat <- function(symbol, name, target = 0.05) {
  p <- coredata(Cl(symbol))
  end <- length(p)
  days_n <- days_p <- integer(end)

  # go through all days and look when target is reached the first time from there
  for (d in 1:end) {
    ret <- cumsum(as.numeric(na.omit(ROC(p[d:end]))))
    cond_n <- ret < -target
    cond_p <- ret > target
    suppressWarnings(days_n[d] <- min(which(cond_n)))
    suppressWarnings(days_p[d] <- min(which(cond_p)))
  }

  days_n_norm <- prop.table(as.integer(table(days_n, exclude = "Inf")))
  days_p_norm <- prop.table(as.integer(table(days_p, exclude = "Inf")))

  plot(days_n_norm, log = "x", xlim = c(1, 1000), main = paste0(name, " gain-/loss-asymmetry with target ", target), xlab = "days", ylab = "density", col = "red")
  points(days_p_norm, col = "blue")

  c(which.max(days_n_norm), which.max(days_p_norm))
}

inv_stat(GSPC, name = "S&P 500")
 ## [1] 10 24

Se está elaborando la siguiente trama (llevará algún tiempo):

Faltan dos cosas:

• Desviación de las series temporales
• Distribución de probabilidad ajustada

Si quieres añadirlas o si tienes ideas para mejorar el código, ¡házmelo saber!

Answer 2

He aquí un ejemplo rápido: se toman los rendimientos totales para cada período de tenencia, se los promedia y se comparan los días para cada nivel de rendimiento.

Puede cambiar tmp1 por el conjunto de datos filtrados que prefiera.

 require(PerformanceAnalytics)

require(sqldf)
data(edhec)

tmp1=edhec[,1]

period_seq = 1:nrow(tmp1)
combos=expand.grid(period_seq,period_seq)
###Remove impossible investments
combos=combos[combos[,2]>combos[,1],]
colnames(combos) = c('start','finish')
combos$day_length = combos[,2]-combos[,1]
###Calculater return for each period
combos$perreturn=NA

###Calculate return for each combo

for(i in 1:nrow(combos)){
  combos[i,]$perreturn = as.numeric(last(cumprod(1+(tmp1[combos[i,1]:combos[i,2]])))-1)

}

###Round the total return
combos$roundedperreturn = round(combos$perreturn,2)
###Calulate the avg day length per return level
ans=sqldf('select avg(day_length) as avg_day_length,roundedperreturn as return_level from combos group by 2')

##Plot it
plot(ans$avg_day_length,ans$return_level,main="Holding period per level of return",xlab="periods",ylab='Return level')

##look only at levels that have a + and -
up_side=ans[ans$return_level<=abs(min(ans$return_level))&ans$return_level>0,]
down_side = ans[ans$return_level<=abs(min(ans$return_level))&ans$return_level<0,]
down_side$return_level = abs(down_side$return_level)
plot(up_side,col="blue",type='b',main='Comparison of days required to return a return level')
points(x = down_side$avg_day_length,y=down_side$return_level,col="red",type='b')

###Constant level of return plot

time_distribution_for_level=combos[combos$roundedperreturn==0.05,]
time_distribution_for_level_down=combos[combos$roundedperreturn==-0.05,]

up_five_pct_plot=table(time_distribution_for_level$day_length)/sum(time_distribution_for_level$day_length)
up_five_pct_plot = data.frame(density=as.numeric(up_five_pct_plot),periods=as.integer(names(up_five_pct_plot)))
down_five_pct_plot=table(time_distribution_for_level_down$day_length)/sum(time_distribution_for_level_down$day_length)
down_five_pct_plot = data.frame(density=as.numeric(down_five_pct_plot),periods=as.integer(names(down_five_pct_plot)))
plot(x=up_five_pct_plot$periods,y=up_five_pct_plot$density,type='b',col='blue',main='Density plot of time required for a five percent return (loss in red)',xlab='periods',ylab='density')
points(x=down_five_pct_plot$periods,y=down_five_pct_plot$density,type='b',col='red')

La imagen es diferente, probablemente debido a mi uso de datos de muestra mensuales.