IMPORTAR DATOS

WORKSPACE

load("C:/Users/sara-/OneDrive - Universidad EAFIT/2024-1/PI2/datos_actualziados.RData")

VARIABLES IMPORTANTES

SE FILTRAN PARA DEJAR LAS COMUNAS CON LAS QUE VAMOS A TRABAJAR

letal<-dataframe_prioridad_sin_nulos

comunas_reales_2<- c('Vitacura', 'Las Condes', 'Providencia', 'Lo Barnechea', 'La Reina', 
                   'Nunoa', 'San Miguel', 'Macul', 'Quilicura', 'Santiago', 'Huechuraba',
                   'Maipu', 'La Florida', 'Penalolen', 'Puente Alto', 'Cerrillos', 
                   'Pudahuel', 'La Cisterna', 'Renca', 'Pedro Aguirre Cerda', 
                   'Estacion Central', 'La Granja', 'Quinta Normal', 'Independencia',
                   'Recoleta', 'El Bosque', 'San Bernardo', 'San Joaquin', 'Lo Prado',
                   'Conchali', 'San Ramon', 'Cerro Navia', 'Lo Espejo', 'La Pintana')

# Filtrar el DataFrame para mantener solo las filas con valores permitidos en la primera columna
datos_prioridad_comunas_reales <- subset(dataframe_prioridad_comunas, dataframe_prioridad_comunas$Comuna %in% comunas_reales)

# Filtrar el DataFrame para solo dejar las comunas con valores en hacinamiento
con_comunas <- subset(regiones_y_comunas, regiones_y_comunas$comuna_nom %in% comunas_reales)

hacinamieto_comuna <- con_comunas$hacinamiento
#Regresión de datos funcionales-<Parte matemática
comunas_con_hacinamiento <- con_comunas$comuna_nom

#Filtramos para solo dejar las comunas que tienen valor en hacinamiento
datos_prioridad_comunas_hacinamiento <- subset(dataframe_prioridad_comunas, dataframe_prioridad_comunas$Comuna %in% comunas_con_hacinamiento)

#Filtrar las de hacinamiento
datos_con_hacinamiento <- subset(regiones_y_comunas, regiones_y_comunas$comuna_nom %in% comunas_con_hacinamiento)


dactH=datos_con_hacinamiento
dact=datos_prioridad_comunas_hacinamiento
dat=dias

Prio=dact$Prioridad

SE ASIGNAN NÚMEROS A LAS PRIORIDADES

Se asignan números a las prioridades de las comunas haciendo agrupaciones

Prioaux=rep(0,length(Prio))
Prioaux[Prio=="Sin Prioridad"]=1
Prioaux[Prio=="Baja Prioridad"]=2
Prioaux[Prio=="Media Baja Prioridad"]=3
Prioaux[Prio=="Media Alta Prioridad"]=4
Prioaux[Prio=="Alta Prioridad"]=5
Prioaux=sort(Prioaux)
Prioaux[Prioaux==1]="Sin Prioridad"
Prioaux[Prioaux==2]="Baja Prioridad"
Prioaux[Prioaux==3]="Media Baja Prioridad"
Prioaux[Prioaux==4]="Media Alta Prioridad"
Prioaux[Prioaux==5]="Alta Prioridad"
datact=data.frame(
  "prio"=Prioaux, 
  "comuna" = dact$Comuna 
  
)

SUAVIZADO

Se realiza el suavizado a los datos funcionales para una mejor obtención de gráficas

d.f=dact[,2:290]*1000
row.names(d.f)=dact$Comuna
fdact=fdata(d.f, argvals = dat$Dias, rangeval = c(1,1016))
#suavizando
out1<-optim.basis(fdact,type.CV=CV.S)
bsp<-create.bspline.basis(fdact$rangeval,nbasis=out1$numbasis.opt)
S.bsp  <-  S.basis(fdact$argvals, bsp)
sfda<-fdact
sfda$data<-fdact$data%*%S.bsp

GRAFICA VELOCIDAD DE CONTAGIO

x.d1 <- fdata.deriv(sfda)
plot(x.d1)

GRÁFICA CONTAGIOS

plot(abs(sfda))

#abline(h=0,lwd=2)

plot(t(dat),dact[2,2:290],type = "l")
for (i in 2:34){
  lines(t(dat),dact[i,2:290],type = "l")}

split.fdata<-function(x,f,drop=FALSE,...){
  if (!is.factor(f)) f<-factor(f)
  nlev<-nlevels(f)
  lev<-levels(f)
  if (is.matrix(x$data)) x$data<-data.frame(x$data)
  if (is.fdata(x)) {
    out<-split(x$data,f,drop=drop,...)
  }
  for (i in 1:nlev) out[[lev[i]]]<-fdata(out[[lev[i]]],x$argvals,x$rangeval,x$names)
  out
}

TEST DE PERMUTACIÓN Se quiere ver si hay una diferencia significativa entre las comunas priorizadas y las no priorizadas

Prioaux[Prio=="Sin Prioridad"]=0
Prioaux[Prio=="Baja Prioridad"]=1
Prioaux[Prio=="Media Baja Prioridad"]=1
Prioaux[Prio=="Media Alta Prioridad"]=1
Prioaux[Prio=="Alta Prioridad"]=1

l1<-split.fdata(fdact,Prioaux)
plot(l1[[1]],col=1,ylim=c(0,10),lty="dotted")
lines(l1[[2]],col=2,lty="dotted")
lines(mean(l1[[1]]),lwd=2,col=1)
lines(mean(l1[[2]]),lwd=2,col=2)

