Introducción
Tenemos las tablas de interpolación en la nueva metodología de medición de la pobreza que se comenzó a implementar retroactivamente desde el 2013, que es la relevante, la oficial, y utilizamos dos metodologías de interpolación
casen_2006 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2006_c.rds")
casen_2006 <- mutate_if(casen_2006, is.factor, as.character)
casen_2009 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2009_c.rds")
casen_2009 <- mutate_if(casen_2009, is.factor, as.character)
casen_2011 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2011_c.rds")
casen_2011 <- mutate_if(casen_2011, is.factor, as.character)
casen_2013 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2013_c.rds")
casen_2013 <- mutate_if(casen_2013, is.factor, as.character)
casen_2015 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2015_c.rds")
casen_2015 <- mutate_if(casen_2015, is.factor, as.character)
casen_2017 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2017_c.rds")
casen_2017 <- mutate_if(casen_2017, is.factor, as.character)
casen_2020 <- readRDS(file = "C:/Users/enamo/Desktop/Shiny-R/Casen_en_pandemia_2020/casen/casen_2020_c.rds")
casen_2020 <- mutate_if(casen_2020, is.factor, as.character)Tabla de pobreza
casen_2006$CORTE[casen_2006$CORTE == "Pobre no indigente"] <- "Pobre"
casen_2006$CORTE[casen_2006$CORTE == "Indigente"] <- "Pobre extremo"
casen_2009$CORTE[casen_2009$CORTE == "Pobre no Indigente"] <- "Pobre"
casen_2009$CORTE[casen_2009$CORTE == "Indigente"] <- "Pobre extremo"
casen_2011$corte[casen_2011$corte == "Pobreza extrema"] <- "Pobre extremo"
casen_2013$pobreza_MN[casen_2013$pobreza_MN == "Pobres no extremos"] <- "Pobre"
casen_2013$pobreza_MN[casen_2013$pobreza_MN == "No pobres"] <- "No pobre"
casen_2013$pobreza_MN[casen_2013$pobreza_MN == "Pobres extremos"] <- "Pobre extremo"
casen_2015$pobreza[casen_2015$pobreza == "Pobres no extremos"] <- "Pobre"
casen_2015$pobreza[casen_2015$pobreza == "No pobres"] <- "No pobre"
casen_2015$pobreza[casen_2015$pobreza == "Pobres extremos"] <- "Pobre extremo"
casen_2017$pobreza[casen_2017$pobreza == "Pobres no extremos"] <- "Pobre"
casen_2017$pobreza[casen_2017$pobreza == "No pobres"] <- "No pobre"
casen_2017$pobreza[casen_2017$pobreza == "Pobres extremos"] <- "Pobre extremo"
casen_2020$pobreza[casen_2020$pobreza == "Pobres no extremos"] <- "Pobre"
casen_2020$pobreza[casen_2020$pobreza == "No pobres"] <- "No pobre"
casen_2020$pobreza[casen_2020$pobreza == "Pobres extremos"] <- "Pobre extremo"receptaculo <- data.frame(
lugar = c(seq(1,3))
)
for (i in 1:7) {
switch(i,
case = casen <- casen_2006,
case = casen <- casen_2009,
case = casen <- casen_2011,
case = casen <- casen_2013,
case = casen <- casen_2015,
case = casen <- casen_2017,
case = casen <- casen_2020
)
expan <-switch(i,"EXPC","EXPC","expc_full","expc","expc_todas","expc","expc")
var1 <-switch(i,"CORTE","CORTE","corte","pobreza_MN","pobreza","pobreza","pobreza")
################ si solo son 2 categorias no hay que modificar esta seccion
tabla_matp <-xtabs(casen[,(expan)]~casen[,(var1)], data = casen)
tabla_matp <- as.data.frame(tabla_matp)
# print(tabla_matp)
receptaculo <- cbind(receptaculo,tabla_matp)
}
receptaculo <- receptaculo[,-c(1,4,6,8,10,12,14)]
colnames(receptaculo) <- c("Variable","2006","2009","2011","2013","2015","2017","2020")
tabla_t <- receptaculo
tabla_t$a2007 <- NA
tabla_t$a2008 <- NA
tabla_t$a2010 <- NA
tabla_t$a2012 <- NA
tabla_t$a2014 <- NA
tabla_t$a2016 <- NA
tabla_t$a2018 <- NA
tabla_t$a2019 <- NA
tabla_t <- tabla_t[,c("Variable","2006","a2007","a2008","2009","a2010","2011","a2012","2013","a2014","2015","a2016","2017","a2018","a2019","2020" )]approx (x, y = NULL, xout, method = “linear”, n = 50, yleft, yright, rule = 1, f = 0, ties = mean, na.rm = TRUE)
approxfun(x, y = NULL, method = “linear”, yleft, yright, rule = 1, f = 0, ties = mean, na.rm = TRUE)
Argumentos x, y
vectores numéricos que dan las coordenadas de los puntos a interpolar. Alternativamente, se puede especificar una única estructura de trazado: ver xy.coords.
xout
un conjunto opcional de valores numéricos que especifican dónde se llevará a cabo la interpolación.
method
especifica el método de interpolación que se utilizará. Las opciones son “linear”o “constant”.
n
Si xoutno se especifica, la interpolación tiene lugar en npuntos igualmente espaciados que abarcan el intervalo [ min(x), max(x)].
yleft
el valor que se devolverá cuando los xvalores de entrada sean menores que min(x). El valor predeterminado se define por el valor de ruledado a continuación.
yright
el valor que se devolverá cuando los xvalores de entrada sean mayores que max(x). El valor predeterminado se define por el valor de ruledado a continuación.
rule
un número entero (de longitud 1 o 2) que describe cómo se producirá la interpolación fuera del intervalo [ min(x), max(x)]. Si rulees, 1entonces NAse devuelven s para dichos puntos y, si es así 2, se usa el valor en el extremo de datos más cercano. Utilice, por ejemplo, rule = 2:1si la extrapolación del lado izquierdo y derecho debe diferir.
f
para method = “constant”un número entre 0 y 1 inclusive, lo que indica un compromiso entre las funciones escalonadas continuas izquierda y derecha. Si y0y y1son los valores a la izquierda y a la derecha del punto, entonces el valor es y0si f == 0, y1si f == 1y y0(1-f)+y1fpara valores intermedios. De esta manera, el resultado es continuo a la derecha para f == 0y continuo a la izquierda para f == 1, incluso para yvalores no finitos .
ties
manejo de xvalores vinculados . La cadena “ordered”o una función (o el nombre de una función) toma un único argumento de vector y devuelve un solo número o uno listde ambos, por ejemplo list(“ordered”, mean), consulte ‘Detalles’.
na.rm
lógico que especifica cómo se NAdeben manejar los valores perdidos . Configuración na.rm=FALSEse propagará NAEs en ycon los valores interpolados, dependiendo también del ruleconjunto. Tenga en cuenta que, en este caso, los NA’in x no son válidos, consulte también los ejemplos.
na.approx
Tenemos la tabla no nueva metodología de medición y su interpolación
receptaculo <- data.frame()
for (n in 1:nrow(tabla_t)) {
calculado <- na.approx(c(tabla_t[n,c(2:ncol(tabla_t))]))
receptaculo <- rbind(receptaculo,calculado)
}
receptaculo <- cbind(tabla_t$Variable,receptaculo)
colnames(receptaculo) <- c("categorias",paste(seq(2006,2020,1)))
################
datatable(receptaculo, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'ruralidad'),
list(extend='pdf',
filename= 'ruralidad')),
text = 'Download')), scrollX = TRUE))%>%
formatRound(columns=c(paste(seq(2006,2020,1))) ,mark = "", digits=0)dt4 <- receptaculo
dt5 <- dt4
dt5 <- as.data.frame(t(dt4))
dt5 <- cbind(data.frame(rownames(dt5)),dt5)
colnames(dt5) <- c(paste0(dt5[1,]))
dt5 <- dt5[-1,]na.spline
receptaculo <- data.frame()
for (n in 1:nrow(tabla_t)) {
calculado <- na.spline(c(tabla_t[n,c(2:ncol(tabla_t))]))
receptaculo <- rbind(receptaculo,calculado)
}
receptaculo <- cbind(tabla_t$Variable,receptaculo)
colnames(receptaculo) <- c("categorias",paste(seq(2006,2020,1)))
################
datatable(receptaculo, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'ruralidad'),
list(extend='pdf',
filename= 'ruralidad')),
text = 'Download')), scrollX = TRUE))%>%
formatRound(columns=c(paste(seq(2006,2020,1))) ,mark = "", digits=0)dt4 <- receptaculo
dt6 <- dt4
dt6 <- as.data.frame(t(dt4))
dt6 <- cbind(data.frame(rownames(dt6)),dt6)
colnames(dt6) <- c(paste0(dt6[1,]))
dt6 <- dt6[-1,]na.approx
No pobre
ggplot(dt5, aes(x=categorias, y=`No pobre`)) + geom_bar(stat="identity")
Pobre
ggplot(dt5, aes(x=categorias, y=Pobre)) + geom_bar(stat="identity")
Pobre extremo
ggplot(dt5, aes(x=categorias, y=`Pobre extremo`)) + geom_bar(stat="identity")
na.spline
No pobre
ggplot(dt6, aes(x=categorias, y=`No pobre`)) + geom_bar(stat="identity")
Pobre
ggplot(dt6, aes(x=categorias, y=Pobre)) + geom_bar(stat="identity")
Pobre extremo
ggplot(dt6, aes(x=categorias, y=`Pobre extremo`)) + geom_bar(stat="identity")
RL
receptaculo <- data.frame(
Variable = c("No pobre","Pobre","Pobre extremo")
)
for (i in 1:7) {
switch(i,
case = casen <- casen_2006,
case = casen <- casen_2009,
case = casen <- casen_2011,
case = casen <- casen_2013,
case = casen <- casen_2015,
case = casen <- casen_2017,
case = casen <- casen_2020
)
expan <-switch(i,"EXPC","EXPC","expc_full","expc","expc_todas","expc","expc")
var1 <-switch(i,"CORTE","CORTE","corte","pobreza_MN","pobreza","pobreza","pobreza")
tabla_matp <-xtabs(casen[,(expan)]~casen[,(var1)], data = casen)
tabla_matp <- as.data.frame(tabla_matp)
receptaculo <- cbind(receptaculo,tabla_matp[,2])
}
tablav <- as.data.frame(t(receptaculo), row.names = F)
colnames(tablav) <- tablav[1,]
tablav <- tablav[-1,]
tablav$año <- c("2006","2009","2011","2013","2015","2017","2020")
tablav <- mutate_if(tablav, is.character, as.numeric)
dt1 <- data.frame()
dt2 <- data.frame()
dt3 <- data.frame()
linearMod_1 <- lm(`No pobre` ~ año, data=tablav)
linearMod_2 <- lm(Pobre ~ año, data=tablav)
linearMod_3 <- lm(`Pobre extremo` ~ año, data=tablav)
for (n in seq(2006,2020,1)) {
p1 <- linearMod_1$coefficients[1]+linearMod_1$coefficients[2]*n
dt1 <- rbind(dt1,p1)
p2 <- linearMod_2$coefficients[1]+linearMod_2$coefficients[2]*n
dt2 <- rbind(dt2,p2)
p3 <- linearMod_3$coefficients[1]+linearMod_3$coefficients[2]*n
dt3 <- rbind(dt3,p3)
dt4 <- cbind(dt1,dt2,dt3)
}
dt4 <- as.data.frame(t(dt4))
colnames(dt4) <- seq(2006,2020,1)
dt4 <- cbind(data.frame(c("No pobre","Pobre","Pobre extremo")),dt4)
names(dt4)[1] <- "Pobreza"
datatable(dt4, extensions = 'Buttons', escape = FALSE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'ruralidad'),
list(extend='pdf',
filename= 'ruralidad')),
text = 'Download')), scrollX = TRUE))%>%
formatRound(columns=c(paste(seq(2006,2020,1))) ,mark = "", digits=0)dt7 <- dt4
dt7 <- as.data.frame(t(dt4))
dt7 <- cbind(data.frame(rownames(dt7)),dt7)
colnames(dt7) <- c(paste0(dt7[1,]))
dt7 <- dt7[-1,]
p <- plot_ly(dt7, width = 1200, x = ~Pobreza, y = ~`No pobre`, name = 'No pobre rl', mode = 'markers') %>% add_lines()
ptatbla1 <- cbind(dt5,dt7[,-1])
colnames(tatbla1) <- c("categorias","No pobre a", "Pobre a", "Pobre extremo a","No pobre b", "Pobre b", "Pobre extremo b")na.approx
No pobre
p <- plot_ly(tatbla1, width = 1200, x = ~categorias, y = ~`No pobre a`, name = 'No pobre interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`No pobre b`, name = "No pobre rl", mode = 'markers')
pPobre
p <- plot_ly(tatbla1, width = 1200, x = ~categorias, y = ~`Pobre a`, name = 'Pobre interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`Pobre b`, name = "Pobre rl", mode = 'markers')
pPobre extremo
p <- plot_ly(tatbla1, width = 1200, x = ~categorias, y = ~`Pobre extremo a`, name = 'Pobre extremo interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`Pobre extremo b`, name = "Pobre extremo rl", mode = 'markers')
pNueva metodologia
2006
Base de datos Complementaria de Ingresos Nueva Metodología Casen 2006 SPSS
casen_2006$clave <- paste0(casen_2006$SEG,casen_2006$O,casen_2006$F)
MN_2006 <- read.spss("C:/Users/enamo/Desktop/Shiny-R/comprobacion_Abner/Ingresos MN 2006.sav", to.data.frame = TRUE)
MN_2006$clave <- paste0(MN_2006$seg,MN_2006$o,MN_2006$f)
MN_2006_2 <- MN_2006[,c("clave","pobreza_MN")]
casen_2006 <- merge(x= casen_2006, y= MN_2006_2, by="clave")
casen_2006 <- mutate_if(casen_2006, is.factor, as.character)2009
Base de datos Complementaria de Ingresos Nueva Metodología Casen 2009 SPSS
casen_2009$clave <- paste0(casen_2009$SEGMENTO,casen_2009$IDVIV,casen_2009$HOGAR,casen_2009$O)
MN_2009 <- read.spss("C:/Users/enamo/Desktop/Shiny-R/comprobacion_Abner/Ingresos MN 2009.sav", to.data.frame = TRUE)
MN_2009$clave <- paste0(MN_2009$SEGMENTO,MN_2009$IDVIV,MN_2009$HOGAR,MN_2009$O)
MN_2009_2 <- MN_2009[,c("clave","pobreza_MN")]
casen_2009 <- merge(x= casen_2009, y= MN_2009_2, by="clave")
casen_2009 <- mutate_if(casen_2009, is.factor, as.character) 2011
Base Complementaria Ingresos Nueva Metodología Casen 2011 (submuestra noviembre 2011-enero 2012) (Base 2011 utilizada para estimaciones de serie Casen) SPSS
casen_2011$clave <- paste0(casen_2011$folio,casen_2011$o)
MN_2011 <- read.spss("C:/Users/enamo/Desktop/Shiny-R/comprobacion_Abner/Ingresos MN 2011.sav", to.data.frame = TRUE)
MN_2011$clave <- paste0(MN_2011$folio,MN_2011$o )
MN_2011_2 <- MN_2011[,c("clave","pobreza_MN")]
casen_2011 <- merge(x= casen_2011, y= MN_2011_2, by="clave")
casen_2011 <- mutate_if(casen_2011, is.factor, as.character) casen_2006$pobreza_MN[casen_2006$pobreza_MN == "No pobres"] <- "No pobre"
casen_2006$pobreza_MN[casen_2006$pobreza_MN == "Pobres no extremos"] <- "Pobre"
casen_2006$pobreza_MN[casen_2006$pobreza_MN == "Pobres extremos"] <- "Pobre extremo"
casen_2009$pobreza_MN[casen_2009$pobreza_MN == "No pobres"] <- "No pobre"
casen_2009$pobreza_MN[casen_2009$pobreza_MN == "Pobres no extremos"] <- "Pobre"
casen_2009$pobreza_MN[casen_2009$pobreza_MN == "Pobres extremos"] <- "Pobre extremo"
casen_2011$pobreza_MN[casen_2011$pobreza_MN == "No pobres"] <- "No pobre"
casen_2011$pobreza_MN[casen_2011$pobreza_MN == "Pobres no extremos"] <- "Pobre"
casen_2011$pobreza_MN[casen_2011$pobreza_MN == "Pobres extremos"] <- "Pobre extremo"receptaculo <- data.frame(
lugar = c(seq(1,3))
)
for (i in 1:7) {
switch(i,
case = casen <- casen_2006,
case = casen <- casen_2009,
case = casen <- casen_2011,
case = casen <- casen_2013,
case = casen <- casen_2015,
case = casen <- casen_2017,
case = casen <- casen_2020
)
expan <-switch(i,"EXPC","EXPC","expc_full","expc","expc_todas","expc","expc")
var1 <-switch(i,"pobreza_MN","pobreza_MN","pobreza_MN","pobreza_MN","pobreza","pobreza","pobreza")
################ si solo son 2 categorias no hay que modificar esta seccion
tabla_matp <-xtabs(casen[,(expan)]~casen[,(var1)], data = casen)
tabla_matp <- as.data.frame(tabla_matp)
# print(tabla_matp)
receptaculo <- cbind(receptaculo,tabla_matp)
}
receptaculo <- receptaculo[,-c(1,4,6,8,10,12,14)]
colnames(receptaculo) <- c("Variable","2006","2009","2011","2013","2015","2017","2020")
tabla_t <- receptaculo
tabla_t$a2007 <- NA
tabla_t$a2008 <- NA
tabla_t$a2010 <- NA
tabla_t$a2012 <- NA
tabla_t$a2014 <- NA
tabla_t$a2016 <- NA
tabla_t$a2018 <- NA
tabla_t$a2019 <- NA
tabla_t <- tabla_t[,c("Variable","2006","a2007","a2008","2009","a2010","2011","a2012","2013","a2014","2015","a2016","2017","a2018","a2019","2020" )]na.approx
receptaculo <- data.frame()
for (n in 1:nrow(tabla_t)) {
calculado <- na.approx(c(tabla_t[n,c(2:ncol(tabla_t))]))
receptaculo <- rbind(receptaculo,calculado)
}
receptaculo <- cbind(tabla_t$Variable,receptaculo)
colnames(receptaculo) <- c("categorias",paste(seq(2006,2020,1)))
################
datatable(receptaculo, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'ruralidad'),
list(extend='pdf',
filename= 'ruralidad')),
text = 'Download')), scrollX = TRUE))%>%
formatRound(columns=c(paste(seq(2006,2020,1))) ,mark = "", digits=0)dt4 <- receptaculo
dt8 <- dt4
dt8 <- as.data.frame(t(dt4))
dt8 <- cbind(data.frame(rownames(dt8)),dt8)
colnames(dt8) <- c(paste0(dt8[1,]))
dt8 <- dt8[-1,]
tatbla2 <- cbind(dt8,dt7[,-1])
colnames(tatbla2) <- c("categorias","No pobre a", "Pobre a", "Pobre extremo a","No pobre b", "Pobre b", "Pobre extremo b")na.approx NM - rl
No pobre
p <- plot_ly(tatbla2, width = 1200, x = ~categorias, y = ~`No pobre a`, name = 'No pobre interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`No pobre b`, name = "No pobre rl", mode = 'markers')
pPobre
p <- plot_ly(tatbla2, width = 1200, x = ~categorias, y = ~`Pobre a`, name = 'Pobre interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`Pobre b`, name = "Pobre rl", mode = 'markers')
pPobre extremo
p <- plot_ly(tatbla2, width = 1200, x = ~categorias, y = ~`Pobre extremo a`, name = 'Pobre extremo interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`Pobre extremo b`, name = "Pobre extremo rl", mode = 'markers')
pna.spline
receptaculo <- data.frame()
for (n in 1:nrow(tabla_t)) {
calculado <- na.spline(c(tabla_t[n,c(2:ncol(tabla_t))]))
receptaculo <- rbind(receptaculo,calculado)
}
receptaculo <- cbind(tabla_t$Variable,receptaculo)
colnames(receptaculo) <- c("categorias",paste(seq(2006,2020,1)))
################
datatable(receptaculo, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'ruralidad'),
list(extend='pdf',
filename= 'ruralidad')),
text = 'Download')), scrollX = TRUE))%>%
formatRound(columns=c(paste(seq(2006,2020,1))) ,mark = "", digits=0)dt4 <- receptaculo
dt9 <- dt4
dt9 <- as.data.frame(t(dt4))
dt9 <- cbind(data.frame(rownames(dt9)),dt9)
colnames(dt9) <- c(paste0(dt9[1,]))
dt9 <- dt9[-1,]
tatbla3 <- cbind(dt9,dt7[,-1])
colnames(tatbla3) <- c("categorias","No pobre a", "Pobre a", "Pobre extremo a","No pobre b", "Pobre b", "Pobre extremo b")na.spline NM - rl
No pobre
p <- plot_ly(tatbla3, width = 1200, x = ~categorias, y = ~`No pobre a`, name = 'No pobre interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`No pobre b`, name = "No pobre rl", mode = 'markers')
pPobre
p <- plot_ly(tatbla3, width = 1200, x = ~categorias, y = ~`Pobre a`, name = 'Pobre interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`Pobre b`, name = "Pobre rl", mode = 'markers')
pPobre extremo
p <- plot_ly(tatbla3, width = 1200, x = ~categorias, y = ~`Pobre extremo a`, name = 'Pobre extremo interpolacion', mode = 'markers') %>% add_lines()
p <- p %>% add_lines(y = ~`Pobre extremo b`, name = "Pobre extremo rl", mode = 'markers')
p