Parcial muestreo
Manuel Reyes CC 1018496422
23/6/2020
Punto1 Muestreo aleatorio simple
En un lote de 1/8 de hectarea se tienen sembradas plantas de fresa a 30cm entre planta y 80cm entre hileras
set.seed(2020)
Lotemetroscuarados <- 10000*(1/8)
densidadsiembra <- round(Lotemetroscuarados/(0.4*0.3)); densidadsiembra## [1] 10417Lotemetros <- sqrt(Lotemetroscuarados)
Plantaslargo <- (Lotemetros/0.80)
Plantasancho <- (Lotemetros/0.3)
Verificaciondensidad <- round(Plantaslargo*Plantasancho)
P <- expand.grid(x=seq(1,round(Plantasancho)), y=seq(0,Plantaslargo))
plot(P, pch=19, cex =0.01, main ="Cultivo de fresa", xlab = "ancho del lote", ylab = "Largo del lote")
Se sabe que el 12% de las plantas tienen botrytis y se muestran de color rojo
botryDF <- sample(0:1, size = densidadsiembra, prob = c(.12,.88), replace = T)
botry <- sample(densidadsiembra, round(densidadsiembra*0.12), replace = F )
plot(P[botry,], pch=19,cex = 0.01, col="red", main ="Cultivo de fresa", xlab = "ancho del lote", ylab = "Largo del lote")
points(P[-botry,],pch=19,cex = 0.01, col="green")
AF <- runif(densidadsiembra,211.2, 251.2)En la base de datos que se muestra acontinuacion se identifican las plantas con botrytis con el numero ‘0’ y las sanas con el numero ‘1’
Df <- data.frame(botryDF,AF)
head(Df)## botryDF AF
## 1 1 217.2611
## 2 1 222.5490
## 3 1 235.6678
## 4 1 219.6399
## 5 1 223.7765
## 6 1 238.6707tail(Df)## botryDF AF
## 10412 1 248.9085
## 10413 1 228.6060
## 10414 1 214.6491
## 10415 1 250.9462
## 10416 1 212.7049
## 10417 1 248.7822tamaño de muestra aleatorio con un error del 5%
n.muestra.p <- function(N, p, e, z=1.96){
n=ceiling(N*p*(1-p)/((N-1)*(e/z)^2+p*(1-p)))
muestras <- sample(N,n,replace = F)}
n1=n.muestra.p(N=densidadsiembra,p=0.5,e=0.05);length(n1)## [1] 371Una vez realizada la formula de muestreo se sabe que se deben muestrear 371 plantas para incurrir en un error de muestreo del 5%. este error quiere decir que se toma una planta como enferma cuando esta no lo esta
prev <- factor(botry, levels = n1)
prev <- prev[!is.na(prev)]
length(prev)## [1] 41Al realizar el anaisis de las plantas muestreadas se evidencia que 39 plantas estan enfermas, por lo tanto la prevalencia estimada es del \[ prevalencia = 39/371= 0.105 * 100 \]
tamaño de muestra aleatorio con un error del 10%
n.muestra.p <- function(N, p, e, z=1.96){
n=ceiling(N*p*(1-p)/((N-1)*(e/z)^2+p*(1-p)))
muestras <- sample(N,n,replace = F)}
n2=n.muestra.p(N=densidadsiembra,p=0.5,e=0.1);length(n2)## [1] 96Una vez realizada la formula de muestreo se sabe que se deben muestrear 96 plantas para incurrir en un error de muestreo del 10%. este error quiere decir que se toma una planta como enferma cuando esta no lo esta
prev1 <- factor(botry, levels = n2)
prev1 <- prev1[!is.na(prev1)]
length(prev1)## [1] 15Al realizar el anaisis de las plantas muestreadas se evidencia que 13 plantas estan enfermas, por lo tanto la prevalencia estimada es del \[ prevalencia = 13/96= 0.135 * 100 \] Al comparar el porcentaje de prevalencia de la proporcion al 10% de error con el porcentaje al 5%, se evidencia que hay un aumento en la prevalencia. por lo que se puede concluir que entre mayor sea el error de muestreo, mayor sera el porcentaje de prevalencia.
intervalo de confianza
icprev=function(N,n,p,z=2.08){
li=p-z*(sqrt((p*(1-p)/n)*(1-n/N)))
ls=p+z*(sqrt((p*(1-p)/n)*(1-n/N)))
return(list(li,ls=ls))
}
ic <- icprev(N = densidadsiembra, n = length(n1), p =0.8); ic## [[1]]
## [1] 0.7575809
##
## $ls
## [1] 0.8424191Grafico intervalo de confianza
lie=0.7575809;
lse=0.8424191;
IC=c(lie, lse)
plot(IC, rep(0,2) , pch=1 , type="l" ,
col="blue" ,xlim= ( c (0.70 ,
0.90)) ,main="Intervalo de confianza")
points(lie,0,col="green")
points(lse,0,col="green")
text(lie,-0.3, "linf")
text(lse,-0.3, "lsup")
text(lie,+0.3,round(lie,3))
text(lse,+0.3,round(lse,3))
Intervalo de confianza del area foliar
mf <-mean(Df$AF)
sdf<- sd(Df$AF)
mf## [1] 231.1876sdf## [1] 11.52772icprev=function(m,n,sd,z=1.95){
lia=m-(z*(sd/sqrt(n)))
lsa=m+(z*(sd/sqrt(n)))
return(list(lia=lia,lsa=lsa))
}
icprev(m= mf ,n = length(n1),sd = sdf)## $lia
## [1] 230.0205
##
## $lsa
## [1] 232.3546liAF=230.0205;
lsAF=232.3546;
IC=c(liAF, lsAF)
plot(IC, rep(0,2) , pch=1 , type="l" ,
col="red" ,xlim= ( c (229 ,
234)) ,main="Intervalo de confianza", xlab="",ylab="")
points(mf,0,col="blue")
points(liAF,0,col="blue")
points(lsAF,0,col="blue")
text(mf,-0.3, "media")
text(mf,+0.3,round(mf,1))
text(liAF,-0.3, "liAF")
text(lsAF,-0.3, "liAF")
text(liAF,+0.3,round(liAF,1))
text(lsAF,+0.3,round(lsAF,1))
PUNTO 2 Muestreo sistematico
Se supone un muestreo sistematico para lo cual se debe determinar el sistema k
e = function(N, p, n, z=1.96){
error=(z*(sqrt((p*(1-p)*(N-n))/n)))
}
errorm=e(N=densidadsiembra, p=0.5,n=60); errorm## [1] 12.8756Sistema K
k= round(densidadsiembra/60);k## [1] 174El sistema k nos indica cada cuantas plantas se debe muestrear
Numero de muestras
muestra<-(seq(2,densidadsiembra,k));length(muestra)## [1] 60Grafico
plot(P[muestra,], pch=19,cex=0.05,col="red")
points(P[-muestra,], cex= 0.05, col= "green")
muestrap3<- sample(botryDF,60, replace = F)
table(muestrap3)## muestrap3
## 0 1
## 6 54prev2 <-100*(6/60)
prev2## [1] 10Despues de analizar las plantas muestreadas se evidencia una prevalencia del 10%
muesAF <- sample(AF,60, replace = F)
Area <- mean(muesAF);Area## [1] 229.9455Comparacion prevalencia estimada
#prevalencia muestreo aleotrrio
length(prev)-12## [1] 29#prealencia muesreo sistematio
12-prev2## [1] 2Los resusltados de las prevalencia obtenidos por el muestreo aleatorio estan por encima del estimado, mientras que la prevalencia del muestreo sistematico esta subestimado .
Intervalo de confianza de la prevalencia 92%
icprevS=function(N,n,p,z=2.08){
lis=p-z*(sqrt((p*(1-p)/n)*(1-n/N)))
lss=p+z*(sqrt((p*(1-p)/n)*(1-n/N)))
return(list(lis=lis,lss=lss))
}
icprevS(N = densidadsiembra,n = 60,p = 0.8)## $lis
## [1] 0.692899
##
## $lss
## [1] 0.907101#intervalo de confianza
lis=0.692899;
lss=0.907101;
IC=c(lis, lss)
plot(IC, rep(0,2) , pch=1 , type="l" ,
col="blue" ,xlim= ( c (0.1 ,
0.91)) ,main="Intervalo de confianza /sistematico", xlab="",ylab="")
points(prev2/100,0,col="green")
points(lis,0,col="green")
points(lss,0,col="green")
text(prev2/100,-0.3, "prev2")
text(prev2/100,+0.3,round(prev2/100,3))
text(lis,-0.3, "linf")
text(lss,-0.3, "lsup")
text(lis,+0.3,round(lis,3))
text(lss,+0.3,round(lss,3))
PUNTO 3
senescencia <- sample(densidadsiembra, (densidadsiembra*0.052), replace = F)
senesc = rep("no",densidadsiembra)
dy =cbind(Df, senesc)
Df$senesc = replace(senesc, senescencia, "si")
summary(dy)## botryDF AF senesc
## Min. :0.0000 Min. :211.2 no:10417
## 1st Qu.:1.0000 1st Qu.:221.3
## Median :1.0000 Median :231.0
## Mean :0.8848 Mean :231.2
## 3rd Qu.:1.0000 3rd Qu.:241.2
## Max. :1.0000 Max. :251.2length(dy)## [1] 3library(clhs)
mues<-clhs(Df[,1:3],size=60,iter=100,progress=F)
mues## [1] 7132 4723 2495 9917 8259 47 5356 2828 5027 7676 4654 2947 1181 7415 6869
## [16] 4737 319 9026 7668 3550 6791 3244 9800 7389 9978 1 9998 6029 7306 775
## [31] 7146 1083 8767 432 3024 7206 248 4571 1868 3359 6456 1790 6512 6855 1160
## [46] 5583 2463 8715 131 1450 9965 3886 11 1710 4260 4278 7097 6772 4513 7037plot(P,pch =16, col ="green", main ="cultivo fresa", xlab = "hilera", ylab = "plantas",cex =0.5)
points(P[botry,],col = "navy",pch =19, cex =0.4)
points(P[senescencia,],col = "darkgoldenrod ",pch =16, cex =0.7)
points(P[mues,],col = "red",pch =16, cex =0.7)
legend("bottomleft",c("sana","enfer","Senesc","Muestreo"), fill=c("green","navy","darkgoldenrod","red"))
#prevalencia muestreo espacial
table(Df$botry[mues])##
## 0 1
## 5 55mean(Df$AF[mues])## [1] 228.9459prevMu<-100*(8/60)
prevMu## [1] 13.33333#comparacion prevalencia con toda la poblacion
prevMu/12## [1] 1.111111#prevalencia estimada con prevalencia
length(prev)-12## [1] 29prev2-12## [1] -2prevMu-12## [1] 1.333333los resultados de la prevalencia de la enfermedad por el muestreo aleatorio simple esta sobreestimado en un 27%, mientras que el muestreo sitematico esta subestimado en 2%. por otro lado en el muestreo espacial el resultado de la prevalencia con muestreo espacial se encuentra 1.3% por encima del valor real del 12%. concluyendo asi que el mejor metodo para realizar un muestreo efectivo es el muestreo espacial.
#intervalo de confianza muestreo espacial
icpreves=function(N,n,p,z=2.08){
liesp=p-z*(sqrt((p*(1-p)/n)*(1-n/N)))
lsesp=p+z*(sqrt((p*(1-p)/n)*(1-n/N)))
return(list(liesp=liesp,lsesp=lsesp))
}
icpreves(N = densidadsiembra,n = 60,p = 0.8)## $liesp
## [1] 0.692899
##
## $lsesp
## [1] 0.907101liesp=0.692899;
lsesp=0.907101;
IC=c(liesp, lsesp)
plot(IC, rep(0,2) , pch=1 , type="l" ,
col="red" ,xlim= ( c (0.1 ,
0.91)) ,main="Intervalo de confianza", xlab="",ylab="")
points(prevMu/100,0,col="blue")
points(liesp,0,col="blue")
points(lsesp,0,col="blue")
text(prevMu/100,-0.3, "prev")
text(prevMu/100,+0.3,round(prevMu/100,3))
text(liesp,-0.3, "linf")
text(lsesp,-0.3, "lsup")
text(liesp,+0.3,round(liesp,3))
text(lsesp,+0.3,round(lsesp,3))
\[H_o=Los~datos~no~tienen~tendencia\] \[H_a=Los~datos~tienen~tendencia\]
library(dbmss)## Loading required package: spatstat## Loading required package: spatstat.data## Loading required package: nlme## Loading required package: rpart##
## spatstat 1.64-1 (nickname: 'Help you I can, yes!')
## For an introduction to spatstat, type 'beginner'## Loading required package: Rcpp## Loading required package: ggplot2da = ppp(P[botry,]$x,P[botry,]$y, window = owin(c(1,5000),c(1,2500)))## Warning in ppp(P[botry, ]$x, P[botry, ]$y, window = owin(c(1, 5000), c(1, : 629
## out of 1250 points had NA or NaN coordinate values, and were discarded## Warning: 15 points were rejected as lying outside the specified windowpruebaK1 = Ktest(da, r = seq(0.1,.5,.1));pruebaK1## [1] 0.9999992ifelse(pruebaK1<0.05,"Rechazo Ho", "No rechazo Ho")## [1] "No rechazo Ho"ifelse(pruebaK1<0.05,“Rechazo Ho”, “No rechazo Ho”)
PUNTO 4 muestreo estratificao no espacial
productores de papa
(255*20)/100## [1] 51pp=function(N,p,z=1.96,e=0.05){
pt=sum(N)
wi<<-N/pt
numerador<<-(N[1]^2*p[1]*(1-p[1])/wi[1])+(N[2]^2*p[2]*(1-p[2])/wi[2])
denominador<<-(N[1]*p[1]*(1-p[1]))+(N[2]*p[2]*(1-p[2]))+(pt*e/z)^2
n=ceiling(numerador/denominador)
return(n)
}
pp(N=c(204,51),p=c(0.12,0.25))## [1] 109¿Qué tamaño de muestra debe ser utilizado para estimar la proporción que declara presencia de palomilla? Use un nivel de confianza del 95% y un error de muestreo del 5.2%.
pp1=function(N,p,z=1.96,e=0.052){
pt1=sum(N)
wi<<-N/pt1
numerador<<-(N[1]^2*p[1]*(1-p[1])/wi[1])+(N[2]^2*p[2]*(1-p[2])/wi[2])
denominador<<-(N[1]*p[1]*(1-p[1]))+(N[2]*p[2]*(1-p[2]))+(pt1*e/z)^2
n=ceiling(numerador/denominador)
return(n)
}
pp1(N=c(204,51),p=c(0.12,0.25))## [1] 104cultivo <- expand.grid(x=seq(1,17,1),y=seq(1,15,1))
productores<-seq(1,255)
sola =sample(productores,51, replace = F)
Muestre =sample(productores,109, replace =F)
plot(cultivo,col = "lime green",xlab = "",ylab = "", main ="cultivo" , pch = 19, cex = 0.7)
points(cultivo[sola,], col = "red", pch = 19, cex = 0.7)
points(cultivo[Muestre,], col = "navy")
legend(x = "bottomright", legend = c(" papa ", "papa y otra solanaceas","muestreadas"), fill = c("lime green", "red", "navy"), title = "plantas")
Asignación proporcional
round(wi*89)## [1] 71 18proporcion de palomilla en cada estrato
propapa = 100*(71/204)
prosolan =100*(18/51)
propapa## [1] 34.80392prosolan## [1] 35.29412la proporcion de palomilla en los cultivos de solo papa es del 34.80% y el numero de agricultores muestreados es de 71 y en los cultivos de papa y otras solanaceas es de 35.29% y el numero de agricultores muestreados es de 18. # Ho: PpI=PpII
# Ha: PpI ≠ PpII
matriz = matrix(c(133,71,33,18),nrow = 2, ncol = 2)
dimnames(matriz) = list(c("NoMu", "Mu"), c("solopapa", "consolanaceas"))
matriz## solopapa consolanaceas
## NoMu 133 33
## Mu 71 18prop.test(matriz, correct=FALSE) ##
## 2-sample test for equality of proportions without continuity
## correction
##
## data: matriz
## X-squared = 0.004315, df = 1, p-value = 0.9476
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.09974596 0.10664998
## sample estimates:
## prop 1 prop 2
## 0.8012048 0.7977528con un intervalo de confianza de el 95% se puede asegurr que la diferencia entre las proporciones esta entre el -9,9% y el 10,6%. con: p-value = 0.9476, no se rechaza Ho