Programacion Funcional

library(fs)
library(tidyverse)

── Attaching packages ────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
✔ ggplot2 3.2.0     ✔ purrr   0.3.2
✔ tibble  2.1.3     ✔ dplyr   0.8.3
✔ tidyr   0.8.3     ✔ stringr 1.4.0
✔ readr   1.3.1     ✔ forcats 0.4.0
── Conflicts ───────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter()  masks stats::filter()
✖ purrr::is_null() masks testthat::is_null()
✖ dplyr::lag()     masks stats::lag()
✖ dplyr::matches() masks testthat::matches()

library(openxlsx)
library(glue)

Attaching package: ‘glue’

The following object is masked from ‘package:dplyr’:

    collapse

bases_individuales_path <- dir_ls(path = '../fuentes/', regexp= 'individual')
bases_individuales_path

../fuentes/usu_individual_t119.txt ../fuentes/usu_individual_t418.txt 

leer_base_eph <- function(path) {
  read.table(path,sep=";", dec=",", header = TRUE, fill = TRUE) %>% 
    select(ANO4,TRIMESTRE,REGION,P21,CH04, CH06)
}

bases_df <- tibble(bases_individuales_path) %>%
  mutate(base = map(bases_individuales_path, leer_base_eph))

bases_df

bases_df <- bases_df %>% unnest()
bases_df

bases_df %>% 
  group_by(REGION) %>% 
  nest()

NA

lmfit <- lm(P21~factor(CH04)+CH06,data = bases_df)

summary(lmfit)

Call:
lm(formula = P21 ~ factor(CH04) + CH06, data = bases_df)

Residuals:
   Min     1Q Median     3Q    Max 
-15472  -6606  -3367   2148 590198 

Coefficients:
               Estimate Std. Error t value Pr(>|t|)    
(Intercept)    4853.196     74.509   65.14   <2e-16 ***
factor(CH04)2 -4063.112     72.200  -56.27   <2e-16 ***
CH06            103.095      1.612   63.97   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 12300 on 116784 degrees of freedom
Multiple R-squared:  0.05511,   Adjusted R-squared:  0.0551 
F-statistic:  3406 on 2 and 116784 DF,  p-value: < 2.2e-16

broom::tidy(lmfit)

resultados <- tibble()

for (region in unique(bases_df$REGION)) {
  
  data <- bases_df %>% 
    filter(REGION==region)
  
  lmfit <- lm(P21~factor(CH04)+CH06,data = data)
  
  lmtidy <- broom::tidy(lmfit)
  lmtidy$region <- region
  resultados <- bind_rows(resultados,lmtidy)

}

resultados

fun<-function(porcion,grupo) {  broom::tidy(lm(P21~factor(CH04)+CH06,data = porcion))}

bases_df_lm <- bases_df %>% 
  group_by(REGION) %>%
  nest() %>% 
  mutate(lm = map(data,fun))
bases_df_lm

bases_df_lm %>% 
  unnest(lm)

bases_df %>% 
  group_by(REGION) %>% 
  group_modify(fun)

fun<-function(porcion,grupo) {  lm(P21~factor(CH04)+CH06,data = porcion)}

bases_df %>% 
  group_by(REGION) %>%
  nest() %>%  
  mutate(lm = map(data,fun))

library(gapminder)


gapminder_unfiltered %>% 
  sample_n(10)

NA

data_argentina <- gapminder_unfiltered %>% 
  filter(country=='Argentina')

ggplot(data_argentina, aes(year, lifeExp, size= pop, color=gdpPercap))+
  geom_point()+
  geom_line(alpha=0.6)+
  labs(title = unique(data_argentina$country))

# definimos la función
graficar_pais <- function(data, pais){
  
  ggplot(data, aes(year, lifeExp, size= pop, color=gdpPercap))+
    geom_point()+
    geom_line(alpha=0.6)+
    labs(title = pais)
}

graficar_pais(data_argentina, 'Argentina')

gapminder_nest <- gapminder_unfiltered %>% 
  group_by(country) %>% 
  nest()

gapminder_nest %>% 
  sample_n(10)

NA

gapminder_nest <- gapminder_nest %>% 
  mutate(grafico= map2(.x = data, .y = country,.f =  graficar_pais))

gapminder_nest %>% 
  sample_n(10)

gapminder_nest$grafico[2]

[[1]]

pdf('../resultados/graficos_gapminder.pdf')
gapminder_nest$grafico
dev.off()

