##Ejercicio 1. Muestreo estratificado Estimar proporción de artículos defectuosos por estrato(diurno y nocturno )
## Tamaño de muestra para definir la proporción de artículos defectuosos por estratos definidos por turnos de fabricación.
f_sam_prop <- function(Ni, pi, ti, e, z = 1.96){
N = sum(Ni) # Tamaño de la población
L = length(Ni) # L: numero de estratos
qi = 1 - pi # proporción de NO defectuosos
ai = Ni/N # Pesos
D = (e/z)**2
numer = sum(Ni**2 * pi * qi / ai)
denom = (N**2 * D) + sum(Ni*pi*qi)
n = ceiling(numer/denom)
# Asignación propocional por estrato
ni = round(ai * n) # Tamaño de muestra por estrato
ki = floor(ti / ni) # Tiempo de muestreo sistemático por estrato
return(list(ni, ki))
}
## Número de artículos diurnos 11000, nocturnos 4000. Proporción de defectusos diurno =0.09 suma de mañana y tarde según ejercicio anterior. Tiempo 16 horas diurno, 8 horas nocturno.
f_sam_prop(Ni = c(11000, 4000),
pi = c(0.09, 0.08),
ti = c(960, 480), # Tiempo de operación en minutos
e = 0.05)
## [[1]]
## [1] 89 33
##
## [[2]]
## [1] 10 14
## De acuerdo con el resultado anterior se deben muestrear 89 artículos en la jornada diurna y 33 arítculos en la jornada nocturna. Con un tiempo de muestreo de 10 minutos (diurna) y 14 minutos (nocturna)
## calculo de la probabilidad de que sean los defectuosos entre la jornada diurna y nocturna.
a = 11/15*0.07 + 4/15*0.06
(11/15*0.07)/a ## Diurno
## [1] 0.7623762
(4/15*0.06)/a ## Nocturno
## [1] 0.2376238
## Según el resultado la probabilidad de que los artículos sean defectuosos en la jornada diurna es 76% mientras ue en la nocturna es del 23%, esto tiene que ver con la mayor cantidad de artículos que se fabrican en la jornada diurna.
## Ejercicio 2. muestreo espacial
palmas= expand.grid(x= seq(0,112,7),
y=seq(0,144,9))
##nrow(palmas)
set.seed(123)
## información auxiliar
p_racimo_u= rnorm(289, 17,1.8) ## peso promedio racimo ultima cosecha
p_racimo_p= rnorm(289, 17,1.8)## peso promedio racimo penultima cosecha
CaMg_h17= runif(289, 1.8, 2.0) # relacion Ca/Mg hoja 17
CaMg_s= runif(289, 1.2, 1.4) # relacion Ca/Mg suelo
hibrido= rep(c("h1", "h2"), c(144, 145)) ### para el ejercicio
## realizar un dataframe
df = data.frame(palmas,
p_racimo_u, p_racimo_p,
CaMg_h17, CaMg_s,hibrido )
head(df)
## x y p_racimo_u p_racimo_p CaMg_h17 CaMg_s hibrido
## 1 0 0 15.99114 17.30252 1.813162 1.350780 h1
## 2 7 0 16.58568 19.10309 1.970874 1.212619 h1
## 3 14 0 19.80567 18.89753 1.902082 1.288496 h1
## 4 21 0 17.12692 19.06147 1.842000 1.300134 h1
## 5 28 0 17.23272 15.96056 1.875169 1.254049 h1
## 6 35 0 20.08712 20.60447 1.841473 1.319760 h1
## tamaño de muestra 10%
library(clhs)
set.seed(123)
res <- clhs(df, size = 30, progress = FALSE, simple = TRUE)
## Warning: NAs introducidos por coerción
res2<- ifelse(res>=145, "h2", "h1")
df[res, 'muestreo'] = res2
df$muestreo[is.na(df$muestreo)] = 'no'
table(res2)
## res2
## h1 h2
## 12 18
## Según el resultado anterior debo muestrear 12 palmas del híbrido 1 y 18 palmas del híbrido 2. asumiendo un tamaño de muestra del 10%
library(ggplot2)
ggplot(df)+
aes(x,y, fill=muestreo)+
geom_tile(color ='white')
###Al comparar las medias de los racimos obtenidos en la penúltima y última cosecha de los datos originales con los datos muestreados son muy similares, lo cual da indicios de que es un buen muestreo.
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
df |> group_by(hibrido) |> summarise(mediahibridos=mean(p_racimo_u))
## # A tibble: 2 x 2
## hibrido mediahibridos
## <chr> <dbl>
## 1 h1 17.0
## 2 h2 17.1
df |> group_by(muestreo) |> summarise(mediahibmuestreo=mean(p_racimo_u))
## # A tibble: 3 x 2
## muestreo mediahibmuestreo
## <chr> <dbl>
## 1 h1 16.6
## 2 h2 17.1
## 3 no 17.0