Temp_brillo
Gabriela Guerrero
2025-06-03
BRIGHTNESS
UNIVERSIDAD CENTRAL DEL ECUADOR
PROYECTO: FOCOS DE CALOR EN EL ECUADOR
AUTORES: GUERRERO MARIA GABRIELA,PUCHAICELA MONICA, ZURITA JOHANNA
FECHA: 14/05/2025
datos <- read.csv("maate_focosdecalor_bdd_2021diciembre.csv",
header = T, sep = ",", dec = ".")
#Estructura de los datos
str(datos)## 'data.frame': 22476 obs. of 17 variables:
## $ MES_REPORT: int 11 11 8 6 5 6 11 9 3 3 ...
## $ DIA_REPORT: int 20 20 6 10 28 10 20 29 22 22 ...
## $ DPA_DESPRO: chr "ZAMORA CHINCHIPE" "ZAMORA CHINCHIPE" "ZAMORA CHINCHIPE" "ZAMORA CHINCHIPE" ...
## $ DPA_DESCAN: chr "CHINCHIPE" "CHINCHIPE" "CHINCHIPE" "CHINCHIPE" ...
## $ DPA_DESPAR: chr "CHITO" "CHITO" "PUCAPAMBA" "PUCAPAMBA" ...
## $ TXT_1 : chr "PARROQUIA RURAL" "PARROQUIA RURAL" "PARROQUIA RURAL" "PARROQUIA RURAL" ...
## $ LATITUDE : chr "-4,981720000000000" "-4,969160000000000" "-4,958520000000000" "-4,957820000000000" ...
## $ LONGITUDE : chr "-79,041280000000000" "-79,049490000000006" "-79,118430000000004" "-79,111859999999993" ...
## $ BRIGHTNESS: chr "354,759999999999990" "342,009999999999990" "331,860000000000010" "331,399999999999980" ...
## $ SCAN : chr "0,510000000000000" "0,510000000000000" "0,150000000000000" "0,540000000000000" ...
## $ TRACK : chr "0,490000000000000" "0,490000000000000" "0,380000000000000" "0,420000000000000" ...
## $ SATELLITE : chr "1" "1" "1" "1" ...
## $ CONFIDENCE: chr "n" "n" "n" "n" ...
## $ VERSION : chr "2.0NRT" "2.0NRT" "2.0NRT" "2.0NRT" ...
## $ BRIGHT_T31: chr "299,420000000000020" "298,149999999999980" "299,160000000000030" "296,800000000000010" ...
## $ FRP : chr "12,100000000000000" "6,870000000000000" "3,770000000000000" "5,500000000000000" ...
## $ DAYNIGHT : chr "D" "D" "D" "D" ...#Extraccion variable Cuantitativa Continua
datos$BRIGHTNESS <- as.numeric(gsub(",", ".", datos$BRIGHTNESS))
str(datos$BRIGHTNESS)## num [1:22476] 355 342 332 331 328 ...BRIGHTNESS <- na.omit (datos$BRIGHTNESS)
#Tabla de distribución de frecuencia
#Manualmente
min <-min(BRIGHTNESS)
max <-max(BRIGHTNESS)
R <-max-min
K <- floor(1+3.33*log10(length(BRIGHTNESS)))
A <-R/K
Li <-round(seq(from=min,to=max-A,by=A),2)
Ls <-round(seq(from=min+A,to=max,by=A),2)
Mc <-(Li+Ls)/2
ni<-c()
for (i in 1:K) {
if (i < K) {
ni[i] <- length(subset(BRIGHTNESS, BRIGHTNESS >= Li[i] & BRIGHTNESS < Ls[i]))
} else {
ni[i] <- length(subset(BRIGHTNESS, BRIGHTNESS >= Li[i] & BRIGHTNESS <= Ls[i]))
}
}
sum(ni)## [1] 22476hi <-ni/sum(ni)*100
Ni_asc<-cumsum(ni)
Hi_asc<-cumsum(hi)
Ni_desc<-rev(cumsum(rev(ni)))
Hi_desc<-rev(cumsum(rev(hi)))
TDFBRIGHTNESS <- data.frame(
Li, Ls, Mc, ni, round(hi, 2), Ni_asc, Ni_desc, round(Hi_asc, 2), round(Hi_desc, 2)
)
colnames(TDFBRIGHTNESS) <- c("Li","Ls","Mc","ni","hi","Ni_asc(%)","Ni_desc(%)","Hi_asc","Hi_desc")
#Crear fila de totales
totales<-c(
Li="-",
Ls="-",
Mc="-",
ni=sum(ni),
hi=sum(hi),
Ni_asc="-",
Ni_desc="-",
Hi_asc="-",
Hi_desc="-")
TDFBRIGHTNESS<-rbind(TDFBRIGHTNESS,totales)
#Simplificación con el histograma
Hist_BRIGHTNESS<-hist(BRIGHTNESS,breaks = 8,plot = F)
k<-length(Hist_BRIGHTNESS$breaks)
Li<-Hist_BRIGHTNESS$breaks[1:(length(Hist_BRIGHTNESS$breaks)-1)]
Ls<-Hist_BRIGHTNESS$breaks[2:length(Hist_BRIGHTNESS$breaks)]
ni<-Hist_BRIGHTNESS$counts
sum(ni)## [1] 22476Mc<-Hist_BRIGHTNESS$mids
hi<-(ni/sum(ni))
sum(hi)## [1] 1Ni_asc<-cumsum(ni)
Hi_asc<-cumsum(hi)
Ni_desc<-rev(cumsum(rev(ni)))
Hi_desc<-rev(cumsum(rev(hi)))
TDFBRIGHTNESS<-data.frame(Li=round(Li,2),
Ls=round(Ls,2),
Mc=round(Mc,2),
ni=ni,
hi=round(hi*100,2),
Ni_asc=Ni_asc,
Ni_desc=Ni_desc,
Hi_asc=round(Hi_asc*100,2),
Hi_desc=round(Hi_desc*100,2))
colnames(TDFBRIGHTNESS)<-c("Lim inf","Lim sup","MC","ni","hi(%)","Ni asc","Ni desc","Hi asc(%)","Hi desc(%)")
#Crear fila de totales
totales<-c(Li="TOTAL",
Ls="-",
Mc="-",
ni = sum(as.numeric(TDFBRIGHTNESS$ni)),
hi = sum(as.numeric(TDFBRIGHTNESS$hi) * 100),
Ni_asc="-",
Ni_desc="-",
Hi_asc="-",
Hi_desc="-")
TDFBRIGHTNESS<-rbind(TDFBRIGHTNESS,totales)
library(knitr)
library(kableExtra)
library(knitr)
library(kableExtra)
kable(TDFBRIGHTNESS, align = 'c', caption = "Tabla de Frecuencias de la Temp de Brillo VIIRS I-4") %>%
kable_styling(full_width = FALSE, position = "center", bootstrap_options = c("striped", "hover", "condensed"))| Lim inf | Lim sup | MC | ni | hi(%) | Ni asc | Ni desc | Hi asc(%) | Hi desc(%) |
|---|---|---|---|---|---|---|---|---|
| 200 | 220 | 210 | 3 | 0.01 | 3 | 22476 | 0.01 | 100 |
| 220 | 240 | 230 | 0 | 0 | 3 | 22473 | 0.01 | 99.99 |
| 240 | 260 | 250 | 0 | 0 | 3 | 22473 | 0.01 | 99.99 |
| 260 | 280 | 270 | 1 | 0 | 4 | 22473 | 0.02 | 99.99 |
| 280 | 300 | 290 | 628 | 2.79 | 632 | 22472 | 2.81 | 99.98 |
| 300 | 320 | 310 | 2023 | 9 | 2655 | 21844 | 11.81 | 97.19 |
| 320 | 340 | 330 | 12234 | 54.43 | 14889 | 19821 | 66.24 | 88.19 |
| 340 | 360 | 350 | 6849 | 30.47 | 21738 | 7587 | 96.72 | 33.76 |
| 360 | 380 | 370 | 738 | 3.28 | 22476 | 738 | 100 | 3.28 |
| TOTAL |
|
|
22476 | 9998 |
|
|
|
|
#Gráficas
#Histograma
hist(BRIGHTNESS,breaks = 10,
main = "Gráfica N°13.1: Distribución para la
Temp de Brillo VIIRS I-4",
xlab = "Brillo VIIRS I-4(%)",
ylab = "Cantidad",
ylim = c(0,max(ni)),
col = "blue",
cex.main=0.9,
cex.lab=1,
cex.axis=0.9,
xaxt="n")
axis(1,at=Hist_BRIGHTNESS$breaks,labels = Hist_BRIGHTNESS$breaks,las=1,
cex.axis=0.9)
#Gráfica Global
hist(BRIGHTNESS, breaks = 10,
main = "Gráfica N°13.2: Distribución para la
Temp de Brillo VIIRS I-4",
xlab = "Brillo VIIRS I-4 (%)",
ylab = "Cantidad",
ylim = c(0, length(BRIGHTNESS)),
col = "green",
cex.main = 0.9,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_BRIGHTNESS$breaks,
labels = Hist_BRIGHTNESS$breaks, las = 1,
cex.axis = 0.9)
# Filtrar solo las filas numéricas (excluyendo la fila "TOTAL")
datos_grafico <- TDFBRIGHTNESS[!TDFBRIGHTNESS$MC %in% c("-", "TOTAL"), ]
# Convertir 'hi' a numérico
hi_numerico <- as.numeric(datos_grafico$hi)
barplot(hi_numerico,
space = 0,
col = "skyblue",
main = "Gráfica N°13.3: Distribución porcentual de frecuencias
relativas para la Temp de Brillo VIIRS I-4",
xlab = "Brillo VIIRS I-4",
ylab = "Porcentaje (%)",
names.arg = datos_grafico$MC,
ylim = c(0, 100))
# Local
hist(BRIGHTNESS, breaks = 10,
main = "Gráfica N°13.4: Distribución para Temp de Brillo VIIRS I-4 ",
xlab = "Brillo VIIRS I-4 (%)",
ylab = "Cantidad",
ylim = c(0,max(ni)),
col = "yellow",
cex.main = 0.9,
cex.lab = 1,
cex.axis = 0.9,
xaxt = "n")
axis(1, at = Hist_BRIGHTNESS$breaks,
labels = Hist_BRIGHTNESS$breaks, las = 1,
cex.axis = 0.9)
# Filtrar filas válidas (excluir "TOTAL")
datos_validos <- TDFBRIGHTNESS[!TDFBRIGHTNESS$MC %in% c("-", "TOTAL"), ]
# Convertir 'hi' a numérico
hi_valores <- as.numeric(datos_validos$hi)
barplot(hi_valores,
space = 0,
col = "brown",
main = "Gráfica N°13.5: Distribución para la Temp de Brillo VIIRS I-4",
xlab = "Brillo VIIRS I-4 (%)",
ylab = "Porcentaje (%)",
ylim = c(0, 60),
names.arg = datos_validos$MC)
# Diagrama de Ojiva Ascendente y Descendente
plot(Li ,Ni_desc,
main = "Gráfica N°13.6: Distribución de frecuencias Ascendente y descendente
para la Temp de Brillo VIIRS I-4",
xlab = " Brillo VIIRS I-4 (%)",
ylab = "Cantidad",
xlim = c(0,900),
col = "red",
cex.axis=0.8,
type = "o",
lwd = 3,
las=1,
xaxt="n")
lines(Ls,Ni_asc,
col = "green",
type = "o",
lwd = 3)
axis(1, at = seq(0, 900, by = 50))
# Diagrama de Ojiva Ascendente y Descendente Porcentual
plot(Li, Hi_desc * 100,
main = "Gráfica N°13.7: Distribución de frecuencia Ascendente y Descendente porcentual
para la Temp de Brillo VIIRS I-4 ",
xlab = " Brillo VIIRS I-4(%)",
ylab = "Porcentaje (%)",
xlim = c(0,900),
col = "red",
type = "o",
lwd = 2,
xaxt="n")
lines(Ls, Hi_asc * 100,
col = "blue",
type = "o",
lwd = 3)
axis(1, at = seq(0,900,by=50))
# Diagrama de Caja
boxplot(BRIGHTNESS,
horizontal = TRUE,
main = "Gráfica N°13.8:Distribución de frecuencia para la Temp de Brillo VIIRS I-4 ",
xlab = " Tasa de contaminante(%)",
col = "pink",
outline = TRUE,
pch = 1)
# INDICADORES ESTADISTICOS
# Indicadores de Tendencia Central
# Media aritmética
media <- round(mean(BRIGHTNESS), 2)
media## [1] 335.3# Moda
max_ni <- max(TDFBRIGHTNESS$ni)
moda <- TDFBRIGHTNESS$MC[TDFBRIGHTNESS$ni == max_ni]
moda## [1] "370"# Mediana
mediana <- median(BRIGHTNESS)
mediana## [1] 336.15# INDICADORES DE DISPERSIÓN #
# Varianza
varianza <- var(BRIGHTNESS)
varianza## [1] 190.8931# Desviación Estándar
sd <- sd(BRIGHTNESS)
sd## [1] 13.81641# Coeficiente de Variación
cv <- round((sd / media) * 100, 2)
cv## [1] 4.12# INDICADORES DE FORMA #
# Asimetría
library(e1071)
asimetria <- skewness(BRIGHTNESS, type = 2)
asimetria## [1] -0.8529796#Curtosis
curtosis <- kurtosis(BRIGHTNESS)
curtosis## [1] 2.368189tabla_indicadores <- data.frame("Variable" =c("Brillo VIIRS I-4 (%)"),
"Rango" = c("[1.1;9.99]"),
"X" = c(media),
"Me" = c(round(mediana,2)),
"Mo" = c("No hay moda"),
"V" = c(round(varianza,2)),
"Sd" = c(round(sd,2)),
"Cv" = c(cv),
"As" = c(round(asimetria,4)),
"K" = c(round(curtosis,2)),
"Valores Atipicos" = "No hay presencia de valores atipicos")
tabla_indicadores <- data.frame(
Indicador = c("Mínimo", "Máximo", "Media", "Desviación estándar"),
Valor = c(
min(as.numeric(TDFBRIGHTNESS$MC), na.rm = TRUE),
max(as.numeric(TDFBRIGHTNESS$MC), na.rm = TRUE),
mean(as.numeric(TDFBRIGHTNESS$MC), na.rm = TRUE),
sd(as.numeric(TDFBRIGHTNESS$MC), na.rm = TRUE)
)
)## Warning in data.frame(Indicador = c("Mínimo", "Máximo", "Media", "Desviación
## estándar"), : NAs introduced by coercion
## Warning in data.frame(Indicador = c("Mínimo", "Máximo", "Media", "Desviación
## estándar"), : NAs introduced by coercion## Warning in mean(as.numeric(TDFBRIGHTNESS$MC), na.rm = TRUE): NAs introduced by
## coercion## Warning in is.data.frame(x): NAs introduced by coerciontabla_indicadores <- data.frame("Variable" =c("Brillo VIIRS I-4(%)"),
"Rango" = c("[1.1;9.99]"),
"X" = c(media),
"Me" = c(round(mediana,2)),
"Mo" = c("No hay moda"),
"V" = c(round(varianza,2)),
"Sd" = c(round(sd,2)),
"Cv" = c(cv),
"As" = c(round(asimetria,4)),
"K" = c(round(curtosis,2)),
"Valores Atipicos" = "No hay presencia de valores atipicos")
library(knitr)
kable(tabla_indicadores, align = 'c', caption = "Conclusiones de la variable de Temp de Brillo VIIRS I-4 ")| Variable | Rango | X | Me | Mo | V | Sd | Cv | As | K | Valores.Atipicos |
|---|---|---|---|---|---|---|---|---|---|---|
| Brillo VIIRS I-4(%) | [1.1;9.99] | 335.3 | 336.15 | No hay moda | 190.89 | 13.82 | 4.12 | -0.853 | 2.37 | No hay presencia de valores atipicos |