Segunda Calificada: InflaxRX N.V

InflaRX (IFRX N.V)

En la presente trabajo se desarrollará la segunda practica del curso de Analisis de Gestion de Riesgos, en la cual se tomara los precios de la cotizacion de la empresa InflaRx en la bolsa NASDAQ.

Haremos una breve descripción de la empresa para contextalizarla. Además, asi podemos comprender mejor el porqué de las volatilidades.

InflaRX es una compañia biofarmacéutica que desarrolla nuevas terapias de primer nivel dirigido a la inflacion aguda y cronica. El enfoque que tiene principalmente es el desarrollo de anticuerpos monoclonales que se dirigen a los productos de activacion del sitema del conmplemento para su aplicación en enfermedades inflamatorias potencialmente mortales.

Fue fundada en diciembre $2007$ en Jena Alemania, un centro de ensayos clínicos de cuidados agudos reconocido internationalmente.

Con respecto al reporte del año $2019$ se tiene el resultado financiero neto disminuyó en $€ 4.2$ millones a $€ 3.5$ millones en $2019$, de $€ 7.7$ millones en $2018$. Este cambio se debió principalmente a menores ganancias cambiarias, que disminuyeron en $€ 4.8$ millones, parcialmente compensado por intereses sobre valores negociables, que aumentaron por $€ 0,6$ millones. La pérdida neta para el año $2019$ fue de $€ 53.3$ millones o $€ 2.05$ por acción común, en comparación con $€ 29.8$ millones o $€ 1.19$ por acción común para el año $2018$. Al 31 de diciembre de 2019, los fondos totales disponibles de la Compañía fueron de € 115.8 millones, principalmente compuesto de efectivo y equivalentes de efectivo $(€ 33,1 millones)$ y valores negociables $(€ 81,9 millones)$.

Con respecto al año 2020 esta compañia también esta haciendo investigaciones acerca del COVID 19, lo cual se vera reflejado en en mayor gastos de investigaciones en año 2020.

DESARROLLO

Se importa los datos de la serie de precios desde con fecha inicio $2019-01-01$ y fecha de ﬁn $2020-01-01$.

Primero importamos los datos pero ello se tiene que llamar algunos paquetes que se van a usar

library(pdfetch)
library(tidyverse)

## -- Attaching packages ----------------------------------- tidyverse 1.3.0 --

## v ggplot2 3.3.0     v purrr   0.3.4
## v tibble  3.0.1     v dplyr   0.8.5
## v tidyr   1.1.0     v stringr 1.4.0
## v readr   1.3.1     v forcats 0.5.0

## -- Conflicts -------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(graphics)

DATOS

Ahora si podemos hacer uso del paquete “pdfetch” para importar la variable.

IFRX.data<- pdfetch_YAHOO("IFRX", from = c("2019-01-01"), to = c("2020-01-01"),interval = "1d")

RESUMEN DE DATOS

Hacemos un resumen de los datos:

summary(IFRX.data)

##      Index              IFRX.open        IFRX.high         IFRX.low     
##  Min.   :2019-01-02   Min.   : 2.210   Min.   : 2.340   Min.   : 2.170  
##  1st Qu.:2019-04-02   1st Qu.: 2.860   1st Qu.: 2.900   1st Qu.: 2.725  
##  Median :2019-07-02   Median : 3.385   Median : 3.565   Median : 3.260  
##  Mean   :2019-07-02   Mean   :18.441   Mean   :19.050   Mean   :17.835  
##  3rd Qu.:2019-10-01   3rd Qu.:36.695   3rd Qu.:37.470   3rd Qu.:35.407  
##  Max.   :2019-12-31   Max.   :51.150   Max.   :53.100   Max.   :50.750  
##    IFRX.close     IFRX.adjclose     IFRX.volume      
##  Min.   : 2.200   Min.   : 2.200   Min.   :    7100  
##  1st Qu.: 2.817   1st Qu.: 2.817   1st Qu.:  161400  
##  Median : 3.390   Median : 3.390   Median :  295650  
##  Mean   :18.408   Mean   :18.408   Mean   :  759392  
##  3rd Qu.:36.517   3rd Qu.:36.517   3rd Qu.:  575700  
##  Max.   :51.610   Max.   :51.610   Max.   :34665400

