Estadísticas del sector agropecuario del departamento de Sucre en el año 2015 para un total de 27 diferentes productos agricolas

a. Lea la base de datos y cambie los nombres de las variables con nombres más simples de manejar.

library(readxl)
BD <- read_excel("BASE_DATOS.xlsx")

Para cambiar los nombres de la base de datos lo podemos hacer de la siguiente manera:

names(BD)
## [1] "CULTIVOS"                  "SUPERFICIE, HAS SEMBRADA" 
## [3] "SUPERFICIE, HAS COSECHADA" "PRODUCCION TON"           
## [5] "PRECIO AL PRODUCTOR $/KG"  "COSTO DE PRODUCCION HA"   
## [7] "INGRESO BRUTO PRODUCCION"  "COSTO TOTAL PRODUCCION"
BD <- BD %>% rename(SUP_SEM=`SUPERFICIE, HAS SEMBRADA`,
                    SUP_COS=`SUPERFICIE, HAS COSECHADA`,
                    PROD_TON=`PRODUCCION TON`,
                    PRE_PRODUC=`PRECIO AL PRODUCTOR $/KG`,
                    COST_PROD=`COSTO DE PRODUCCION HA`,
                    INGR_PROD=`INGRESO BRUTO PRODUCCION`,
                    COST_TOTAL=`COSTO TOTAL PRODUCCION`)
names(BD)
## [1] "CULTIVOS"   "SUP_SEM"    "SUP_COS"    "PROD_TON"   "PRE_PRODUC"
## [6] "COST_PROD"  "INGR_PROD"  "COST_TOTAL"

b. Calcule e interprete los promedios de cada una de las variables

##      SUP_SEM      SUP_COS     PROD_TON   PRE_PRODUC    COST_PROD    INGR_PROD 
## 1.075637e+03 7.101907e+02 6.109169e+03 1.602782e+03 5.113609e+06 5.609295e+09 
##   COST_TOTAL 
## 2.360894e+09

c. Calcule e interprete las desviaciones estándar muestrales de cada una de las variables.

##      SUP_SEM      SUP_COS     PROD_TON   PRE_PRODUC    COST_PROD    INGR_PROD 
## 1.760419e+03 1.207101e+03 1.089280e+04 1.201474e+03 7.114924e+06 8.429286e+09 
##   COST_TOTAL 
## 3.803952e+09

d. Calcule e interprete cada una de las correlaciones entre las variables.

ggpairs(BD[-1])

e. Crear las variables:

  1. Rendimiento de la cosecha (TON/HA)

  2. Utilidad

  3. Rendimiento del negocio

BD <- BD %>% mutate(X_1=PROD_TON/SUP_COS,
                    X_2=INGR_PROD-COST_TOTAL,
                    X_3=(X_2/COST_TOTAL)*100)
resumen <- BD %>% select(X_1,X_2,X_3) %>% 
  summarise(X1_M=mean(X_1),
            X1_SD=sd(X_1),
            X2_M=mean(X_2),
            X2_SD=sd(X_2),
            X3_M=mean(X_3),
            X3_SD=sd(X_3))
resumen
  1. \(P(X_1\leq 9)\)
pnorm(9,resumen[['X1_M']],resumen[['X1_SD']])
## [1] 0.5125531
  1. \(P(9<X_1\leq10)\)
pnorm(10,resumen[['X1_M']],resumen[['X1_SD']])-pnorm(9,resumen[['X1_M']],resumen[['X1_SD']])
## [1] 0.04873654
  1. \(P(X_1>10)\)
pnorm(10,resumen[['X1_M']],resumen[['X1_SD']],lower.tail = FALSE)
## [1] 0.4387103
  1. \(P(\bar{X_1}\leq9)\)
pnorm((9-resumen[['X1_M']])*sqrt(27)/resumen[['X1_SD']])
## [1] 0.5649491
  1. \(P(9<\bar{X_1}\leq10)\)
pnorm((10-resumen[['X1_M']])*sqrt(27)/resumen[['X1_SD']])-pnorm((9-resumen[['X1_M']])*sqrt(27)/resumen[['X1_SD']])
## [1] 0.2236163
  1. \(P(\bar{X_1}>10)\)
pnorm((10-resumen[['X1_M']])*sqrt(27)/resumen[['X1_SD']],lower.tail = FALSE)
## [1] 0.2114346
  1. \(P(X_2> 7000000000)\)
