Primera parte: boxplot a mano

x <- c(7.6, 3.3, 4.4, 5.8, 9.0, 2.3, 0.9, 3.7, 5.7, 4.4) # Datos
n <- length(x) # Número de observaciones
q1 <- quantile(x, 0.25); q1 # Primer cuartil
## 25% 
## 3.4
q2 <- quantile(x, 0.50); q2 # segundo cuartil (mediana)
## 50% 
## 4.4
q3 <- quantile(x, 0.70); q3 # Tercer cuartil
##  70% 
## 5.73
IQR <- q3 - q1; IQR         # Rango intercuartil
##  70% 
## 2.33
k <- 1.5                    # Tamaño de los _bigotes_

Gráfico vacío para representar los datos

par(mar = c(3.5, 1, 1, 1)) # Parámetros gráficos (márgenes)
plot(0,0, type = 'n', xlim = c(0, 10), axes = F, ylab = '', xlab = '')
axis(1, 0:10); box()
rug(x, lwd = 4, ticksize = 0.1)

Graficamos la caja

segments(q3, -0.3, q3, 0.3, lwd = 3)  # Extremo derecho
segments(q1, -0.3, q1, 0.3, lwd = 3)  # Extremo izquerdo
segments(q1, 0.3, q3, 0.3, lwd = 3)   # Tapa superior
segments(q1, -0.3, q3, -0.3, lwd = 3) # Tapa inferior

# Polígono para darle color
aux.x <- c(q1, q1, q3, q3, q1)
aux.y <- c(-0.3, 0.3, 0.3, -0.3, -0.3)
polygon(aux.x, aux.y, col = '#4DB6AC', lwd = 3)

Agregamos la mediana

segments(q2, -0.3, q2, 0.3, lwd = 5)  # Mediana

Para el extremo derecho

Graficamos una línea guía

segments(q3+k*IQR, -0.1, q3+k*IQR, 0.1, lwd = 3, col = 'red2') # Línea guía

Con el siguiente código calculamos el número de observaciones mayores o iguales al extremo derecho \(Q_3 + kIQR\) y guardamos la observación más extrema menor al extremo derecho.

aux.d <- sum(q3 + k*IQR <= x); aux.d    # Observaciones mayores o iguales a q3 + k*IQR
## [1] 0
lim.d <- sort(x)[n-aux.d];     lim.d    # Obsrevación más extrema menor a q3 + k*IQR
## [1] 9

Graficamos el bigote derecho y borramos la línea guía

segments(q3, 0, lim.d, 0, lwd = 3, lty = 3) # _Bigote_ derecho
segments(lim.d, -0.15, lim.d, 0.15, lwd = 3) # _Bigote_ derecho
segments(q3+k*IQR, -0.1, q3+k*IQR, 0.1, lwd = 5, col = 'white') # Borrar línea guía

Se grafican las observaciones atípicas derechas (no hay)

if(aux.d != 0)
{
  points(x[q3 + k*IQR <= x], rep(0, aux.d), cex = 1.5, lwd = 3)
}

Para el extremo izquierdo repetimos lo anterior

Línea guía

segments(q1-k*IQR, -0.1, q1-k*IQR, 0.1, lwd = 3, col = 'gray') # Línea guía

Observaciones mayores o iguales al extremo izquierdo \(Q_1 - kIQR\) y guardamos la observación más extrema mayor al extremo izquierdo.

aux.i <- sum(q1 - k*IQR >= x); aux.i    # Observaciones menores o iguales a q1 - k*IQR
## [1] 0
lim.i <- sort(x)[1+aux.i];     lim.i    # Observación más extrema mayor a q1 - k*IQR
## [1] 0.9

Graficamos el bigote derecho y borramos la línea guía

segments(q1, 0, lim.i, 0, lwd = 3, lty = 3) # _Bigote_ izquierdo
segments(lim.i, -0.15, lim.i, 0.15, lwd = 3)  # _Bigote_ izquerdo
segments(q1-k*IQR, -0.1, q1-k*IQR, 0.1, lwd = 5, col = 'white') # Borrar línea guía

Se grafican las observaciones atípicas izquierdas (no hay)

if(aux.i != 0)
{  
  points(x[q1 - k*IQR >= x], rep(0, aux.i), cex = 1.5, lwd = 3)
}

Segunda parte

Cargamos la función gcaja

source('http://sigma.iimas.unam.mx/jsantibanez/Cursos/Inferencia/2018_1/gcaja.R')

Comparamos gráficos

Gráfico con la función gcaja

gcaja(x, k = 0.9, color = '#4DB6AC')

Gráfico con la función boxplot de R

boxplot(x, horizontal = T, ylim = c(0, 10), col = 'lightgray', lwd = 3, range = 0.9)
rug(x, lwd = 4, ticksize = 0.1)

Archivo .R con el código anterior diponible aquí.