En este resumen se puede observar al precio que abren, el mas alto, el mas bajo, cuando cierra el precio, el ajustado y el volumen.

Para calcular los retornos ya sea continuos o discretos, se tiene que seleccionar el precio de cierre ajustado que se encuentra en la columna 5, y lo pudimos ver con el comando head, y lo convertimos en series de tiempo.

head(IFRX.data)

##            IFRX.open IFRX.high IFRX.low IFRX.close IFRX.adjclose IFRX.volume
## 2019-01-02     36.10     36.54   33.160      34.90         34.90       49700
## 2019-01-03     33.98     34.90   32.860      33.60         33.60       11500
## 2019-01-04     33.55     37.06   33.420      35.85         35.85       12600
## 2019-01-07     36.65     36.65   33.735      35.95         35.95       22900
## 2019-01-08     36.83     36.83   33.265      35.50         35.50       10400
## 2019-01-09     36.15     36.15   33.250      34.54         34.54       68700

pIFRX<- IFRX.data[, 5]
tsIFRX <- ts(pIFRX, start = c(2019,1), frequency = 365)
summary(tsIFRX)

##  IFRX.adjclose   
##  Min.   : 2.200  
##  1st Qu.: 2.817  
##  Median : 3.390  
##  Mean   :18.408  
##  3rd Qu.:36.517  
##  Max.   :51.610

plot(tsIFRX)

En esta grafica se observa que los los datos de la series de IFRX son volaites a lo largo del tiempo en estudio, se podría decir que no es estacionaria la serie porque se puede observar como va variando y en segundo para trimestre disminuyo bruscamente.

Retorno Discreto:

$r_t=(P_t−P_t−1)/P_t−1$

tamano.precios <- length(pIFRX)
R1D <- numeric(length = tamano.precios)
for (i in 2:tamano.precios) {
  R1D[i] <- (tsIFRX[i]/tsIFRX[i - 1]) - 1
}

summary(R1D)

##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -0.917941 -0.023759 -0.003301 -0.001596  0.021075  0.182073

plot(R1D)

Retorno Continuo:

El rendimiento continuo se calcula de la siguiente forma:

$R_t=ln(P_t/P_t−1)$

Aplicando la propiedad de logaritmos la ecuación quedaría:

$R_t=ln(P_t)−ln(P_t−1)$

R1C <- diff(log(tsIFRX))
R1C <- na.omit(R1C)

summary(R1C)

##  IFRX.adjclose      
##  Min.   :-2.500310  
##  1st Qu.:-0.024091  
##  Median :-0.003442  
##  Mean   :-0.008670  
##  3rd Qu.: 0.020951  
##  Max.   : 0.167269

plot(R1C)

La diferencia es utilizada en este caso para transformar los datos y para trabajar con los redimientos.

Luego de realizar las diferencias tanto discretas como continuas, se puede observar en el grafico que de la diferncia continua, que los rendimientos de IFRX son volatiles, pero se presenta mayor volatilidad en el tercer trimestre del 2019, posiblemente esto se deba a que las acciones de InflaRx IFRX, $+ 7.04\%$ cayeron un $84\%$ en el comercio previo al mercado después de que la biotecnología dijo que su medicamento para un trastorno inflamatorio de la piel llamado hidradenitis supurativa no mostró una respuesta estadísticamente significativa en los pacientes que recibieron el tratamiento en comparación con los que recibieron placebo.

ANALISIS DESCRIPTIVO

media <- mean(R1C)
varianza <- var(R1C)
desviacion.estandar <- sd(R1C)

Analisis<-data_frame(media,varianza,desviacion.estandar)

## Warning: `data_frame()` is deprecated as of tibble 1.1.0.
## Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.

Media= $-0.00867029$ Varianza= $0.0264$ Desviasión Estandar= $0.162619$