LS0tCnRpdGxlOiBQcm9ncmFtYWNpb24gRnVuY2lvbmFsCm91dHB1dDoKICBodG1sX25vdGVib29rOgogICAgdG9jOiB5ZXMKICAgIHRvY19mbG9hdDogeWVzCmRhdGU6ICIiCnN1YnRpdGxlOiBQcsOhY3RpY2EgR3VpYWRhCi0tLQoKYGBge3J9CmxpYnJhcnkoZnMpCmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KG9wZW54bHN4KQpsaWJyYXJ5KGdsdWUpCgpgYGAKCiMjIyBFamVtcGxvIDE6IEl0ZXJhbmRvIGVuIGxhIEVQSAoKTG8gcHJpbWVybyBxdWUgbmVjZXNpdGFtb3MgZXMgZGVmaW5pciB1biB2ZWN0b3IgbyBsaXN0YSBzb2JyZSBlbCBxdWUgaXRlcmFyLiAKClBvciBlamVtcGxvLCBwb2RlbW9zIGFybWFyIHVuIHZlY3RvciBjb24gbG9zIHBhdGggYSBsYXMgYmFzZXMgaW5kaXZpZHVhbGVzLCBjb24gZWwgY29tYW5kbyBgZnM6OmRpcl9sc2AKCmBgYHtyfQoKYmFzZXNfaW5kaXZpZHVhbGVzX3BhdGggPC0gZGlyX2xzKHBhdGggPSAnLi4vZnVlbnRlcy8nLCByZWdleHA9ICdpbmRpdmlkdWFsJykKYmFzZXNfaW5kaXZpZHVhbGVzX3BhdGgKYGBgCgpMdWVnbywgY29tbyBlbiBsYSBmdW5jacOzbiBxdWUgdXNhbW9zIHBhcmEgbGVlciBsYXMgYmFzZXMgZGVmaW5pbW9zIG11Y2hvcyBwYXJhbWV0cm9zLCBub3MgcG9kZW1vcyBhcm1hciB1bmEgZnVuY2nDs24gX3dyYXBwZXJfIHF1ZSBzw7NsbyBuZWNlc2l0ZSB1biBwYXLDoW1ldHJvLCB5IHF1ZSBzaW1wbGlmaXF1ZSBsYSBlc2NyaXR1cmEgZGVsIG1hcAoKYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KCmxlZXJfYmFzZV9lcGggPC0gZnVuY3Rpb24ocGF0aCkgewogIHJlYWQudGFibGUocGF0aCxzZXA9IjsiLCBkZWM9IiwiLCBoZWFkZXIgPSBUUlVFLCBmaWxsID0gVFJVRSkgJT4lIAogICAgc2VsZWN0KEFOTzQsVFJJTUVTVFJFLFJFR0lPTixQMjEsQ0gwNCwgQ0gwNikKfQoKYmFzZXNfZGYgPC0gdGliYmxlKGJhc2VzX2luZGl2aWR1YWxlc19wYXRoKSAlPiUKICBtdXRhdGUoYmFzZSA9IG1hcChiYXNlc19pbmRpdmlkdWFsZXNfcGF0aCwgbGVlcl9iYXNlX2VwaCkpCgpgYGAKCmBgYHtyfQpiYXNlc19kZgpgYGAKCkVsIHJlc3VsdGFkbyBlcyB1biBERiBkb25kZSBsYSBjb2x1bW5hIF9fYmFzZV9fIHRpZW5lIGVuIGNhZGEgZmlsYSwgb3RybyBERiBjb24gbGEgYmFzZSBkZSBsYSBFUEggZGUgZXNlIHBlcsOtb2RvLiBFc3RvIGVzIGxvIHF1ZSBsbGFtYW1vcyB1biBfbmVzdGVkIERGXyBvIGRhdGFmcmFtZSBuZXN0ZWFkbyBwYSBsZXMgcGliZXMuCgpTaSBxdWVyZW1vcyBqdW50YXIgdG9kbywgcG9kZW1vcyB1c2FyIGB1bm5lc3QoKWAKCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmJhc2VzX2RmIDwtIGJhc2VzX2RmICU+JSB1bm5lc3QoKQpiYXNlc19kZgpgYGAKCj4gwr9RdcOpIHBhc2Egc2kgbG9zIERGIHF1ZSB0ZW5lbW9zIG5lc3RlYWRvcyBubyB0aWVuZW4gbGEgbWlzbWEgY2FudGlkYWQgZGUgY29sdW1uYXM/CgoKRXN0byBtaXNtbyBsbyBwb2RlbW9zIHVzYXIgcGFyYSBmcmFnbWVudGFyIGVsIGRhdGFzdGV0IHBvciBhbGd1bmEgdmFyaWFibGUsIGNvbiBlbCBgZ3JvdXBfYnkoKWAKCgpgYGB7cn0KYmFzZXNfZGYgJT4lIAogIGdyb3VwX2J5KFJFR0lPTikgJT4lIAogIG5lc3QoKQoKYGBgCgpBc8OtLCBwYXJhIGNhZGEgcmVnacOzbiB0ZW5lbW9zIHVuIERGLgoKPiDCvyBEZSBxdcOpIHNpcnZlIHRvZG8gZXN0bz8KCk5vIHRvZG8gZW4gbGEgdmlkYSBlcyB1biBEYXRhZnJhbWUuIEhheSBlc3R1Y3R1cmFzIGRlIGRhdG9zIHF1ZSBubyBzZSBwdWVkZW4gbm9ybWFsaXphciBhIGZpbGFzIHkgY29sdW1uYXMuIEVuIGVzb3MgY2Fzb3MgcmVjdXJyw61hbW9zIHRyYWRpY2lvbmFsbWVudGUgYSBsb3MgbG9vcHMuIENvbiBNQVAgcG9kZW1vcyB0ZW5lciBsb3MgZWxlbWVudG9zIGFncnVwYWRvcyBlbiB1biBzw7NsbyBvYmpldG8geSBhw7puIGNvbnNlcnZhciBzdXMgZm9ybWFzIGRpZmVyZW50ZXMuCgojIyMgRWplbXBsbyAyLiBSZWdyZXNpw7NuIGxpbmVhbAoKU2kgYmllbiBubyBub3MgdmFtb3MgYSBtZXRlciBlbiBlbCBkZXRhbGxlIGRlbCBtb2RlbG8gbGluZWFsIGhveSwgZXMgw7p0aWwgdXNhcmxvIGNvbW8gZWplbXBsbyBkZSBsbyBxdWUgcG9kZW1vcyBoYWNlciBjb24gTUFQLgoKUGxhbnRlYW1vcyBlbCBtb2RlbG8gCiQkClAyMSA9IFxiZXRhXzAgKyBcYmV0YV8xKkNIMDQgKyBcYmV0YV8yKkNIMDYKJCQKT3NlYSwgdW4gbW9kbGVvIHF1ZSBleHBsaWNhIGVsIGluZ3Jlc28gc2Vnw7puIHNleG8geSBlZGFkCgoKYGBge3J9CgpsbWZpdCA8LSBsbShQMjF+ZmFjdG9yKENIMDQpK0NIMDYsZGF0YSA9IGJhc2VzX2RmKQoKc3VtbWFyeShsbWZpdCkKYGBgCihhbCBmaW5hbCBkZSBsYSBjbGFzZSBwb2RlbW9zIGNoYXJsYXIgc29icmUgbG9zIHJlc3VsdGFkb3MsIHNpIGhheSBpbnRlcsOpcyA6LSkgKQoKRGUgZm9ybWEgVGlkeSwgbGEgbGlicmVyw61hIGBicm9vbWAgbm9zIGRhIGxvcyByZXN1bHRhZG9zIGVuIHVuIERGLgoKYGBge3J9CmJyb29tOjp0aWR5KGxtZml0KQpgYGAKIAogU2kgbG8gcXVlcmVtb3MgaGFjZXIgcG9yIHJlZ2lvbgogCiAKIyMjIyBMb29wZWFuZG8KCmBgYHtyfQoKcmVzdWx0YWRvcyA8LSB0aWJibGUoKQoKZm9yIChyZWdpb24gaW4gdW5pcXVlKGJhc2VzX2RmJFJFR0lPTikpIHsKICAKICBkYXRhIDwtIGJhc2VzX2RmICU+JSAKICAgIGZpbHRlcihSRUdJT049PXJlZ2lvbikKICAKICBsbWZpdCA8LSBsbShQMjF+ZmFjdG9yKENIMDQpK0NIMDYsZGF0YSA9IGRhdGEpCiAgCiAgbG10aWR5IDwtIGJyb29tOjp0aWR5KGxtZml0KQogIGxtdGlkeSRyZWdpb24gPC0gcmVnaW9uCiAgcmVzdWx0YWRvcyA8LSBiaW5kX3Jvd3MocmVzdWx0YWRvcyxsbXRpZHkpCgp9CgpyZXN1bHRhZG9zCmBgYAoKIyMjIyBVc2FuZG8gTUFQCgpQcmltZXJvIG1lIGFybW8gdW5hIGZ1bmNpb24gcXVlIG1lIHNpbXBsaWZpY2EgZWwgY29kaWdvCmBgYHtyfQpmdW48LWZ1bmN0aW9uKHBvcmNpb24sZ3J1cG8pIHsgIGJyb29tOjp0aWR5KGxtKFAyMX5mYWN0b3IoQ0gwNCkrQ0gwNixkYXRhID0gcG9yY2lvbikpfQpgYGAKCmBgYHtyfQpiYXNlc19kZl9sbSA8LSBiYXNlc19kZiAlPiUgCiAgZ3JvdXBfYnkoUkVHSU9OKSAlPiUKICBuZXN0KCkgJT4lIAogIG11dGF0ZShsbSA9IG1hcChkYXRhLGZ1bikpCmJhc2VzX2RmX2xtCmJhc2VzX2RmX2xtICU+JSAKICB1bm5lc3QobG0pCmBgYAoKTyBpbmNsdXNvIG3DoXMgZmFjaWwsIHV0aWxpemFuZG8gYGdyb3VwX21vZGlmeWAgKHF1ZSBlcyB1biBhdGFqbyBxdWUgc29sbyBhY2VwdGEgREYpCgoKCmBgYHtyfQpiYXNlc19kZiAlPiUgCiAgZ3JvdXBfYnkoUkVHSU9OKSAlPiUgCiAgZ3JvdXBfbW9kaWZ5KGZ1bikKYGBgCgoKUGVybyBNQVAgc2lydmUgcGFyYSBvcGVyYXIgY29uIGN1YWxxdWllciBvYmpldG8gZGUgUi4KClBvciBlamVtcGxvIHBvZGVtb3MgZ3VhcmRhciBlbCBfX29iamV0b19fIGBTMzpsbWAgcXVlIGVzIGxhIHJlZ3Jlc2lvbiBsaW5lYWwgZW50cmVuYWRhLiBFc2Ugb2JqZXRvIG5vIGVzIG5pIHVuIHZlY3RvciwgbmkgdW5hIGxpc3RhLCBuaSB1biBERi4gTm8gZXMgdW5hIGVzdHJ1Y3R1cmEgZGUgZGF0b3MsIHNpbm8gcXVlIGVzIGFsZ28gZGlzdGludG8sIGNvbiBfcHJvcGllZGFkZXNfIGNvbW8gYHByZWRpY3QoKWAgcGFyYSBwcmVkZWNpciwgZWwgYHN1bW1hcnkoKWAgcXVlIHZpbW9zLCBldGMuCgpgYGB7cn0KZnVuPC1mdW5jdGlvbihwb3JjaW9uLGdydXBvKSB7ICBsbShQMjF+ZmFjdG9yKENIMDQpK0NIMDYsZGF0YSA9IHBvcmNpb24pfQoKYmFzZXNfZGYgJT4lIAogIGdyb3VwX2J5KFJFR0lPTikgJT4lCiAgbmVzdCgpICU+JSAgCiAgbXV0YXRlKGxtID0gbWFwKGRhdGEsZnVuKSkKYGBgCgojIyMgRWplbXBsbyAzOiBHcsOhZmljb3MgZW4gc2VyaWUKClZlYW1vcyB1biB0ZXJjZXIgZWplbXBsbyBjb24gb3RyYSBiYXNlIGRlIGRhdG9zIHF1ZSB5YSBjb25vY2Vtb3M6IEdhcG1pbmRlciwgcXVlIG11ZXN0cmEgYWxndW5vcyBkYXRvcyBzb2JyZSBsYSBwb2JsYWNpw7NuIGRlIGxvcyBwYcOtc2VzIHBvciBhw7FvLgoKRWwgb2JqZXRpdm8gZGUgZXN0ZSBlamVyY2ljaW8gZXMgaGFjZXIgdW4gZ3LDoWZpY28gcG9yIHBhw61zIGRlIGZvcm1hIGF1dG9tw6F0aWNhLiAKCi0gUHJpbWVybyB2ZWFtb3MgbG9zIGRhdG9zCgoKYGBge3J9CgpsaWJyYXJ5KGdhcG1pbmRlcikKCgpnYXBtaW5kZXJfdW5maWx0ZXJlZCAlPiUgCiAgc2FtcGxlX24oMTApCgpgYGAKCmxhIGJhc2UgdGllbmUgbGEgc2lndWllbnRlIGluZm86CgotIGNvdW50cnk6IE5vbWJyZSBkZWwgcGHDrXMKLSBjb250aW5lbnQ6IE5vbWJyZSBkZWwgY29udGluZW50ZQotIHllYXI6IGHDsW8KLSBsaWZlRXhwOiBFc3BlcmFuemEgZGUgdmlkYSBhbCBuYWNlcgotIHBvcDogUG9ibGFjacOzbgotIGdkcFBlcmNhcAoKCi0gVmFtb3MgYSBoYWNlciB1biBncsOhZmljbyBzZW5jaWxsbyBwYXJhIEFyZ2VudGluYQoKYGBge3J9CgpkYXRhX2FyZ2VudGluYSA8LSBnYXBtaW5kZXJfdW5maWx0ZXJlZCAlPiUgCiAgZmlsdGVyKGNvdW50cnk9PSdBcmdlbnRpbmEnKQoKZ2dwbG90KGRhdGFfYXJnZW50aW5hLCBhZXMoeWVhciwgbGlmZUV4cCwgc2l6ZT0gcG9wLCBjb2xvcj1nZHBQZXJjYXApKSsKICBnZW9tX3BvaW50KCkrCiAgZ2VvbV9saW5lKGFscGhhPTAuNikrCiAgbGFicyh0aXRsZSA9IHVuaXF1ZShkYXRhX2FyZ2VudGluYSRjb3VudHJ5KSkKYGBgCgoKLSBBaG9yYSBxdWUgdGVuZW1vcyB1bmEgaWRlYSBkZSBsbyBxdWUgcXVlcmVtb3MgZ3LDoWZpY2FyIGxvIHBvZGVtb3MgcG9uZXIgYWRlbnRybyBkZSB1bmEgZnVuY2nDs24gcXVlIGdyYWZpcXVlLgoKYGBge3J9CgoKIyBkZWZpbmltb3MgbGEgZnVuY2nDs24KZ3JhZmljYXJfcGFpcyA8LSBmdW5jdGlvbihkYXRhLCBwYWlzKXsKICAKICBnZ3Bsb3QoZGF0YSwgYWVzKHllYXIsIGxpZmVFeHAsIHNpemU9IHBvcCwgY29sb3I9Z2RwUGVyY2FwKSkrCiAgICBnZW9tX3BvaW50KCkrCiAgICBnZW9tX2xpbmUoYWxwaGE9MC42KSsKICAgIGxhYnModGl0bGUgPSBwYWlzKQp9CgpgYGAKCgpwcm9iYW1vcyBsYSBmdW5jacOzbiBwYXJhIHVuIGNhc28KCmBgYHtyfQpncmFmaWNhcl9wYWlzKGRhdGFfYXJnZW50aW5hLCAnQXJnZW50aW5hJykKCmBgYAoKCi0gTm9zIGFybWFtb3MgdW4gZGF0YXNldCBuZXN0ZWFkbwoKYGBge3J9CgpnYXBtaW5kZXJfbmVzdCA8LSBnYXBtaW5kZXJfdW5maWx0ZXJlZCAlPiUgCiAgZ3JvdXBfYnkoY291bnRyeSkgJT4lIAogIG5lc3QoKQoKZ2FwbWluZGVyX25lc3QgJT4lIAogIHNhbXBsZV9uKDEwKQoKYGBgCgotIEFob3JhIHBvZGVtb3MgY3JlYXIgdW5hIG51ZXZhIGNvbHVtbmEgcXVlIGNvbnRlbmdhIGxvcyBncsOhZmljb3MKCmBgYHtyfQpnYXBtaW5kZXJfbmVzdCA8LSBnYXBtaW5kZXJfbmVzdCAlPiUgCiAgbXV0YXRlKGdyYWZpY289IG1hcDIoLnggPSBkYXRhLCAueSA9IGNvdW50cnksLmYgPSAgZ3JhZmljYXJfcGFpcykpCgpnYXBtaW5kZXJfbmVzdCAlPiUgCiAgc2FtcGxlX24oMTApCmBgYAoKVmVhbW9zIHVuIGVqZW1wbG8KCgpgYGB7ciB9CmdhcG1pbmRlcl9uZXN0JGdyYWZpY29bMl0KYGBgCgoKQWhvcmEgcG9kZW1vcyBndWFyZGFyIHRvZG9zIGxvcyBncsOhZmljb3MgZW4gdW4gYXJjaGl2byBQREYKCmBgYHtyZXZhbD1GQUxTRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRSwgaW5jbHVkZT1UUlVFfQpwZGYoJy4uL3Jlc3VsdGFkb3MvZ3JhZmljb3NfZ2FwbWluZGVyLnBkZicpCmdhcG1pbmRlcl9uZXN0JGdyYWZpY28KZGV2Lm9mZigpCmBgYAoKCg==