Problema 2

Actividad 2. Métodos y Simulación

Problema 2 - Propiedades de los Estimadores

Enunciado

La simulación ayuda a entender y validad las propiedades de los estimadores estadísticos como son. insesgadez, eficiencia y la consistencia principalmente. El siguiente problema permite evidenciar las principales características de un grupo de estimadores propuestos para la estimación de un parámetro asociado a un modelo de probabilidad.

Sean \(X_1,X_2,X_3\) y \(X_4\), una muestra aleatoria de tamaño \(n = 4\) cuya población la conforma una distribución exponencial con parámetro \(\theta\) desconocido. Determine las características de cada uno de los siguientes estimadores propuestos:

\[\hat{\theta_1} = \frac{X_1+X_2}{6} + \frac{X_3+X_4}{3}\] \[\hat{\theta_2} = \frac{X_1+2X_2+3X_3+4X_4}{5}\] \[\hat{\theta_3} = \frac{X_1+X_2+X_3+X_4}{4}\] \[\hat{\theta_4} = \frac{min{(X_1,X_2,X_3,X_4)}+max{(X_1,X_2,X_3,X_4)}}{2}\]

Nota

• Genere una muestras de n=20, 50, 100 y 1000 para cada uno de los estimadores planteados.
• En cada caso evalue las propiedades de insesgadez, eficiencia y consistencia
• Suponga un valor para el parámetro θ
• Funciones recomendadas : function(){}, rexp() , data.frame(), apply(), boxplot()
• Entregable : enlace en RPubs con informe 2

Desarrollo

Se procede a evaluar la función con los diferentes tamaños de muestra propuestos, es decir, con 20, 50, 100 y 1000 y con \[\lambda = 1/5\], de lo cual se obtienen los graficos de cajas y bigotes que sirven para comparar los estimadores. También se imprimen el resumen estadístico que indica el mínimo, el máximo, cuartiles, media y mediana. De igual forma se muestran las varianzas en una matriz para realizar un analisis de dispersión.

#Definition of estimator's functions
#estimators = data.frame(
  theta1 <- function(x1,x2,x3,x4){
   return(((x1+x2)/6)+ (x3+x4)/3)
  }
  #,
  theta2 <- function(x1, x2, x3, x4){
   return((x1+2*x2+3*x3+4*x4)/5)
  }
  #,
  theta3 <- function(x1, x2, x3, x4){
    return((x1+x2+x3+x4)/4)
  }
  #,
  theta4 <- function(x1, x2, x3, x4){
    return(((min(x1,x2,x3,x4)+max(x1,x2,x3,x4))/2))
  }
#)

comparison_function <- function(n, sup_theta){
  # n <- number of records
  # sup_theta <- Initial value assumed for the exponential distribution

  # 1. Exponential distribution for each sample
  x1 <- rexp(n, sup_theta)
  x2 <- rexp(n, sup_theta)
  x3 <- rexp(n, sup_theta)
  x4 <- rexp(n, sup_theta)
  # 2. Dataframe creation
  base <- data.frame(x1, x2, x3, x4)
  # 3. Estimators calculation for the sample
  base$t1 <- apply(base, 1, function(row) theta1(row['x1'], row['x2'], row['x3'], row['x4']))
  base$t2 <- apply(base, 1, function(row) theta2(row['x1'], row['x2'], row['x3'], row['x4']))
  base$t3 <- apply(base, 1, function(row) theta3(row['x1'], row['x2'], row['x3'], row['x4']))
  base$t4 <- apply(base, 1, function(row) theta4(row['x1'], row['x2'], row['x3'], row['x4']))
  # 4. Estimators are extracted into a dataframe
  estimators<- base[c('t1', 't2', 't3', 't4')]
  # 5. Summary
  summary_data <- summary(estimators)
  # 6. The variance matrix is calculated
  varianza <- var(estimators)
  # 7.  Reorder estimators to graph
  estimators_2 <- melt(estimators, id.vars= NULL)
  # 8. Create the boxplots graph
  plot <- ggplot(estimators_2, aes(variable, value)) + 
  geom_boxplot() +
  labs(x = "Estimadores", y = "Valor", title = paste("Comparación de los estimadores con n = ", n)) +
  geom_hline(yintercept = 1/sup_theta, color = "blue", linetype = "dashed")
  # 9. Results
  resultados <- list(
    'summary' = summary_data,
    'grafico' = plot,  
    'varianza' = varianza
    )
  return(resultados)
}

## $summary
##        t1              t2               t3              t4        
##  Min.   :1.767   Min.   : 3.564   Min.   :1.598   Min.   : 1.537  
##  1st Qu.:2.506   1st Qu.: 5.391   1st Qu.:3.135   1st Qu.: 2.688  
##  Median :3.650   Median : 7.193   Median :3.450   Median : 4.277  
##  Mean   :4.474   Mean   : 8.650   Mean   :4.576   Mean   : 5.195  
##  3rd Qu.:6.600   3rd Qu.:12.496   3rd Qu.:6.313   3rd Qu.: 7.303  
##  Max.   :8.365   Max.   :15.158   Max.   :9.106   Max.   :11.348  
## 
## $grafico