Podemos observar que la media de los retornos continuos es negativa y muy baja, con ello se puede decir que predominan los retonos muy cercanos a cero o negativos. Ademas, se puede decir que dabo a que la varianza es muy baja 0.0026 los valores(retornos continuos) se ecuentran muy cercanos a la media y no existe tanta dispersión de la muestra a los extremos. La desviación estándar, que es la raiz cuadrada de la varianza esta es 0.162619 lo cual representa una desviasión casi nula, cercana a cero.

Var Montecarlo con simulaciones movimiento geometrico browniano

Ahora para aplicar el metodo de Var Montercalo,primero haremos el proceso browniano geometrico para $10,000$ simulaciones, es más efectivo porque se modela a partir del precio inicial, ademas este incluye el factor estocastico, para realizar este se utiliza la media y desviacion estandar del modelo.

Posterior que se incorpora lo generado del proceso browniano en el VAR, luego para interpretar los datos se debe de transformar en discretos.

Todo ello se va realizar para cada nivel de confianza, se graficara las distribuciones obtenidas, se calculara la media, desviacion estandar y los intervalos de confianza para los percentiles $0.025%$ y $0.975%$

Movimiento Browniano Geométrico en R

El Movimiento Browniano Geométrico (GBM) es un caso particular del proceso Ito. EL GBM se define de la siguiente manera:

$S_t=S_0$$e^(μ−0.5σ2)Δt+σΔt√ϵ^)$ , $ϵ∼N(0,1)$

Al definir el GBM en términos sencillos se obtiene:

$ΔS= μSΔt+σSΔz$

Este proceso se denomina geomentrico porque los terminos de tendencia como de volatilidad son proporcionales al valor del mercado $S$ que es valor actual, ello se puede ver en las acciones que son actvos de renta variable, donde se puede observar que las tasas de rendimiento tinen tendencias a ser “más” estacionarias con respecto de las ganancias en terminos monetarios $ΔS$.

En este caso se tomara en cuenta lo siguiente: —$10,000$ simulaciones —Unidades temporales seran $365$ días —El precio inicial sera tomado de nuestra serie temporal —La desviación estándar y la media de nuetsra data serán empleadas para dichas simulaciones

VAR(VALUE AT RISK)- VAR MONTE CARLO

El VAR es una tecnica estadistica para medir el terminos sencillos la probabilidad de sufrir una pérdida monetaria dado niveles de significancias. En este caso se tomaran los siguientes niveles de significancias: $α_1=0.01, α_2=0.05$ $y$ $α_3=0$

Por otro lado, el VaR Montercarlo es un método para estimar el VaR y este utilizá un software informático para generar miles de posibles resultados según datos iniciales introducidos y en este caso utilizará una simulacón que sigue un Movimiento Geometrico

Var Montecarlo al 99% del nivel de confianza

set.seed(1000)

t<-365
tseq <- 1:t
dt <- 1/t
mu<-media
d.e<-desviacion.estandar
P0<-34.90
nsimulaciones<-10000
mgb <- matrix(ncol = nsimulaciones, nrow = t)
for (i in 1:nsimulaciones) {
  mgb[1,i] <- P0
  for (h in 2:t) {
    e <- rnorm(1)
    mgb[h, i]<- mgb[(h-1),i]*exp((mu-(d.e^2)/2)*dt+d.e*e*sqrt(dt))  
  }
}

Procemos a graficar

gbm_df <- as.data.frame(mgb) %>%
  mutate(ix = 1:nrow(mgb)) %>%
  pivot_longer(-ix, names_to = 'simulaciones', values_to = 'Precio')

gbm_df %>%
  ggplot(aes(x=ix, y=Precio, color=simulaciones)) +
  geom_line() +
  theme(legend.position = 'none')

m2<-t(mgb)
plot(tseq, m2[1, ],xlab = "Tiempo", ylab = "Precio", type = "l",ylim = c(min(m2[1, ])/1.1,max(m2[1, ])*1.1))
apply(m2[2:nsimulaciones, ],MARGIN =  1, function(x, r){
  lines(tseq, x)
})

## NULL

Ahora realizaremos el VaR Montecarlo