dev.off()
## null device 
##           1
temp.fd1=fdata2fd(l1[[1]])
temp.fd2=fdata2fd(l1[[2]])

#Test de permutación
dif.test=tperm.fd(temp.fd1,temp.fd2,q=0.1) 
for (i in 1:length(dif.test$Tvals)){
  if (dif.test$Tvals[i] >= dif.test$qval){
    abline(v=dif.test$argvals[i])
    print(dif.test$argvals[i]) 
    
  }
}
## [1] 51.75
## [1] 72.05
## [1] 82.2
## [1] 325.8
## [1] 335.95
## [1] 386.7
## [1] 396.85
## [1] 407
## [1] 417.15
## [1] 599.85
## [1] 610
## [1] 711.5
## [1] 721.65
## [1] 731.8
## [1] 741.95
## [1] 752.1
## [1] 762.25
## [1] 772.4
## [1] 782.55
## [1] 792.7
## [1] 802.85
dif.test=tperm.fd(temp.fd1,temp.fd2,q=0.1) 
abline(v=50)
abline(v=88)
abline(v=326.7)
#abline(v=341.6)
#abline(v=380)
abline(v=422)
abline(v=599)
abline(v=615.5)
abline(v=713)
abline(v=805)

GRÁFICA CONTAGIOS CON RANGOS DE DIFERENCIA SIGNIFICATIVA DE CONTAGIOS ENTRE COMUNAS PRIORIZADAS Y NO PRIORIZADAS

# Asignar colores según la prioridad
# Asignar colores según la prioridad
Prioaux[Prio=="Sin Prioridad"] = 0
Prioaux[Prio=="Baja Prioridad"] = 1
Prioaux[Prio=="Media Baja Prioridad"] = 1
Prioaux[Prio=="Media Alta Prioridad"] = 1 
Prioaux[Prio=="Alta Prioridad"] = 1

colors <- ifelse(Prioaux == 0, "blue", "red")

# Plot con colores y leyenda
plot(abs(sfda), col = colors, main = "Contagios por comunas con prioridad y sin prioridad")
abline(v=50)
abline(v=88)
abline(v=326.7)
abline(v=422)
abline(v=599)
abline(v=615.5)
abline(v=713)
abline(v=805)

# Añadir línea punteada en la posición 280 y etiquetarla
abline(v=280, col="orange", lty=2)
text(280, max(abs(sfda)), "Inicio Vacunación", pos=4, col="green", cex=0.7)

# Añadir leyenda
legend("topright", legend=c("Sin Prioridad", "Con Prioridad"), fill=c("blue", "red"))

GRÁFICA VELOCIDAD POR PRIORIDAD

Prioaux[Prio=="Sin Prioridad"]=0
Prioaux[Prio=="Baja Prioridad"]=1
Prioaux[Prio=="Media Baja Prioridad"]=1
Prioaux[Prio=="Media Alta Prioridad"]=1
Prioaux[Prio=="Alta Prioridad"]=1

l1<-split.fdata(x.d1,Prioaux)

#dev.off()
plot(l1[[1]],col=1,ylim=c(-0.4,0.4),lty="dotted")
lines(l1[[2]],col=2,lty="dotted")
lines(mean(l1[[1]]),lwd=2,col=1)
lines(mean(l1[[2]]),lwd=2,col=2)

TEST DE PERMUTACIÓN VELOCIDADES DE CONTAGIO

temp.fd1=fdata2fd(l1[[1]])
temp.fd2=fdata2fd(l1[[2]])

#Test de permutación
dif.test=tperm.fd(temp.fd1,temp.fd2,q=0.1) 
for (i in 1:length(dif.test$Tvals)){
  if (dif.test$Tvals[i] >= dif.test$qval){
    abline(v=dif.test$argvals[i])
    print(dif.test$argvals[i]) 
    
  }
}

## [1] 31.45
## [1] 51.75
## [1] 92.35
## [1] 102.5
## [1] 376.55
## [1] 447.6
## [1] 518.65
## [1] 589.7
## [1] 620.15
## [1] 863.75
## [1] 873.9
dif.test=tperm.fd(temp.fd1,temp.fd2,q=0.1) 
abline(v=50)
abline(v=88)
abline(v=326.7)
#abline(v=341.6)
#abline(v=380)
abline(v=422)
abline(v=599)
abline(v=615.5)
abline(v=713)
abline(v=805)

# x.d1 #Velocidad de contagio fd1 <- fda(x.d1, argvals = dat$Dias, rangeval = c(1, 1016))

Crear un objeto fdact para el hacinamiento

d.f <- dactH\(hacinamiento fdact <- fda(d.f, argvals = dat\)Dias, rangeval = c(1, 1016))

Suavizar el hacinamiento utilizando splines

out1 <- optim.basis(fdact, type.CV = CV.S) bsp <- create.bspline.basis(fdact\(rangeval, nbasis = out1\)numbasis.opt) S.bsp <- S.basis(fdact\(argvals, bsp) sfda <- fdact sfda\)data <- fdact$data %*% S.bsp

Convertir las funciones suavizadas a objetos ‘fd’

fd2 <- fda(sfda, argvals = dat$Dias, rangeval = c(1, 1016))

Calcular la correlación funcional de Hájek

cor_hajek <- cor.fd(fd1, fd2, rho = “Hajek”) print(paste(“Correlación Funcional de Hájek:”, cor_hajek))