library(clhs)
library(ggplot2)
Buscamos determinar la proporción de articulos (tamaño de muestra) defectuosos por turno de fabricación . Para lo cual construimos la función que genere la estratificación:
f_sam_prop <- function (Ni,pi,e,z=1.96,ti){
N <- sum(Ni) #tamaño de la población
L <- length(Ni) #número de estratos
qi <- 1-pi #proporcion de no defectuosos
ai <- Ni/N #peso para cada estrato
D <- (e/z)**2 #error
numer <- sum(Ni**2 * pi * qi / ai)
denom <- (N**2 * D)+ sum(Ni*pi*qi)
n <- ceiling(numer/denom) #tamaño de la muestra
ni <- round(ai*n) #tamaño de la muestra para cada estrato
ki <- floor(ti/ni) #tiempo de muestreo por estrato
return(list(ni,ki))
}
Generamos una estratificación para turnos de fabricación de 16 horas (diurna) y 8 horas (nocturno):
Ns = c(11000, 4000)
Ps = c(0.09, 0.08)
f_sam_prop(Ni = Ns,
pi = Ps,
ti = c(16*60, 8*60), # tiempo de operación en minutos
e = 0.05)
## [[1]]
## [1] 89 33
##
## [[2]]
## [1] 10 14
Calculamos la probabilidad de ocurrencia de una muestra defectuosa para la jornada diurna
a = (Ns[1]/sum(Ns))*Ps[1] + (Ns[2]/sum(Ns))*Ps[2]
defect_diurno = ((Ns[1]/sum(Ns))*Ps[1])/a; defect_diurno
## [1] 0.7557252
Calculamos la probabilidad de ocurrencia de una muestra defectuosa para la jornada nocturna
defect_nocturno = ((Ns[2]/sum(Ns))*Ps[2])/a; defect_nocturno
## [1] 0.2442748
Se puede concluir que existe mayor probabilidad de ocurrencia para un item defectuoso, durante la jornada diurna con una probabilidad aproximada del 75% en comparación a la jornada nocturna con 24%.
set.seed(1990)
Comenzamos con la creación conjunto de datos e híbridos
palmas = expand.grid(x = seq(0, 112, 7),
y = seq(0, 144, 9))
#peso promedio de racimo último
p_racimo_u = rnorm(289, 17, 1.8)
#peso promedio de racimo penúltimo
p_racimo_p = rnorm(289, 17, 1.8)
#relación calcio-magnesio hoja 17
CaMg_h17 = runif(289, 1.8, 2.0)
#relación calcio-magnesio suelo
CaMg_s = runif(289, 1.2, 1.4)
hibrid = rep(c('h1', 'h2'), c(144, 145))
df = data.frame (palmas,
p_racimo_u, p_racimo_p,
CaMg_h17, CaMg_s, hibrid)
head(df)
## x y p_racimo_u p_racimo_p CaMg_h17 CaMg_s hibrid
## 1 0 0 15.30099 17.05091 1.986174 1.390650 h1
## 2 7 0 17.43162 17.73708 1.936607 1.211921 h1
## 3 14 0 15.62925 15.43645 1.964574 1.282813 h1
## 4 21 0 17.20160 16.57591 1.834148 1.316677 h1
## 5 28 0 16.09296 19.93284 1.884900 1.280784 h1
## 6 35 0 20.17346 17.96522 1.847847 1.321645 h1
Librería para estratificación en complemento con datos auxiliares, que asociar un peso a cada individuo para tenerlo en cuenta durante el proceso de optimización. Iniciamos con una matriz de 15 elementos:
res = clhs(df, size=15, progress = FALSE, simple = TRUE)
## Warning: NAs introducidos por coerción
Se ha producido un error, debido a la existencia de intervalos sin muestras, por lo cual etiquetaremos los intervalos sin muestras para evitar valores nulos nulos:
sort(res)
## [1] 32 36 65 76 101 132 141 173 193 199 214 238 254 259 283
res2 = ifelse(res>= 145, "Dh1", "Dh2")
df[res, 'muestreo'] = res2
df$muestreo[is.na(df$muestreo)] = 'no muestreadas'
table(res2)
## res2
## Dh1 Dh2
## 8 7
Graficamos mediante la libreria ggplot
ggplot(df)+
aes(x,y, fill= muestreo)+
geom_tile(color = 'white')
Calculamos las medias de las variables para cada hibrido:
h1=mean(df$p_racimo_u)
h2=mean(df$p_racimo_p)
h3=mean(df$CaMg_h17)
h4=mean(df$CaMg_s)
df2= data.frame (h1,h2,h3,h4)
head(df2)
## h1 h2 h3 h4
## 1 16.71272 16.90313 1.899726 1.304442
mean(df$p_racimo_u[df$muestreo == 'Dh1'])
## [1] 16.37342
mean(df$p_racimo_p[df$muestreo == 'Dh1'])
## [1] 17.16706
mean(df$CaMg_h17[df$muestreo=='Dh1'])
## [1] 1.893292
mean(df$CaMg_s[df$muestreo=='Dh1'])
## [1] 1.320954
mean(df$p_racimo_u[df$muestreo == 'Dh2'])
## [1] 17.10941
mean(df$p_racimo_p[df$muestreo == 'Dh2'])
## [1] 17.09739
mean(df$CaMg_h17[df$muestreo=='Dh2'])
## [1] 1.896225
mean(df$CaMg_s[df$muestreo=='Dh2'])
## [1] 1.294549