pnorm( 7000000000,resumen[['X2_M']],resumen[['X2_SD']],lower.tail = FALSE)
## [1] 0.2515676
  1. \(P(6500000000\leq X_2\leq 7500000000)\)
pnorm(7500000000,resumen[['X2_M']],resumen[['X2_SD']])-pnorm(6500000000,resumen[['X2_M']],resumen[['X2_SD']])
## [1] 0.05686141
  1. \(P(\bar{X_2}> 7000000000)\)
pnorm((7000000000-resumen[['X2_M']])*sqrt(27)/resumen[['X2_SD']],lower.tail = FALSE)
## [1] 0.0002514926
  1. \(P(6500000000\leq \bar{X_2}\leq 7500000000)\)
pnorm((7500000000-resumen[['X2_M']])/resumen[['X2_SD']])-pnorm((6500000000-resumen[['X2_M']])/resumen[['X2_SD']])
## [1] 0.05686141
  1. \(P(X_3\leq180)\)
pnorm(180,resumen[['X3_M']],resumen[['X3_SD']])
## [1] 0.522569
  1. \(P(150\leq X_3\leq200)\)
pnorm(200,resumen[['X3_M']],resumen[['X3_SD']])-pnorm(150,resumen[['X3_M']],resumen[['X3_SD']])
## [1] 0.0882788
  1. \(P(\bar{X_3}\leq180)\)
pnorm((180-resumen[['X3_M']])*sqrt(27)/resumen[['X3_SD']])
## [1] 0.6156649
  1. \(P(150\leq \bar{X_3}\leq 200)\)
pnorm((200-resumen[['X3_M']])*sqrt(27)/resumen[['X3_SD']])-pnorm((150-resumen[['X3_M']])*sqrt(27)/resumen[['X3_SD']])
## [1] 0.4294891

g. Calcule e interprete las correlaciones entre las variables \(X_1,X_2 y X_3\).

ggpairs(BD %>% select(X_1,X_2,X_3))

2. Considere la base de datos relacionada con los precios de cierre (Close) de la acción de Almacenes Exito en la bolsa de valores de Colombia desde enero 1 del 2018 hasta enero 1 del 2023

carga de datos

library(readr)
## Warning: package 'readr' was built under R version 4.2.2
DT <- read_csv("EXITO.CL.csv")
## Rows: 260 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (6): Open, High, Low, Close, Adj Close, Volume
## date (1): Date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
str(DT)
## spc_tbl_ [260 × 7] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Date     : Date[1:260], format: "2022-04-04" "2022-04-05" ...
##  $ Open     : chr [1:260] "5640.000000" "5510.000000" "5510.000000" "5580.000000" ...
##  $ High     : chr [1:260] "5640.000000" "5510.000000" "5510.000000" "5580.000000" ...
##  $ Low      : chr [1:260] "5640.000000" "5433.333496" "5510.000000" "5580.000000" ...
##  $ Close    : chr [1:260] "5640.000000" "5510.000000" "5510.000000" "5580.000000" ...
##  $ Adj Close: chr [1:260] "5402.116699" "5277.600098" "5277.600098" "5344.647461" ...
##  $ Volume   : chr [1:260] "0" "38940" "777" "10674" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Date = col_date(format = ""),
##   ..   Open = col_character(),
##   ..   High = col_character(),
##   ..   Low = col_character(),
##   ..   Close = col_character(),
##   ..   `Adj Close` = col_character(),
##   ..   Volume = col_character()
##   .. )
##  - attr(*, "problems")=<externalptr>

a. Por medio de la probabilidad frecuentista, estime la probabilidad de que el precio de la acción aumente o se mantenga igual en un día cualquiera

 # Close_rtn=diff(log(DT %>% select(Close))) # Compute log returns

Carga de los datos con la función getSymbols

 getSymbols("EXITO.CL",from="2018-01-01",to="2023-01-01",)
## Warning: EXITO.CL contains missing values. Some functions will not work if
## objects contain missing values in the middle of the series. Consider using
## na.omit(), na.approx(), na.fill(), etc to remove or replace them.
## [1] "EXITO.CL"

Log-retornos

Close_rtn=diff(log(EXITO.CL$EXITO.CL.Close))
 chartSeries(Close_rtn)