niveldeconfianza <- c(0.01, 0.05, 0.1)

set.seed(2106)

VAR.99 <- numeric(length=nsimulaciones)
for (i in 1:nsimulaciones) {
  vec<-mgb[,i]
  sim.R <- diff(log(vec))
  sim.q <- quantile(sim.R, 0.01, na.rm = TRUE)
  sim.VAR <- exp(sim.q)-1
  VAR.99[i] <- sim.VAR
}
  

mean(VAR.99)

## [1] -0.01918788

sd(VAR.99)

## [1] 0.001497608

#Valores discretos

mean.monet.99<-c(mean(VAR.99)*100000)
sd.monet.99<-c(sd(VAR.99)*100000)

mean.monet.99

## [1] -1918.788

sd.monet.99

## [1] 149.7608

plot(density(VAR.99))

q.1.025<-quantile(VAR.99,0.025)
q.1.975<-quantile(VAR.99,0.975)

quantile.1.025<- c(q.1.025*100000)
quantile.1.97.5<- c(q.1.975*100000)

quantile.1.97.5

##     97.5% 
## -1645.035

quantile.1.025

##      2.5% 
## -2233.072

De los valores obtenidos se puede decir lo siguiente: la maxima perdida media esperada a un nivel de confianza del $90\%$ es de $\$1,918.788$, estos valores estan en terminos monetarios porque se mutiplicaron por $\$100,000$ de la cartera. Con respecto a la desviasión estandar se puede decir lo siguiente, este también se calculo multplicando la sd por $\$100,000$ de la cartera y nos dio $\$149.7608$ esto quiere decir que a dicho valor se desviará de la media. Ahora analizando los cuantiles $0.025$ y $0.975$ podemos decir que la maxima perdida se encontratria entre estos valores $\$1,645.035$ y $\$2,233.072$

Var Montecarlo al 95% del nivel de confianza

set.seed(1000)

t1<-365
tseq1 <- 1:t1
dt1 <- 1/t1
mu1<-media
d.e1<-desviacion.estandar
P01<-34.90
nsimulaciones1<-10000
mgb1 <- matrix(ncol = nsimulaciones1, nrow = t1)
for (i in 1:nsimulaciones1) {
  mgb1[1,i] <- P01
  for (h in 2:t1) {
    e1 <- rnorm(1)
    mgb1[h, i]<- mgb1[(h-1),i]*exp((mu1-(d.e1^2)/2)*dt1+d.e1*e1*sqrt(dt1))  
  }
}

gbm_df1 <- as.data.frame(mgb1) %>%
  mutate(ix = 1:nrow(mgb1)) %>%
  pivot_longer(-ix, names_to = 'simulaciones', values_to = 'Precio')

gbm_df1 %>%
  ggplot(aes(x=ix, y=Precio, color=simulaciones)) +
  geom_line() +
  theme(legend.position = 'none')

m3<-t(mgb1)
plot(tseq1, m3[1, ],xlab = "Tiempo", ylab = "Precio", type = "l",ylim = c(min(m3[1, ])/1.1,max(m3[1, ])*1.1))
apply(m3[2:nsimulaciones1, ],MARGIN =  1, function(x, r){
  lines(tseq1, x)
})

## NULL

#VAR

set.seed(2106)

VAR.95 <- numeric(length=nsimulaciones1)
for (i in 1:nsimulaciones1) {
  vec1<-mgb1[,i]
  sim.R1 <- diff(log(vec1))
  sim.q1<- quantile(sim.R1, 0.05, na.rm = TRUE)
  sim.VAR1 <- exp(sim.q1)-1
  VAR.95[i] <- sim.VAR1
}

#Valores  Discretos

mean(VAR.95)

## [1] -0.01382864

sd(VAR.95)

## [1] 0.0009143399

mean.monet.95<-c(mean(VAR.95)*100000)
sd.monet.95<-c(sd(VAR.95)*100000)

mean.monet.95

## [1] -1382.864

sd.monet.95

## [1] 91.43399

plot(density(VAR.95))

q.2.025<-quantile(VAR.95,0.025)
q.2.975<-quantile(VAR.95,0.975)

