Carga de datos

library(rio)
datos<-import("paises.xlsx")
names(datos)
[1] "country_name"                      
[2] "crecimiento_PIB_per_capita_%_anual"
[3] "esperanza_vida"                    
[4] "mejora_suministro_agua_urbano_%"   
[5] "prevalencia_anemia_%_menores_5"    
[6] "mortalidad_materna"                
[7] "mortalidad_menores_5"              
attach(datos)

Problema

Buscamos encontrar un suavizamiento para explorar la asociación entre la mortalidad materna y la prevalencia de la anemia entre menores a 5 años.

Span fijo

plot(`prevalencia_anemia_%_menores_5`,mortalidad_materna,main="Suavizamientos con span fijo", 
     las=1,
     ylab="Mortalidad materna",
     xlab="Prevalencia de Anemia en <5 años")
lines(supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span=0.05,bass=0),col="red")
lines(supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span=0.2,bass=0),col="green")
lines(supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span=0.5,bass=0),col="purple")
legend("topleft", c("5%", "20%", "50%"), fill=c("red", "green", "purple"),
       title = "Span")

Al usar un span fijo de 50% obtenemos una curva razonablemente suave. Con los otros spans la curvas tienen irregularidades poco prácticas.

Span variable

Se usa validación cruzada para la selección del span y se hace un extra-suavizamiento con el parámetro bass (0,5,10).

plot(`prevalencia_anemia_%_menores_5`,mortalidad_materna,main="Suavizamientos con span variable", 
     las=1,
     ylab="Mortalidad materna",
     xlab="Prevalencia de Anemia en <5 años")
lines(supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span="cv",bass=0),col="red")
lines(supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span="cv",bass=5),col="green")
lines(supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span="cv",bass=10),col="purple")
legend("topleft", c("0", "5", "10"), fill=c("red", "green", "purple"),
       title = "Bass")

Ya que no hay una diferencia gráfica significativa entre bass=5 y bass=10 tomamos el primero.

Comparación

  • Span fijo 50%
s<-supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span=.5,bass=0,trace=TRUE)
smooth(span= 0.5, iper=+1) -> (var, cvar) = (18772.1, 249570)
s2<-merge(datos,s,by.x="prevalencia_anemia_%_menores_5",by.y="x")
plot(s2$`prevalencia_anemia_%_menores_5`,s2$mortalidad_materna-s2$y)

plot(s2$mortalidad_materna,s2$y)

  • Span variable, bass=5
s<-supsmu(`prevalencia_anemia_%_menores_5`,mortalidad_materna,span="cv",bass=5,trace=TRUE)
smooth(span=0.05, iper=+1) -> (var, cvar) = (182.796, -4946.07)
smooth(span= 0.2, iper=-1) -> (var, cvar) = (2432.91, 9646.17)
smooth(span= 0.2, iper=+1) -> (var, cvar) = (2432.91, 40766.4)
smooth(span= 0.2, iper=-1) -> (var, cvar) = (2432.91, 14900.6)
smooth(span= 0.5, iper=+1) -> (var, cvar) = (18772.1, 249570)
smooth(span= 0.2, iper=-1) -> (var, cvar) = (2432.91, 10765.3)
smooth(span= 0.2, iper=-1) -> (var, cvar) = (2432.91, -5.12691)
smooth(span=0.05, iper=-1) -> (var, cvar) = (182.796, 2628.41)
s2<-merge(datos,s,by.x="prevalencia_anemia_%_menores_5",by.y="x")
plot(s2$`prevalencia_anemia_%_menores_5`,s2$mortalidad_materna-s2$y)

plot(s2$mortalidad_materna,s2$y)

No hay diferencias significativas entre ambos procedimientos

Conclusión

El suavizamiento más práctico, bajo el método del super-suavizamiento de Fiedman, resulta con un span fijo de 50%