## 
## $varianza
##          t1        t2        t3        t4
## t1 5.128421  9.515852  5.476037  6.250953
## t2 9.515852 18.079295 10.094433 11.115848
## t3 5.476037 10.094433  6.251125  6.910751
## t4 6.250953 11.115848  6.910751  9.045993

## $summary
##        t1                t2               t3               t4         
##  Min.   : 0.6387   Min.   : 1.344   Min.   : 0.695   Min.   : 0.8642  
##  1st Qu.: 3.2033   1st Qu.: 6.294   1st Qu.: 3.128   1st Qu.: 3.3655  
##  Median : 4.0621   Median : 8.225   Median : 3.969   Median : 4.6343  
##  Mean   : 4.8311   Mean   : 9.538   Mean   : 4.963   Mean   : 5.8067  
##  3rd Qu.: 5.6352   3rd Qu.:11.306   3rd Qu.: 6.106   3rd Qu.: 7.0321  
##  Max.   :12.1408   Max.   :23.493   Max.   :13.197   Max.   :16.0809  
## 
## $grafico

## 
## $varianza
##           t1       t2        t3        t4
## t1  7.286053 13.43935  7.612652  8.568259
## t2 13.439347 25.67221 13.688540 15.161435
## t3  7.612652 13.68854  8.505949 10.003452
## t4  8.568259 15.16144 10.003452 13.348050

## $summary
##        t1               t2               t3               t4        
##  Min.   : 1.002   Min.   : 1.599   Min.   : 1.182   Min.   : 1.310  
##  1st Qu.: 3.108   1st Qu.: 6.219   1st Qu.: 3.213   1st Qu.: 3.713  
##  Median : 4.255   Median : 8.979   Median : 4.510   Median : 4.959  
##  Mean   : 4.784   Mean   : 9.774   Mean   : 4.785   Mean   : 5.535  
##  3rd Qu.: 6.290   3rd Qu.:12.745   3rd Qu.: 6.043   3rd Qu.: 7.167  
##  Max.   :10.674   Max.   :24.096   Max.   :11.764   Max.   :16.065  
## 
## $grafico

## 
## $varianza
##           t1        t2       t3        t4
## t1  4.983959 10.544076 4.449238  5.217641
## t2 10.544076 23.111498 9.155749 10.943495
## t3  4.449238  9.155749 4.506484  5.146582
## t4  5.217641 10.943495 5.146582  7.437949

## $summary
##        t1                t2                t3                t4         
##  Min.   : 0.3342   Min.   : 0.7125   Min.   : 0.3602   Min.   : 0.4383  
##  1st Qu.: 3.0277   1st Qu.: 5.9151   1st Qu.: 3.1249   1st Qu.: 3.3968  
##  Median : 4.5293   Median : 8.9602   Median : 4.5741   Median : 5.3288  
##  Mean   : 4.9655   Mean   : 9.8837   Mean   : 5.0214   Mean   : 5.8549  
##  3rd Qu.: 6.3990   3rd Qu.:12.8492   3rd Qu.: 6.4421   3rd Qu.: 7.5653  
##  Max.   :17.0149   Max.   :39.4124   Max.   :14.8683   Max.   :23.4715  
## 
## $grafico

## 
## $varianza
##           t1       t2        t3        t4
## t1  6.647399 13.46979  6.128357  7.202934
## t2 13.469789 28.37501 12.148760 14.205786
## t3  6.128357 12.14876  6.299528  7.459181
## t4  7.202934 14.20579  7.459181 10.454047

Sezgo

Tanto en los gráficos como en las tablas se puede ver que los valores de los estimadores \(\theta_1, \theta_2,\) y \(\theta_3\) son cercanos a la media, lo cual indica que el sezgo es bajo, en contraste con \(\theta_4\). El estimador \(\theta_3\) tiene el valor medio más cercano al valor teórico indicado.

Dispersión

En las tablas se puede ver que el estimador \(\theta_3\) es el que presenta el menos grado de dispersión, lo que nos indica que es el estimador más eficiente. A este lo siguen \(\theta_1, \theta_4,\) y \(\theta_2\).

Consistencia

Los estimadores \(\theta_1\) y \(\theta_3\) son los que presentan una disminución del sezgo a medida en que se hace más grande el tamaño de la muestra, lo cual nos indica que son consistentes.

En Conclusión, el estimador \(\theta_3\), por todo lo mencionado anteriormente, es el que presenta menor grado de sezgo, es el más eficiente y el más consistente.