#TEMA:Variable Cuantitativa Continua
#FECHA: 28/05/2024
#NOMBRE: Dayana Gutama, Damarys Patiño, Antonia Rivera, Valentina Vaca
#VARIABLE CONTINUA
install.packages('rmarkdown')
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)
library(rmarkdown)
#----Extracción de Datos----
library(readxl)
datos <- read_excel("Litogeoquímica_Peru (2).xlsx")
no_numeric <- datos$Cu[!grepl("^[0-9.]+$", datos$Cu)]
datos$Cu <- as.numeric(datos$Cu)
## Warning: NAs introduced by coercion
datos <- datos[!is.na(datos$Cu), ]
Variable <- datos$Cu
#----TDF Cualitativa Continua----
TdF = function(Variable)
{
t = length(Variable)
y.min = min(Variable)
y.max = max(Variable)
num.dec = rep(0,t)
for (i in 1:t)
{
if ((Variable[i] %% 1) != 0)
num.dec[i]=nchar(strsplit(sub('0+$','',as.character(Variable[i])),".",
fixed=TRUE)[[1]][[2]])
else
num.dec[i] = 0
}
num.dec = max(num.dec)
R = y.max-y.min
k = round(1+log(t,2),0)
A = R/k
residuo = 10^(num.dec+1)*A-floor(10^(num.dec+1)*A)
if (residuo<1e-10) residuo = 0
if (residuo!=0) A = A-residuo/(10*(num.dec+1))+1/(10*(num.dec+1))
else A = A-residuo/(10*(num.dec+1))
exceso = k*A-R
Li_E = round(rep(0,k),2)
Ls_E = round(rep(0,k),2)
MC_E = round(rep(0,k),2)
ni_E = rep(0,k)
Ni_asc_E = rep(0,k)
Ni_dsc_E = rep(0,k)
Li_E[1] = y.min-exceso/2
for (i in 1:k)
{
if (i!=k) Ls_E[i] = Li_E[1]+i*A
else Ls_E[i] = y.max+exceso/2
for (j in 1:t)
{
if (i!=k & Li_E[i]<=Variable[j] & Variable[j]<Ls_E[i]) ni_E[i] = ni_E[i]+1
if (i==k & Li_E[i]<=Variable[j] & Variable[j]<=Ls_E[i]) ni_E[i] = ni_E[i]+1
}
if (i!=k) Li_E[(i+1)] = Ls_E[i]
for (j in 1:i) Ni_asc_E[i] = Ni_asc_E[i]+ni_E[j]
MC_E[i] = (Li_E[i]+Ls_E[i])/2
}
Ni_dsc_E[k] = ni_E[k]
for (i in (k-1):1) {
Ni_dsc_E[i] = Ni_dsc_E[i+1] + ni_E[i]
}
hi_E = round(ni_E/t,4)*100
Hi_asc_E = round(Ni_asc_E/t,4)*100
Hi_dsc_E = round(Ni_dsc_E/t,4)*100
result = data.frame(Li_E,Ls_E,MC_E,ni_E,hi_E,Ni_asc_E,Ni_dsc_E,Hi_asc_E,Hi_dsc_E)
return(result)
}
TdF(Variable)
## Li_E Ls_E MC_E ni_E hi_E Ni_asc_E Ni_dsc_E Hi_asc_E Hi_dsc_E
## 1 1.0 13.4 7.2 93 25.48 93 365 25.48 100.00
## 2 13.4 25.8 19.6 89 24.38 182 272 49.86 74.52
## 3 25.8 38.2 32.0 55 15.07 237 183 64.93 50.14
## 4 38.2 50.6 44.4 34 9.32 271 128 74.25 35.07
## 5 50.6 63.0 56.8 37 10.14 308 94 84.38 25.75
## 6 63.0 75.4 69.2 20 5.48 328 57 89.86 15.62
## 7 75.4 87.8 81.6 18 4.93 346 37 94.79 10.14
## 8 87.8 100.2 94.0 9 2.47 355 19 97.26 5.21
## 9 100.2 112.6 106.4 4 1.10 359 10 98.36 2.74
## 10 112.6 125.0 118.8 6 1.64 365 6 100.00 1.64
#----TDF Cualitativa Continua Simplificada----
#tabla de frec absolutas
HistogramaElev<- hist(Variable,breaks=7)
k <- length(HistogramaElev$breaks)-1
Li <- HistogramaElev$breaks[1:7]
Ls <- HistogramaElev$breaks[2:8]
MC <- HistogramaElev$mids
ni <- HistogramaElev$counts
hi <- round((ni/sum(ni))*100,2)
#tabla de freq acumuladas
Ni_asc <- cumsum(ni)
Ni_dsc <- rev(cumsum(rev(ni)))
Hi_asc <- cumsum(hi)
Hi_dsc <- rev(cumsum(rev(hi)))
(TDFelevacion<- data.frame(Li,Ls,MC,ni,hi,Ni_asc,Ni_dsc,Hi_asc,Hi_dsc))
## Li Ls MC ni hi Ni_asc Ni_dsc Hi_asc Hi_dsc
## 1 0 20 10 141 38.63 141 365 38.63 100.00
## 2 20 40 30 108 29.59 249 224 68.22 61.37
## 3 40 60 50 53 14.52 302 116 82.74 31.78
## 4 60 80 70 33 9.04 335 63 91.78 17.26
## 5 80 100 90 20 5.48 355 30 97.26 8.22
## 6 100 120 110 9 2.47 364 10 99.73 2.74
## 7 120 140 130 1 0.27 365 1 100.00 0.27
#----Gráficas----
#Histogramas Frecuencia Acumuladas
barplot(ni,space = 0,main = "Grafica N°1:Distribucción de la Concetracion de Cobre en ppm de las Muestras Obtenidas en la zona oeste de Perú",
col = "skyblue",xlab = "Concentración de Cobre (ppm)",ylab = "Cantidad",
ylim=c(0,max(ni)),names.arg=round(MC,2), axis.lty=1, cex.main=0.7)
#Total
barplot(ni,space = 0,main = "Grafica N°2:Distribucción de la Concetracion de Cobre en ppm de las Muestras Obtenidas en la zona oeste de Perú",
col = "skyblue",xlab = "Concentración de Cobre (ppm)",ylab = "Cantidad",
ylim=c(0,length(Variable)),names.arg=round(MC,2), axis.lty=1, cex.main=0.7)
#Histogramas Frecuencia Absoluta
barplot(hi,space = 0,main = "Grafica N°3:Distribucción de la Concetracion de Cobre en ppm de las Muestras Obtenidas en la zona oeste de Perú",
col = "skyblue",xlab = "Concentración de Cobre (ppm)",ylab = "Porcentaje",
names.arg=round(MC,2), axis.lty=1,ylim = c(0,max(hi)),cex.main=0.7)
#Total
barplot(hi,space = 0,main = "Grafica N°4:Distribucción de la Concetracion de Cobre en ppm de las Muestras Obtenidas en la zona oeste de Perú",
col = "skyblue",xlab = "Concentración de Cobre (ppm)",ylab = "Porcentaje",
names.arg=round(MC,2), axis.lty=1,ylim = c(0,100),cex.main=0.7)
#Diagrama de Caja
caja<-boxplot(Variable, horizontal = TRUE, main = "Grafica N°5:Diagrama de Caja",
xlab="Concentración de Cobre (ppm)", col="skyblue",cex.main=0.7)
(round(summary(Variable),2))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 12.00 26.00 34.37 51.00 125.00
#Ojivas
plot(Li, Hi_dsc, type ="b", main ="Grafica N°6:Ojiva de Frecuencias Relativas Acumuladas Ascendete y Descendente",
ylab="Porcentaje %",xlab="Concentración de Cobre (ppm)",cex.main=0.7)
lines(Ls, Hi_asc, type = "b", col="skyblue")
#----Obtención de Indicadores Estadisticos----
library(PASWR)
## Loading required package: lattice
library(psych)
Indicadores<-c("n", "Minimo", "Maximo","k intervalos", "Amplitud","Media",
"Mediana", "Desviacion Estandar", "Varianza", "Coef. de variación (%)",
"Curtosis","Coef. de Asimetría")
Valores1<-c(length(Variable),min(Variable),max(Variable),k,
(max(Variable)-min(Variable))/k,mean(Variable),median(Variable),sd(Variable),
var(Variable),round((sd(Variable)/mean(Variable))*100,2),kurtosi(Variable),
skew(Variable))
Valores <- round(Valores1,2)
Estadisticas<- data.frame(Indicadores,Valores)
Estadisticas
## Indicadores Valores
## 1 n 365.00
## 2 Minimo 1.00
## 3 Maximo 125.00
## 4 k intervalos 7.00
## 5 Amplitud 17.71
## 6 Media 34.37
## 7 Mediana 26.00
## 8 Desviacion Estandar 27.45
## 9 Varianza 753.32
## 10 Coef. de variación (%) 79.85
## 11 Curtosis 0.50
## 12 Coef. de Asimetría 1.04
(outliers <- sort(caja$out))
## [1] 109.92 112.00 114.00 114.00 117.00 119.00 119.00 125.00
#CONCLUSIÓN
# La concentración de Cu tiene un comportamiento donde su valor mínimo es de 1 y su valor
# máximo es de 125 es un conjunto heterogeneo donde los valores se encuntran agrupados en su
# mayoria en la parte inferior izquierda del
# histograma, formando una curva leptocurtica, asimétrica positiva, con precencia de valores atipicos
# por lo tanto el comportamiento es medianamente beneficiosa
######################################### ETAPA2 ###################################################
Cu<- datos$Cu
CU<- na.omit(as.numeric(Cu))
hist(CU, breaks = 7, freq=FALSE, las=1)
summary(CU)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 12.00 26.00 34.37 51.00 125.00
#Ajuste
installed.packages('MASS')
## Package LibPath Version Priority Depends Imports LinkingTo Suggests
## Enhances License License_is_FOSS License_restricts_use OS_type Archs
## MD5sum NeedsCompilation Built
require(MASS)
## Loading required package: MASS
ajustelognormal<-fitdistr(CU, "lognormal")
ajustelognormal
## meanlog sdlog
## 3.13478726 1.02374509
## (0.05358527) (0.03789051)
x <- seq(min(CU),max(CU), by =0.001)
hv<- hist(CU, breaks = 7, freq =FALSE, xlab="Cu", ylab="Gráfica Nº 7. Densidad de Probabilidad",las =1, main = "Diagrama de distribución de densidad del Cu",
ylim= c(0,0.02), col="skyblue",cex.main=0.7)
curve(dlnorm(x,mean=ajustelognormal$estimate[1], sd=ajustelognormal$estimate[2]), ylim= c(0,1),col="red", add= TRUE)
#PRUEBAS DE AJUSTE
FO <- hv$counts
FO
## [1] 141 108 53 33 20 9 1
FE<-c()
for (i in 1:7){
P <- plnorm(hv$breaks[i+1],mean=ajustelognormal$estimate[1] , sd=ajustelognormal$estimate[2])-plnorm(hv$breaks[i],mean=ajustelognormal$estimate[1],sd=ajustelognormal$estimate[2])
FE[i] <- P*length(CU)
}
FO
## [1] 141 108 53 33 20 9 1
FE
## [1] 162.781954 94.845649 43.752213 22.903337 13.173372 8.116905 5.269537
cor(FE,FO)
## [1] 0.9815994
##Con esta formula calculamos el chi, solo valores positivos de eje horizontal
x2 <- sum(((FO-FE)^2)/FE)
x2
## [1] 18.23778
#Valor critico
Vc<-qchisq(0.99, 10)#nivel de confianza (no riesgo), grados de libertad
Vc
## [1] 23.20925
x2>Vc
## [1] FALSE
#CONCLUSIÓN
#El comportamiento de la variable continua Cu se representa a traves de un modelo
# Lognormal con pararametros mean= 3,13 y sd 1.023 donde podemos afirmar
# que la media aritmÈtica se encuentra en el intervalo: [1;13.4] y con una desviaciÛn estandar
#igual a 27.56