quantile.2.025<- c(q.2.025*100000)
quantile.2.97.5<- c(q.2.975*100000)

quantile.2.97.5

##     97.5% 
## -1208.424

quantile.2.025

##      2.5% 
## -1568.504

De los valores obtenidos se puede decir lo siguiente: la maxima perdida media esperada a un nivel de confianza del $99\%$ es de $\$1,383$, estos valores estan en terminos monetarios porque se mutiplicaron por $\$100,000$ de la cartera. Con respecto a la desviasión estandar se puede decir lo siguiente, este también se calculo multplicando la sd por $\$100,000$ de la cartera y nos dio $\$91.43399$ esto quiere decir que a dicho valor se desviará de la media. Ahora analizando los cuantiles $0.025$ y $0.975$ podemos decir que la maxima perdida se encontratria entre estos valores $\$1208.424$ y $\$1,568.504$

Var Montecarlo al 90% del nivel de confianza

set.seed(1000)

t2<-365
tseq2 <- 1:t2
dt2 <- 1/t2
mu2<-media
d.e2<-desviacion.estandar
P02<-34.90
nsimulaciones2<-10000
mgb2 <- matrix(ncol = nsimulaciones2, nrow = t2)
for (i in 1:nsimulaciones2) {
  mgb2[1,i] <- P02
  for (h in 2:t2) {
    e2 <- rnorm(1)
    mgb2[h, i]<- mgb2[(h-1),i]*exp((mu2-(d.e2^2)/2)*dt+d.e2*e2*sqrt(dt2))  
  }
}

gbm_df2 <- as.data.frame(mgb2) %>%
  mutate(ix = 1:nrow(mgb2)) %>%
  pivot_longer(-ix, names_to = 'simulaciones', values_to = 'Precio')

gbm_df2 %>%
  ggplot(aes(x=ix, y=Precio, color=simulaciones)) +
  geom_line() +
  theme(legend.position = 'none')

m4<-t(mgb2)
plot(tseq2, m4[1, ],xlab = "Tiempo", ylab = "Precio", type = "l",ylim = c(min(m4[1, ])/1.1,max(m4[1, ])*1.1))
apply(m4[2:nsimulaciones2, ],MARGIN =  1, function(x, r){
  lines(tseq2, x)
})

## NULL

set.seed(2106)
VAR.90 <- numeric(length=nsimulaciones2)
for (i in 1:nsimulaciones2) {
  vec2<-mgb2[,i]
  sim.R <- diff(log(vec2))
  sim.q <- quantile(sim.R, 0.10, na.rm = TRUE)
  sim.VAR <- exp(sim.q)-1
  VAR.90[i] <- sim.VAR
}

#Valores  Discretos

mean(VAR.90)

## [1] -0.01084227

sd(VAR.90)

## [1] 0.0007571635

mean.monet.90<-c(mean(VAR.90)*100000)
sd.monet.90<-c(sd(VAR.90)*100000)

mean.monet.90

## [1] -1084.227

sd.monet.90

## [1] 75.71635

plot(density(VAR.90))

q.3.025<-quantile(VAR.90,0.025)
q.3.975<-quantile(VAR.90,0.975)

quantile.3.025<- c(q.3.025*100000)
quantile.3.97.5<- c(q.3.975*100000)

quantile.3.97.5

##     97.5% 
## -936.9552

quantile.3.025

##      2.5% 
## -1234.141

De los valores obtenidos se puede decir lo siguiente: la maxima perdida media esperada a un nivel de confianza del $90\%$ es de $\$1,084$, estos valores estan en terminos monetarios porque se mutiplicaron por $\$100,000$ de la cartera. Con respecto a la desviasión estandar se puede decir lo siguiente, este también se calculo multplicando la sd por $\$100,000$ de la cartera y nos dio $\$75.71635$ esto quiere decir que a dicho valor se desviará de la media. Ahora analizando los cuantiles $0.025$ y $0.975$ podemos decir que la maxima perdida se encontratria entre estos valores $\$936.9552$ y $\$1,234.141$