c. Asumiendo que el cambio en el precio de cierre de la acción del día t con respecto al día t − 1 tiene una distribución normal, calcule la probabilidad de que en un día cualquiera: el precio aumente o disminuya un 5%, un 10% y un 20% del precio de cierre promedio

Al cambio de precio de una acción del día t con respecto al día t-1 se le llama retorno financiero y se calcula así: \[1+R_t=\frac{P_t}{P_{t-1}} \] \[R_t=\frac{P_t}{P_t -1}-1=\frac{P_t-P_{t-1}}{P_{t-1}}\] Ahora gracias a sus ventajas conceptuales y computaciones se va a trabajar con rendimientos logarítmicos \[r_t=\ln(1+R_t)=ln \frac{P_t}{P_{t-1}}= ln(P_t)-ln(P_{t-1})\] y se asume que \[r_t \sim Normal \]

hist(Close_rtn, freq = FALSE, main = "Histograma y densidad(Log-retornos) ",
     ylab = "Densidad")

dx <- density(Close_rtn,na.rm = TRUE)

lines(dx, lwd = 2, col = "red")

Se calculan el retorno promedio \(\bar{R_t}\) y la desviación estandar de los retornos \(sd(R_t)\) de la siguiente manera

mean_logr=mean(Close_rtn,na.rm=TRUE)
sd_logr=sd(Close_rtn,na.rm=TRUE)
  • \(1-P(|r_t - \bar{r_t}|<\beta)= 1- P(-\beta<r_t - \bar{r_t}<\beta)\)

  • \(1- P(\frac{-\beta}{sd(r_t)}<\frac{r_t - \bar{r_t}}{sd(r_t)}<\frac{\beta}{sd(r_t)})\)

  • \(1- P(\frac{-\beta}{sd(r_t)}<Z_t<\frac{\beta}{sd(r_t)})\)

  • \(1-(P(Z_t<\frac{\beta}{sd(r_t)})-P(Z_t<\frac{-\beta}{sd(r_t)}))\) con \(\beta:0.05,0.1\ y \ 0.2\)

Ahora, se contruye una función para hacer el calculo de la probabilidad pedida variando el valor de \(\beta\)

betas <- c(0.05,0.1,0.2)

for (beta in betas) {
  p=1-(pnorm((beta/sd_logr))-pnorm(-beta/sd_logr))
  print(p)
}
## [1] 0.03985548
## [1] 3.948253e-05
## [1] 2.220446e-16

3. Sea \(X_1,X_2,\dots,X_n\) una muestra aleatoria de una Gamma(\(\alpha,\beta\)) sea \(T=X_1+X_2+\dots+X_n\)

Probar Que \(T\sim Gamma(n\alpha,\beta)\)

Encontremos la función generadora de momentos de T así: \[M_{T}(t)=E(e^{tT})\] \[=E(e^{t\sum_{i=1}^{n}X_{n}})\] \[=E(e^{tX_1+tX_2+\dots+tX_n})\] \[=E(e^{tX_1}*e^{tX_2}*\dots *e^{tX_n})\] \[=E(e^{tX_1})*E(e^{tX_2})*\dots *E(e^{tX_n})\] \[=[M_{T}(t)]^n\] \[=[\frac{1}{(1-\beta t)^\alpha}]^n=\frac{1}{(1-\beta t)^{n\alpha}}\ con\ t<\frac{1}{\beta} \] la cual corresponde a una fgm de una \(Gamma(n\alpha,\beta)\), con lo cual probamos que \(T\sim Gamma(n\alpha,\beta)\), de acá \(E(T) = n\alpha\beta\)

Ahora probaremos que \(E(\frac{1}{T})\)

\[E(\frac{1}{T})=\int_{0}^{\infty}\frac{1}{T}\frac{1}{\Gamma(n\alpha)\beta^{n\alpha}}*t^{n\alpha-1}e^\frac{-t}{\beta}dt\] \[=\int_{0}^{\infty}\frac{1}{\Gamma(n\alpha)\beta^{n\alpha}}*t^{(n\alpha-1)-1}e^\frac{-t}{\beta}dt\] Realizando un cambio de variable \(u=\frac{t}{\beta}\) con \(du=\frac{1}{\beta}dt\) tenemos:

\[=\frac{\beta}{\Gamma(n\alpha)\beta^{n\alpha}}\int_{0}^{\infty}(u\beta)^{n\alpha-1}e^\frac{-t}{\beta}du\]