├── .gitignore ├── Adelmo Aguiar Filho └── Compartilhar.md ├── Alessia Paccagnini ├── VAR_Slides_Paccagnini_Parla.pdf ├── data │ └── dataoil1.csv ├── functions │ ├── cusum.R │ ├── getcomp.R │ ├── getfevd.R │ ├── getfevdbands.R │ ├── gethd.R │ ├── getirf.R │ ├── getirfbands.R │ ├── getlag.R │ ├── plotfevd.R │ ├── plothd.R │ ├── plotirf.R │ └── printfevd.R ├── main.R └── packages │ └── packages.R ├── Alexandre Lima └── Compartilhar.md ├── Beatriz Milz ├── README.Rmd ├── README.md ├── README_files │ └── figure-gfm │ │ └── grafico-1.png ├── dados_exemplo_mananciais.Rds └── slides.pdf ├── Bruna Wundervald ├── Compartilhar.md └── code │ ├── aux.R │ └── code.R ├── Bruno Tomio ├── Card image - Twitter.R ├── Compartilhar.md ├── GDP_search.gif ├── Hands-on.R ├── Hans Rosling’s Gapminder.R ├── Slides.Rmd ├── Slides.html ├── Slides_files │ └── figure-html │ │ ├── unnamed-chunk-13-1.png │ │ ├── unnamed-chunk-14-1.png │ │ ├── unnamed-chunk-16-1.png │ │ ├── unnamed-chunk-18-1.png │ │ ├── unnamed-chunk-20-1.png │ │ ├── unnamed-chunk-22-1.png │ │ ├── unnamed-chunk-24-1.png │ │ ├── unnamed-chunk-26-1.png │ │ ├── unnamed-chunk-28-1.gif │ │ ├── unnamed-chunk-28-1.png │ │ ├── unnamed-chunk-30-1.gif │ │ ├── unnamed-chunk-30-1.png │ │ ├── unnamed-chunk-32-1.gif │ │ ├── unnamed-chunk-32-1.png │ │ ├── unnamed-chunk-34-1.png │ │ ├── unnamed-chunk-36-1.png │ │ ├── unnamed-chunk-38-1.png │ │ ├── unnamed-chunk-6-1.png │ │ └── unnamed-chunk-7-1.png ├── WDI - 2021 Talk.Rproj ├── World maps.R ├── all-ok.PNG ├── gist.R ├── libs │ ├── clipboard │ │ └── clipboard.min.js │ ├── header-attrs │ │ └── header-attrs.js │ ├── kePrint │ │ └── kePrint.js │ ├── lightable │ │ └── lightable.css │ ├── panelset │ │ ├── panelset.css │ │ └── panelset.js │ ├── shareon │ │ ├── shareon.min.css │ │ └── shareon.min.js │ ├── xaringanExtra-clipboard │ │ ├── xaringanExtra-clipboard.css │ │ └── xaringanExtra-clipboard.js │ └── xaringanExtra-shareagain │ │ ├── shareagain.css │ │ └── shareagain.js ├── logoSER_transparente.png ├── macros.js └── xaringan-themer.css ├── Daniel Falbel └── Compartilhar.md ├── Data_and_Code.Rproj ├── Dean Attali └── Compartilhar.md ├── Eduardo Jangutta ├── Buscas │ ├── Export_from_R_CSV.csv │ ├── busca1_scopus.bib │ ├── busca2_savedrecs.bib │ ├── busca3_scopus.bib │ └── busca4_savedrecs.bib ├── SLIDES V SER BIBLIOMETRIX.pdf └── VSER_BIBLIOMETRIX_EDUARDO_MORGANY.R ├── Emmanuelle Nunes ├── Compartilhar.md └── GA │ ├── GA.Rproj │ ├── data │ └── cancer.csv │ ├── functions │ ├── aux_functions.R │ ├── fitness_function.R │ └── ga_functions.R │ ├── main.R │ └── slides │ ├── GA_slides.Rmd │ ├── GA_slides.html │ ├── GA_slides_files │ └── header-attrs │ │ └── header-attrs.js │ ├── human_evolution.png │ ├── www │ ├── crossover.png │ ├── degrade_evolucion.png │ ├── evaluation3.png │ ├── ga.png │ ├── initialization.png │ ├── mutation.png │ └── selection1.png │ └── xaringan-themer.css ├── Eric Ferreira ├── Lcasca.csv ├── V_SER.pdf ├── sabor.csv └── script.r ├── Fernando Barbalho ├── Compartilhar.md └── interface_rsiconfi.rmd ├── Fernando Corrêa └── Compartilhar.md ├── Fernando Pereira ├── Challenger.csv ├── League of Legends Estatística.pptx ├── Palestra SER.R ├── Palestra SER.Rmd └── Palestra-SER.html ├── Gilberto Liska ├── Palestra_SIR_Gilberto2.pdf ├── dados_jan.xlsx └── rotina_V_SER_final.R ├── Julio Trecenti ├── Compartilhar.md ├── custom.css ├── data.csv ├── img │ └── logo.png ├── jtrecenti.Rmd ├── jtrecenti.html ├── jtrecenti.pdf ├── jtrecenti_files │ └── figure-html │ │ └── grafico-1.png └── libs │ ├── clipboard │ └── clipboard.min.js │ ├── header-attrs │ └── header-attrs.js │ ├── panelset │ ├── panelset.css │ └── panelset.js │ ├── remark-css │ └── default.css │ ├── xaringanExtra-clipboard │ ├── xaringanExtra-clipboard.css │ └── xaringanExtra-clipboard.js │ └── xaringanExtra-extra-styles │ └── xaringanExtra-extra-styles.css ├── Larissa Alves ├── Apresentacao_SER.pdf ├── MCMC - ARD - Galaxia.R ├── Simulacao - VB x MCMC.R ├── VB - ARD - Galaxia.R └── space_data.txt ├── Laura Teixeira └── Compartilhar.md ├── Leonardo Filgueira ├── Compartilhar.md ├── Tipo_tel.csv ├── apresentacao.Rmd ├── apresentacao.pdf ├── header.tex ├── img │ ├── esquema_qualithron.png │ └── logoSER_transparente.png ├── qualifica_tel_light.R ├── qualithron_vs_quality.csv └── tempo_atual.csv ├── Luis Torgo └── Compartilhar.md ├── Matheus Barros ├── Compartilhar.md ├── codigo_usado.R └── slides_apresentacao_basedosdados.pdf ├── Orlando Guilarte ├── Driver neo4j.R ├── Grafos Visualiz.R ├── Import to Neo4j DB.txt ├── Manipulação de grafos no R.pdf ├── nodes.csv └── relationship.csv ├── Paulo Guimarães ├── Best R Libraries for Machine Learning.pdf ├── Best_libraries_ML.R └── Slides palestra ├── Pedro Faria └── Compartilhar.md ├── README.md └── Vanessa_Manhaes_e_Alexandre_da_Silva └── README /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | .Rproj.user 41 | 42 | 43 | .DS_store -------------------------------------------------------------------------------- /Adelmo Aguiar Filho/Compartilhar.md: -------------------------------------------------------------------------------- 1 | # Share Your Data and Code for - V International Seminar on Statistics with R 2 | 3 | . 4 | -------------------------------------------------------------------------------- /Alessia Paccagnini/VAR_Slides_Paccagnini_Parla.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Alessia Paccagnini/VAR_Slides_Paccagnini_Parla.pdf -------------------------------------------------------------------------------- /Alessia Paccagnini/data/dataoil1.csv: -------------------------------------------------------------------------------- 1 | date,RPOIL,INFL,GDP 2 | 01/01/1973,-1.271510255,1.271510255,2.43212956 3 | 01/04/1973,-1.627243433,1.627243433,1.127439946 4 | 01/07/1973,17.26467318,1.853062744,-0.544917449 5 | 01/10/1973,-1.716061394,1.716061394,0.928407117 6 | 01/01/1974,83.24191149,2.016801397,-0.83416854 7 | 01/04/1974,-2.214244596,2.214244596,0.262445447 8 | 01/07/1974,-3.000591011,3.000591011,-0.973000382 9 | 01/10/1974,6.887920129,2.993172263,-0.400832113 10 | 01/01/1975,-2.233956695,2.233956695,-1.215480828 11 | 01/04/1975,-1.449206964,1.449206964,0.767508103 12 | 01/07/1975,-1.763534484,1.763534484,1.639089039 13 | 01/10/1975,-1.652309465,1.652309465,1.339184008 14 | 01/01/1976,7.015736766,1.071212799,2.233025635 15 | 01/04/1976,-0.419190904,0.996036343,0.75280388 16 | 01/07/1976,12.02270911,1.268784202,0.507161428 17 | 01/10/1976,-1.66410032,1.66410032,0.74777922 18 | 01/01/1977,-1.593285813,1.593285813,1.156802253 19 | 01/04/1977,-1.556855524,1.556855524,1.943623796 20 | 01/07/1977,5.230359532,1.380742979,1.753681907 21 | 01/10/1977,-1.667637975,1.667637975,0.010496759 22 | 01/01/1978,-1.662118616,1.662118616,0.347351148 23 | 01/04/1978,-1.895035421,1.895035421,3.814352995 24 | 01/07/1978,-1.723013356,1.723013356,0.973187633 25 | 01/10/1978,-2.011636963,2.011636963,1.332298033 26 | 01/01/1979,4.699405581,1.817557927,0.198560637 27 | 01/04/1979,16.29606487,2.355818603,0.121042598 28 | 01/07/1979,38.00328392,2.018291298,0.715556336 29 | 01/10/1979,11.19090563,1.942694577,0.258613407 30 | 01/01/1980,13.49122251,2.143384528,0.323034829 31 | 01/04/1980,1.704686352,2.166764866,-2.049061069 32 | 01/07/1980,-11.54828547,2.270112123,-0.151704479 33 | 01/10/1980,-0.029304223,2.769201642,1.835901659 34 | 01/01/1981,0.115715044,2.551109665,2.050067377 35 | 01/04/1981,-7.162640208,1.755918081,-0.733376175 36 | 01/07/1981,-1.847888722,1.847888722,1.140744037 37 | 01/10/1981,-4.601443619,1.784355923,-1.173635989 38 | 01/01/1982,-21.9500439,1.335446408,-1.686866298 39 | 01/04/1982,19.58620889,1.228188874,0.543495395 40 | 01/07/1982,0.18229038,1.401901166,-0.360684943 41 | 01/10/1982,-12.70459166,1.080533371,0.097501187 42 | 01/01/1983,-10.43256261,0.844781992,1.301255044 43 | 01/04/1983,6.616915088,0.674846304,2.256295662 44 | 01/07/1983,-0.685756983,1.039967625,1.939086909 45 | 01/10/1983,-6.92149919,0.722331588,2.041373886 46 | 01/01/1984,4.03492609,1.032824886,1.96736959 47 | 01/04/1984,-3.483336764,0.881510433,1.741166464 48 | 01/07/1984,-3.048693214,0.821880554,0.979067686 49 | 01/10/1984,-14.81949045,0.619572925,0.794405874 50 | 01/01/1985,9.304238929,1.17674439,0.989082613 51 | 01/04/1985,-4.537930146,0.564854324,0.911489016 52 | 01/07/1985,3.510046233,0.639926857,1.543905704 53 | 01/10/1985,-4.354544495,0.535636633,0.747375151 54 | 01/01/1986,-77.38826653,0.484621573,0.922207319 55 | 01/04/1986,6.147282833,0.370930498,0.458081115 56 | 01/07/1986,9.691564902,0.465148934,1.001577963 57 | 01/10/1986,6.953954121,0.600459377,0.516742661 58 | 01/01/1987,12.40034961,0.586759887,0.697075677 59 | 01/04/1987,8.3263417,0.652037399,1.116322515 60 | 01/07/1987,-3.263918968,0.735978489,0.90290845 61 | 01/10/1987,-13.25040691,0.778458946,1.636917985 62 | 01/01/1988,-6.871167398,0.772445743,0.560928138 63 | 01/04/1988,0.905950354,0.98723596,1.31253833 64 | 01/07/1988,-14.51041238,1.200475265,0.575297915 65 | 01/10/1988,10.87125654,0.853281519,1.315694665 66 | 01/01/1989,16.83799587,1.014419014,1.003615705 67 | 01/04/1989,1.792262179,1.046245674,0.783203556 68 | 01/07/1989,-2.852919071,0.731627407,0.743683865 69 | 01/10/1989,6.714544769,0.663431484,0.211189661 70 | 01/01/1990,-4.337599653,1.109181477,1.088903269 71 | 01/04/1990,-20.12274493,1.02495331,0.385849581 72 | 01/07/1990,68.26937477,0.897041314,0.02513039 73 | 01/10/1990,-21.65895602,0.773933409,-0.855995677 74 | 01/01/1991,-32.94898221,0.984664942,-0.46966462 75 | 01/04/1991,1.027026094,0.670468485,0.772907465 76 | 01/07/1991,7.179649394,0.717938441,0.47882582 77 | 01/10/1991,-11.84837374,0.526483566,0.435505817 78 | 01/01/1992,-3.578626802,0.456625066,1.174347032 79 | 01/04/1992,16.16271137,0.632102557,1.09637603 80 | 01/07/1992,-2.632512493,0.464405886,0.967326727 81 | 01/10/1992,-12.75960808,0.689784117,0.996921686 82 | 01/01/1993,4.127825822,0.601425649,0.185971456 83 | 01/04/1993,-7.097051634,0.600602406,0.592793016 84 | 01/07/1993,-9.043221704,0.508794373,0.486327239 85 | 01/10/1993,-19.35449638,0.56108844,1.32603423 86 | 01/01/1994,0.510061314,0.518401642,0.97538754 87 | 01/04/1994,25.80807784,0.491294478,1.357330421 88 | 01/07/1994,-9.320086651,0.499699731,0.587458625 89 | 01/10/1994,-2.298887523,0.565741888,1.128909427 90 | 01/01/1995,7.18624829,0.602621209,0.341156075 91 | 01/04/1995,-1.149547536,0.446271714,0.348927311 92 | 01/07/1995,-1.463928887,0.427084673,0.852276305 93 | 01/10/1995,3.87069056,0.476653507,0.707340931 94 | 01/01/1996,10.9880156,0.50978287,0.653919847 95 | 01/04/1996,-4.730435342,0.376722182,1.73098375 96 | 01/07/1996,15.51209887,0.453320562,0.92074929 97 | 01/10/1996,5.250319917,0.421511969,1.050838429 98 | 01/01/1997,-19.52152829,0.490602099,0.759393769 99 | 01/04/1997,-9.533810796,0.463853119,1.497556355 100 | 01/07/1997,2.892443314,0.290576942,1.265420732 101 | 01/10/1997,-8.060316687,0.34197665,0.77324804 102 | 01/01/1998,-20.00491317,0.143841875,0.984475056 103 | 01/04/1998,-9.719781435,0.228702215,0.965157106 104 | 01/07/1998,8.664163597,0.359780973,1.299733563 105 | 01/10/1998,-28.42942693,0.261421549,1.628184885 106 | 01/01/1999,25.83525165,0.373893391,0.929655026 107 | 01/04/1999,19.50061879,0.411301318,0.838846249 108 | 01/07/1999,28.52267987,0.35725923,1.265054134 109 | 01/10/1999,8.320175912,0.492568942,1.715654987 110 | 01/01/2000,12.90242178,0.73310214,0.286187787 111 | 01/04/2000,5.739449153,0.549077347,1.871229549 112 | 01/07/2000,5.600499789,0.64106306,0.127574384 113 | 01/10/2000,-17.96665217,0.534124458,0.5309702 114 | 01/01/2001,-5.030546527,0.649235389,-0.286762294 115 | 01/04/2001,0.627256011,0.685673133,0.529505481 116 | 01/07/2001,-6.760133349,0.32560304,-0.304669167 117 | 01/10/2001,-29.49389437,0.31267673,0.24464858 118 | 01/01/2002,23.08756854,0.286849008,0.935730396 119 | 01/04/2002,3.984334021,0.421664959,0.544907759 120 | 01/07/2002,14.62520519,0.442192392,0.479627764 121 | 01/10/2002,-1.374001144,0.527829231,0.048218354 122 | 01/01/2003,12.51250734,0.623707484,0.505373655 123 | 01/04/2003,-9.118070729,0.305775216,0.941283307 124 | 01/07/2003,-8.788372483,0.547820186,1.675664364 125 | 01/10/2003,12.27531698,0.515089559,1.127650095 126 | 01/01/2004,12.55320551,0.846579166,0.595970846 127 | 01/04/2004,2.572369462,0.797834495,0.762276725 128 | 01/07/2004,18.26436483,0.679786343,0.874046678 129 | 01/10/2004,-6.587135303,0.716273998,0.839626476 130 | 01/01/2005,21.68905021,0.897263418,1.088020654 131 | 01/04/2005,2.839079771,0.68846333,0.544032837 132 | 01/07/2005,14.37069531,0.942751816,0.812845092 133 | 01/10/2005,-10.60919528,0.77728279,0.551750877 134 | 01/01/2006,4.924728676,0.749972757,1.206212526 135 | 01/04/2006,11.23331228,0.823705153,0.310605342 136 | 01/07/2006,-11.21773169,0.691074649,0.08746409 137 | 01/10/2006,-3.281563645,0.358400786,0.77802593 138 | 01/01/2007,-3.503164173,1.104811188,0.065250548 139 | 01/04/2007,10.24711172,0.572553132,0.767529016 140 | 01/07/2007,16.60233723,0.329662164,0.67140477 141 | 01/10/2007,13.34522846,0.424594332,0.364378735 142 | 01/01/2008,13.48406669,0.558936526,-0.673781472 143 | 01/04/2008,23.36513253,0.438643847,0.494373478 144 | 01/07/2008,-26.06882121,0.67998348,-0.496360694 145 | 01/10/2008,-93.13149446,0.194579909,-2.174610639 146 | 01/01/2009,15.42425924,0.248191235,-1.399587094 147 | 01/04/2009,37.46895592,-0.156048407,-0.105656378 148 | 01/07/2009,-0.308219473,-0.00800905,0.317412467 149 | 01/10/2009,6.440081956,0.295908484,0.95151192 150 | 01/01/2010,8.600809511,0.328868988,0.39413317 151 | 01/04/2010,-7.98597866,0.459597496,0.956903412 152 | 01/07/2010,-0.50763695,0.454537254,0.684993306 153 | 01/10/2010,16.23985227,0.507425614,0.692239479 154 | 01/01/2011,14.10860737,0.397451356,-0.324745058 155 | 01/04/2011,-7.330640084,0.652457787,0.784462782 156 | 01/07/2011,-12.36298884,0.606751589,0.338458951 157 | 01/10/2011,13.97017983,0.12630586,1.187951545 158 | 01/01/2012,6.952252167,0.494046507,0.910555785 159 | 01/04/2012,-25.78762486,0.435309494,0.299300102 160 | 01/07/2012,13.35638094,0.565457298,0.686755394 161 | 01/10/2012,-7.354788447,0.279640915,0.036320206 162 | 01/01/2013,4.961788597,0.334540131,0.284800371 163 | 01/04/2013,2.751370299,0.16119989,0.612400508 164 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/cusum.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # cusum.R 3 | #======================================================================================================= 4 | # This function computes cumulative sum of an array 5 | # 6 | # Notes. It is used if the IRFs are computed as a cumulative sum of the original responses 7 | # 8 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 9 | # contact: fabioparla123@gmail.com 10 | # Dublin, May 2021 11 | # 12 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 13 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 14 | #======================================================================================================= 15 | 16 | 17 | cusum <- function(xarr) { 18 | 19 | H <- dim(xarr)[3] 20 | n <- nrow(xarr) 21 | 22 | # Create array of cumulative sums 23 | xsum <- array(0, dim=c(n, n, H), dimnames = dimnames(xarr)) 24 | xsum[,,1] <- xarr[,,1] # Initialize 25 | 26 | for (hh in 2 : H) { 27 | 28 | xsum[,,hh] <- xarr[,,hh] + xsum[,,hh-1] 29 | 30 | } 31 | 32 | return(xsum) 33 | 34 | } 35 | 36 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/getcomp.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # getcomp.R 3 | #======================================================================================================= 4 | # This function construct the companion matrix containing the slopes coefficients obtained from the 5 | # estimation of a VAR(p). 6 | # See slides page 7 | # 8 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 9 | # contact: fabioparla123@gmail.com 10 | # Dublin, May 2021 11 | # 12 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 13 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 14 | #======================================================================================================= 15 | 16 | getcomp <- function(Beta,P) { 17 | 18 | nvar <- ncol(Beta) 19 | 20 | BB <- t(Beta) 21 | 22 | # Remove deterministic terms 23 | CAPB <- BB[, 1:(nvar*P)] 24 | 25 | # Get Companion matrix 26 | Fupp <- CAPB 27 | Flw <- cbind(diag(nvar*(P-1)), matrix(0 , nrow = nvar*(P-1), ncol = nvar)) 28 | 29 | capF <- rbind(Fupp, Flw) 30 | 31 | return(capF) 32 | 33 | } -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/getfevd.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # getfevd.R 3 | #======================================================================================================= 4 | # This function computes the Forecast Error Variance Decomposition (FEVD) 5 | # 6 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 7 | # contact: fabioparla123@gmail.com 8 | # Dublin, May 2021 9 | # 10 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 11 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 12 | #======================================================================================================= 13 | 14 | 15 | getfevd <- function(Bmat, A0mat, L, fhorizon) { 16 | 17 | 18 | if (is.null(A0mat)) { 19 | stop('No structural dynamic analysis can be performed! Specify impact multiplier matrix') 20 | } 21 | 22 | # Number of endogenous variables 23 | nvar <- ncol(Bmat) 24 | 25 | # Names of endogenous variables 26 | if (is.null(colnames(Bmat)) == FALSE) { 27 | 28 | labVAR <- colnames(Bmat) 29 | 30 | } else { 31 | 32 | labVAR <- paste0('y', 1:nvar) 33 | 34 | } 35 | 36 | # 1. Compute IRFs 37 | # Get companion 38 | MATCOMP <- getcomp(Bmat,L) 39 | 40 | # Selection matrices 41 | J <- rbind( diag(nvar) , matrix(0, nrow = (nvar*L)-nvar, ncol = nvar)) 42 | 43 | # Save IRFs 44 | THETA <- array(0, dim = c(nvar, nvar, fhorizon+1), dimnames = list(NULL , paste0('eps', 1:nvar), 45 | paste0('horz',0:fhorizon))) 46 | 47 | for (hh in 1 : (fhorizon+1)) { 48 | 49 | THETA[,,hh] <- t(J) %*% (MATCOMP%^%(hh-1)) %*% J %*% A0mat 50 | 51 | } 52 | 53 | SIGMAEPS <- diag(nvar) 54 | 55 | # 2. Prediction Mean Squared Error 56 | MSPE <- array(0, dim = c(nvar , nvar , fhorizon), dimnames = list(labVAR, paste0('eps', 1:nvar) , paste0('hor', 1:fhorizon))) 57 | 58 | MSPE[,,1] <- THETA[,,1]^2 # Initialize MSPE 59 | 60 | for (hh in 2 : fhorizon) { 61 | 62 | MSPE[,,hh] <- ( THETA[,,hh]^2 ) + MSPE[,,hh-1] 63 | 64 | } 65 | 66 | 67 | # 3. Total Prediction Mean Squared Error 68 | TOT.MSPE <- array(0, dim = c(nvar , nvar , fhorizon), dimnames = list(labVAR, paste0('eps', 1:nvar) , paste0('hor', 1:fhorizon))) 69 | 70 | TOT.MSPE[,,1] <- THETA[,,1] %*% SIGMAEPS %*% t(THETA[,,1]) # Initialize MSPE 71 | 72 | for (hh in 2 : fhorizon) { 73 | 74 | TOT.MSPE[,,hh] <- ( THETA[,,hh] %*% SIGMAEPS %*% t(THETA[,,hh]) ) + TOT.MSPE[,,hh-1] 75 | 76 | } 77 | 78 | # 4. Forecast Error Variance Decomposition 79 | fevd <- array(0, dim = c(nvar , nvar , fhorizon), dimnames = list(labVAR, paste0('eps', 1:nvar) , paste0('hor', 1:fhorizon))) 80 | 81 | for (hh in 1 : fhorizon) { 82 | 83 | for(ii in 1 : nvar) { 84 | 85 | for (jj in 1 : nvar) { 86 | 87 | fevd[ii,jj,hh] <- MSPE[ii,jj,hh] / TOT.MSPE[ii,ii,hh] 88 | 89 | } 90 | 91 | } 92 | 93 | } 94 | 95 | # For each forecast horizon the row sum must sum up to one 96 | check <-apply(fevd, MARGIN = 3, function(x) rowSums(x)) 97 | 98 | if (round(sum(apply(check, MARGIN = 1, function(x) sum(x)))) != nvar*fhorizon) { 99 | 100 | message('Error! Row sum condition is not satisfied!') 101 | 102 | } 103 | 104 | # Reshape FEVD [HORIZON x VARIABLE x SHOCK] 105 | PFEVD <- printfevd(fevd) 106 | 107 | return(PFEVD) 108 | 109 | 110 | } 111 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/getfevdbands.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # getfevdbands.R 3 | #======================================================================================================= 4 | # This function computes confidence intervals for Forecast Error Variance Decomposition through 5 | # residual-based bootstrap 6 | # 7 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 8 | # contact: fabioparla123@gmail.com 9 | # Dublin, May 2021 10 | # 11 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 12 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 13 | #======================================================================================================= 14 | 15 | 16 | getfevdbands <- function(datamat,bigL,CONSTANT,BETA,capinvA0,FHORZ,cb,ndraws) { 17 | 18 | 19 | # Get point estimates 20 | fevdpe <- getfevd(BETA,capinvA0, bigL, FHORZ) 21 | 22 | # Get confidence intervals 23 | # Data 24 | tobs <- nrow(datamat) 25 | temp <- tobs - bigL 26 | kvar <- ncol(datamat) 27 | 28 | # Get data matrices for estimation 29 | YDATA <- datamat[(1+bigL):tobs , ] 30 | XDATA <- getlag(datamat,bigL,CONSTANT) 31 | 32 | # Get OLS residuals (to be used in the simulation - that is residuals-based bootstrap) 33 | resids <- YDATA - XDATA%*%BETA 34 | 35 | # Constant 36 | if (CONSTANT == 1) { 37 | 38 | const <- matrix(rep(1 , temp)) 39 | 40 | } else { 41 | 42 | const <- NULL 43 | 44 | } 45 | 46 | deterministic <- const 47 | 48 | 49 | # Get confidence bands 50 | # Bootstrapping the residuals 51 | ucent <- apply(resids, MARGIN = 2, function(x) scale(x, center = TRUE, scale = FALSE)) 52 | 53 | # Save impulse response functions 54 | FEVDBOOT <- vector('list', ndraws) 55 | 56 | #------------------------------------------------------------------------------------------ 57 | # Bootstrap starts here 58 | irep <- 1 # Initialize 59 | 60 | while (irep <= ndraws) { 61 | 62 | nb <- sample(1:temp, replace = TRUE) # extract from uniform distribution with replacement 63 | uboot <- ucent[nb , ] # bootstrap the residuals 64 | ubt <- rbind(matrix(0, nrow = bigL, ncol = kvar) , uboot) 65 | 66 | # Initialize data boot matrix 67 | databoot <- matrix(0, nrow = tobs, ncol = kvar) 68 | databoot[1:bigL , ] <- datamat[1:bigL , ] 69 | 70 | # Reconstruct the series 71 | for (tt in (1+bigL) : tobs) { 72 | 73 | xb <- matrix(t(databoot[ rev((tt-p):(tt-1)) , ]) , nrow = 1, byrow = TRUE) 74 | xboot <- c(xb, deterministic[tt-bigL , ]) 75 | databoot[tt , ] <- t(xboot) %*% BETA + ubt[tt , ] 76 | remove(xb); remove(xboot); 77 | 78 | } 79 | 80 | # Get data matrices for estimation 81 | Yboot <- databoot[(1+bigL):tobs , ] 82 | Xboot <- getlag(databoot,bigL,CONSTANT) 83 | N <- ncol(Xboot) # Number of coefficients for each VAR equation 84 | 85 | # Get OLS quantities 86 | Bboot <- solve(t(Xboot)%*%Xboot) %*% t(Xboot)%*%Yboot 87 | residboot <- Yboot - Xboot%*%Bboot 88 | sseboot <- crossprod(residboot) 89 | SIGMAboot <- (1 / (temp-N)) * sseboot 90 | 91 | 92 | # Identification scheme 93 | invA0b <- t(chol(SIGMAboot)) 94 | 95 | # Save only non-explosive FEVD 96 | THETA <- getcomp(Bboot,bigL) 97 | 98 | eigboot <- eigen(THETA)$values 99 | 100 | if (max(abs(eigboot)) < 1) { 101 | 102 | FEVDBOOT[[irep]] <- getfevd(Bboot,invA0b,bigL,FHORZ) 103 | 104 | print(paste0('Bootstrap replication: ',irep)) 105 | 106 | irep <- irep + 1 107 | 108 | } 109 | 110 | } 111 | 112 | # Bootstrap ends here 113 | #------------------------------------------------------------------------------------------ 114 | 115 | # Construct confidence intervals 116 | # Create matrix for the distribution of the parameters 117 | distrpar <- matrix(0, nrow = kvar^2*FHORZ , ncol = ndraws) 118 | colnames(distrpar) <- paste0('iter',1:ndraws) 119 | npars <- nrow(distrpar) 120 | 121 | for (ii in 1 : ndraws) { 122 | 123 | distrpar[,ii] <- matrix(FEVDBOOT[[ii]]) 124 | 125 | } 126 | 127 | # Compute lower and upper bands 128 | siglev <- 1 - cb 129 | lowb <- siglev / 2 130 | uppb <- 1 - (siglev / 2) 131 | 132 | qnts <- t(apply(distrpar, MARGIN = 1, function(x) quantile(sort(x) , c(lowb , 0.5 , uppb) ))) 133 | 134 | LWbands <- array(qnts[,1] , dim = c(FHORZ, kvar, kvar)) 135 | MEDbands <- array(qnts[,2] , dim = c(FHORZ, kvar, kvar)) 136 | UPbands <- array(qnts[,3] , dim = c(FHORZ, kvar, kvar)) 137 | 138 | # Create output for FEVD [HORIZON x PERCENTILES x VARIABLE x SHOCK] 139 | FEVDOUTPUT <- array(0, dim = c(FHORZ, 3, kvar, kvar) , dimnames = list(paste0('H=', 1:FHORZ), c('LW','MEDIAN','UB'), paste0('y', 1:kvar), paste0('eps', 1:kvar))) 140 | 141 | for (ishock in 1 : kvar) { # for each shock 142 | 143 | for (kk in 1 : kvar) { 144 | 145 | FEVDOUTPUT[,,kk,ishock] <- cbind(LWbands[,kk,ishock],MEDbands[,kk,ishock],UPbands[,kk,ishock]) # k-th variable, i-th shock 146 | 147 | } 148 | 149 | } 150 | 151 | return(FEVDOUTPUT) 152 | 153 | } 154 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/gethd.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # gethd.R 3 | #======================================================================================================= 4 | # This function computes computes Historical Decompositions (HD) 5 | # 6 | # Notes. This function is based on Ambrogio Cesa-Bianchi's matlab code - available on his personal 7 | # webpage. 8 | # 9 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 10 | # contact: fabioparla123@gmail.com 11 | # Dublin, May 2021 12 | # 13 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 14 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 15 | #======================================================================================================= 16 | 17 | 18 | gethd <- function(datatemp,Betahd,invAhd,RESIDS,const,lagENDO) { 19 | 20 | 21 | # Information 22 | kv <- ncol(Betahd) 23 | capT <- nrow(datatemp) 24 | TESS <- capT - lagENDO 25 | 26 | # Get contemporaneous and lagged variables 27 | ytemp <- datatemp[(1+lagENDO):capT, ] 28 | xtemp <- getlag(datatemp,lagENDO,const) # Get lagged endogenous variables 29 | 30 | # Get companion 31 | THETA <- getcomp(Betahd,lagENDO) # reduced form OLS coefficients 32 | compinvA0 <- rbind(invAhd, matrix(0,nrow = (kv *(lagENDO-1)), ncol = kv)) # structural impact multiplier matrix 33 | 34 | # Selection matrix (useful when p > 1) 35 | selID <- cbind(diag(kv), matrix(0, nrow = kv, ncol = (lagENDO-1)*kv)) 36 | 37 | # Getting structural shocks 38 | eStruct <- solve(invAhd) %*% t(RESIDS) 39 | 40 | #------------------------------------------------ 41 | # Stochastic component 42 | compHD.stoch <- array(0, dim=c(kv*lagENDO,TESS+1, kv)) 43 | HD.stoch <- array(0, dim=c(kv,TESS+1, kv)) 44 | 45 | for (kk in 1 : kv){ # for each shock 46 | 47 | EPS <- matrix(0, nrow = kv, ncol = TESS+1) 48 | EPS[kk , 2:(TESS+1)] <- eStruct[kk,] 49 | 50 | for (tt in 2 : (TESS+1)) { 51 | 52 | compHD.stoch[ , tt , kk] <- THETA %*% compHD.stoch[ , tt-1, kk] + compinvA0 %*% EPS[ , tt] 53 | HD.stoch[, tt , kk] <- selID %*% compHD.stoch[ , tt , kk] 54 | 55 | } 56 | 57 | } 58 | 59 | #------------------------------------------------ 60 | # Initial condition 61 | compHDinit <- matrix(0, nrow = kv*lagENDO, ncol = TESS+1) 62 | compHDinit[,1] <- matrix(xtemp[1,-ncol(xtemp)]) 63 | HDinit <- matrix(0, nrow = kv, ncol = TESS+1) 64 | HDinit[,1] <- selID %*% compHDinit[,1] 65 | 66 | for (tt in 2 : (TESS+1)) { 67 | 68 | compHDinit[,tt] <- THETA %*% compHDinit[,tt-1] 69 | HDinit[,tt] <- selID %*% compHDinit[,tt] 70 | 71 | } 72 | 73 | #------------------------------------------------ 74 | # Constant term 75 | if (const == 1) { 76 | 77 | compHDconst <- matrix(0, nrow = kv*lagENDO, ncol = TESS+1) 78 | HDconst <- matrix(0, nrow = kv, ncol = TESS+1) 79 | 80 | compMU <- rbind(matrix(Betahd[(kv*lagENDO)+1 , ]) , matrix(0, nrow = kv*(lagENDO-1), ncol = 1)) 81 | 82 | for (tt in 2 : (TESS+1)) { 83 | 84 | compHDconst[,tt] <- compMU + THETA %*% compHDconst[,tt-1] 85 | HDconst[,tt] <- selID %*% compHDconst[,tt] 86 | 87 | } 88 | 89 | } else { 90 | 91 | HDconst <- matrix(0, nrow = kv, ncol = TESS+1) 92 | 93 | } 94 | 95 | # Check if one retrives the original series. 96 | # Notes. The VAR is specified as a VAR(1) using the companion representation 97 | HDdata <- HDconst + HDinit + rowSums(HD.stoch, dims = 2) 98 | 99 | if (all(round(t(HDdata), 9) == round(datatemp[lagENDO : nrow(datatemp) , ] , 9)) == TRUE) { 100 | 101 | print('The original series have been retrieved') 102 | 103 | PROBLEM <- 0 104 | 105 | } else { 106 | 107 | PROBLEM <- 1 108 | 109 | } 110 | 111 | # Print historical decomposition of the structural shocks [T x SHOCK x VARIABLE) 112 | HDshock <- array(0, dim=c(TESS+1, kv, kv), dimnames = list(NULL, paste0('eps',1:kv), paste0('y',1:kv))) 113 | 114 | for (ii in 1 : kv) { # for each variable 115 | 116 | for (jj in 1 : kv) { # for each shock 117 | 118 | HDshock[,jj,ii] <- matrix(HD.stoch[ii,,jj]) 119 | 120 | } 121 | 122 | } 123 | 124 | HDdecomp <- list(HDunexp=HDshock,HDconst=HDconst,HDinit=HDinit,INITCOND=t(HDconst+HDinit),PROBLEM=PROBLEM) 125 | 126 | 127 | return(HDdecomp) 128 | 129 | } 130 | 131 | 132 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/getirf.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Alessia Paccagnini/functions/getirf.R -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/getirfbands.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # getirfbands.R 3 | #======================================================================================================= 4 | # This function computes confidence intervals for impulse response functions through residual-based 5 | # bootstrap 6 | # 7 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 8 | # contact: fabioparla123@gmail.com 9 | # Dublin, May 2021 10 | # 11 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 12 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 13 | #======================================================================================================= 14 | 15 | 16 | getirfbands <- function(datamat,bigL,CONSTANT,BETA,FHORZ,CUMULATIVE,scalefact,cb,ndraws) { 17 | 18 | # Data 19 | tobs <- nrow(datamat) 20 | temp <- tobs - bigL 21 | kvar <- ncol(datamat) 22 | 23 | # Get data matrices for estimation 24 | YDATA <- datamat[(1+bigL):tobs , ] 25 | XDATA <- getlag(datamat,bigL,CONSTANT) 26 | 27 | # Get OLS residuals (to be used in the simulation - that is residuals-based bootstrap) 28 | resids <- YDATA - XDATA%*%BETA 29 | 30 | # Constant 31 | if (CONSTANT == 1) { 32 | 33 | const <- matrix(rep(1 , temp)) 34 | 35 | } else { 36 | 37 | const <- NULL 38 | 39 | } 40 | 41 | deterministic <- const 42 | 43 | # Get confidence bands 44 | # Bootstrapping the residuals 45 | ucent <- apply(resids, MARGIN = 2, function(x) scale(x, center = TRUE, scale = FALSE)) 46 | 47 | # Save impulse response functions 48 | IRFBOOT <- vector('list', ndraws) 49 | 50 | #------------------------------------------------------------------------------------------ 51 | # Bootstrap starts here 52 | irep <- 1 # Initialize 53 | 54 | while (irep <= ndraws) { 55 | 56 | nb <- sample(1:temp, replace = TRUE) # extract from uniform distribution with replacement 57 | uboot <- ucent[nb , ] # bootstrap the residuals 58 | ubt <- rbind(matrix(0, nrow = bigL, ncol = kvar) , uboot) 59 | 60 | # Initialize data boot matrix 61 | databoot <- matrix(0, nrow = tobs, ncol = kvar) 62 | databoot[1:bigL , ] <- datamat[1:bigL , ] 63 | 64 | # Reconstruct the series 65 | for (tt in (1+bigL) : tobs) { 66 | 67 | xb <- matrix(t(databoot[rev((tt-p):(tt-1)), ]) , nrow = 1, byrow = TRUE) 68 | xboot <- c(xb, deterministic[tt-bigL, ]) 69 | databoot[tt , ] <- t(xboot) %*% BETA + ubt[tt, ] 70 | remove(xb); remove(xboot); 71 | 72 | } 73 | 74 | # Get data matrices for estimation 75 | Yboot <- databoot[(1+bigL):tobs , ] 76 | Xboot <- getlag(databoot,bigL,CONSTANT) 77 | N <- ncol(Xboot) # Number of coefficients for each VAR equation 78 | 79 | # Get OLS quantities 80 | Bboot <- solve(t(Xboot)%*%Xboot) %*% t(Xboot)%*%Yboot 81 | residboot <- Yboot - Xboot%*%Bboot 82 | sseboot <- crossprod(residboot) 83 | SIGMAboot <- (1 / (temp-N)) * sseboot 84 | 85 | # Identification scheme 86 | B0boot <- t(chol(SIGMAboot)) 87 | 88 | # Save only non-explosive IRFs 89 | THETA <- getcomp(Bboot,bigL) 90 | 91 | eigboot <- eigen(THETA)$values 92 | 93 | if (max(abs(eigboot)) < 1) { 94 | 95 | IRFBOOT[[irep]] <- getirf(Bboot,bigL,B0boot,FHORZ,scalefact,CUMULATIVE) 96 | 97 | print(paste0('Bootstrap replication: ',irep)) 98 | 99 | irep <- irep + 1 100 | 101 | } 102 | 103 | } 104 | 105 | # Bootstrap ends here 106 | #------------------------------------------------------------------------------------------ 107 | 108 | # Construct confidence intervals 109 | # Create matrix for the distribution of the parameters 110 | distrpar <- matrix(0, nrow = (kvar*(FHORZ+1))*kvar , ncol = ndraws) 111 | colnames(distrpar) <- paste0('iter',1:ndraws) 112 | npars <- nrow(distrpar) 113 | 114 | for (ii in 1 : ndraws) { 115 | 116 | distrpar[,ii] <- matrix(IRFBOOT[[ii]]) 117 | 118 | } 119 | 120 | # Compute lower and upper bands 121 | siglev <- 1 - cb 122 | lowb <- siglev / 2 123 | uppb <- 1 - (siglev / 2) 124 | 125 | qnts <- t(apply(distrpar, MARGIN = 1, function(x) quantile(sort(x) , c(lowb , 0.5 , uppb) ))) 126 | 127 | LWbands <- array(qnts[,1] , dim = c(FHORZ+1, kvar, kvar)) 128 | MEDbands <- array(qnts[,2] , dim = c(FHORZ+1, kvar, kvar)) 129 | UPbands <- array(qnts[,3] , dim = c(FHORZ+1, kvar, kvar)) 130 | 131 | # Create output for IRF [HORIZON x PERCENTILES x VARIABLE x SHOCK] 132 | IRFOUTPUT <- array(0, dim = c(FHORZ+1, 3, kvar, kvar) , dimnames = list(paste0('H=', 0:FHORZ), c('LW','MED','UB'), paste0('y', 1:kvar), paste0('eps', 1:kvar))) 133 | 134 | for (ishock in 1 : kvar) { # for each shock 135 | 136 | for (kk in 1 : kvar) { 137 | 138 | IRFOUTPUT[,,kk,ishock] <- cbind(LWbands[,kk,ishock],MEDbands[,kk,ishock],UPbands[,kk,ishock]) # k-th variable, i-th shock 139 | 140 | } 141 | 142 | } 143 | 144 | return(IRFOUTPUT) 145 | 146 | } 147 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/getlag.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # getlag.R 3 | #======================================================================================================= 4 | # This function constructs the matrix containing the lagged endogenous variables plus the intercept 5 | # 6 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 7 | # contact: fabioparla123@gmail.com 8 | # Dublin, May 2021 9 | # 10 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 11 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 12 | #======================================================================================================= 13 | 14 | 15 | getlag <- function(DATAMAT,plag,CONSTANT) { 16 | 17 | if (is.matrix(DATAMAT) == FALSE) { 18 | 19 | DATAMAT <- matrix(DATAMAT) 20 | 21 | } 22 | 23 | kvar <- ncol(DATAMAT) 24 | TOBS <- nrow(DATAMAT) 25 | TESS <- TOBS - plag 26 | 27 | X <- matrix(0, nrow = TESS, ncol = 0) 28 | 29 | # Lagged endogenous variables 30 | for (tt in 1 : plag) { 31 | 32 | X <- cbind(X , DATAMAT[((1+plag)-tt) : (TOBS-tt) , ]) 33 | 34 | } 35 | 36 | if (!is.null(colnames(DATAMAT))) { 37 | 38 | colnames(X) <- paste0(rep(colnames(DATAMAT) , plag), '_l', rep(1:plag, each=kvar)) 39 | 40 | } else { 41 | 42 | colnames(X) <- paste0(rep(paste0('y', 1:kvar), plag), '_l', rep(1:plag, each=kvar)) 43 | 44 | } 45 | 46 | # Constant 47 | if (CONSTANT == 1) { 48 | 49 | X <- cbind(X , rep(1 , TESS)) 50 | colnames(X)[ncol(X)] <- 'constant' 51 | 52 | } else if(CONSTANT == 0) { 53 | 54 | X <- X 55 | 56 | } 57 | 58 | return(X) 59 | 60 | } 61 | 62 | 63 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/plotfevd.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # plotfevd.R 3 | #======================================================================================================= 4 | # This function plots the Forecast Error Variance Decomposition 5 | # 6 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 7 | # contact: fabioparla123@gmail.com 8 | # Dublin, May 2021 9 | # 10 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 11 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 12 | #======================================================================================================= 13 | 14 | 15 | plotfevd <- function(CAPFEVD,FEVDPE,labnames,shock) { 16 | 17 | fhor <- dim(CAPFEVD)[1] 18 | k <- dim(CAPFEVD)[3] 19 | 20 | plotlist <- list() 21 | 22 | for (ii in 1 : k) { 23 | 24 | lbp <- labnames[ii] 25 | 26 | DF <- data.frame(0:(fhor-1),CAPFEVD[,,ii,shock],FEVDPE[,ii]) 27 | names(DF) <- c("STEP" ,"LOWER", "MEDIAN", "UPPER","P.ESTIMATE") 28 | 29 | P0 <- ggplot(DF , aes(STEP, DF[,5])) + geom_line(colour="blue", size = 1) + 30 | geom_ribbon(data=DF ,aes(ymin=LOWER, ymax=UPPER), alpha=0.4, fill = 'grey') + theme_classic() + 31 | labs(y = '', x = 'Quarters') + ggtitle(paste0('Contribution to FEV of ',labnames[ii])) + 32 | theme(plot.title = element_text(size = 12)) + theme(plot.title = element_text(hjust = 0.5)) + 33 | geom_hline(yintercept=0, color = "black", size=0.2) 34 | 35 | plotlist[[ii]] <- ggplotGrob(P0) 36 | 37 | } 38 | 39 | do.call(grid.arrange , c(plotlist,ncol=2)) 40 | 41 | } 42 | 43 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/plothd.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # plothd.R 3 | #======================================================================================================= 4 | # This function plots the contribution of a structural shock along the detrended time series (i.e. 5 | # removing the deterministic components) 6 | # 7 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 8 | # contact: fabioparla123@gmail.com 9 | # Dublin, May 2021 10 | # 11 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 12 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 13 | #======================================================================================================= 14 | 15 | 16 | plothd <- function(DATES,L,DATAMAT,HD,shock,NAMES) { 17 | 18 | 19 | DATESPLOT <- DATES[(1+L):length(DATES)] 20 | 21 | capT <- nrow(DATAMAT) 22 | YTEMP <- DATAMAT[(1+L):capT, ] 23 | k <- ncol(DATAMAT) 24 | 25 | CONTRIB <- HD$HDunexp[,shock,] # Contribution of the shock of interest 26 | 27 | 28 | plotlist <- list() 29 | 30 | for (ii in 1:k) { 31 | 32 | PLOTHD <- data.frame(DATESP=DATESPLOT,DETRENDED=YTEMP[,ii]-t(HD$HDinit)[-1,ii],CONTRIBUTION=CONTRIB[-1,ii]) 33 | 34 | P1 <- ggplot() + 35 | geom_line(data=PLOTHD, aes(x=DATESP, y=DETRENDED, color="De-trended series"), size=0.8) + 36 | geom_line(data=PLOTHD, aes(x=DATESP, y=CONTRIBUTION, color="Contribution shock"), size=0.8) + 37 | scale_colour_manual(name='', values=c("De-trended series"="black", "Contribution shock"="red")) + 38 | theme_classic() + labs(y = '', x = 'Years') + 39 | ggtitle(paste0('Historical decomposition: ', NAMES[ii])) + 40 | theme(plot.title = element_text(size = 12)) + theme(plot.title = element_text(hjust = 0.5)) + 41 | theme(legend.position="top") + theme(legend.title = element_text(size=18)) + 42 | geom_hline(yintercept=0, color = "black", size=0.2) 43 | 44 | plotlist[[ii]] <- ggplotGrob(P1) 45 | 46 | } 47 | 48 | do.call(grid.arrange , c(plotlist,ncol=2)) 49 | 50 | 51 | } -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/plotirf.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # plotirf.R 3 | #======================================================================================================= 4 | # This function plots the impulse response functions 5 | # 6 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 7 | # contact: fabioparla123@gmail.com 8 | # Dublin, May 2021 9 | # 10 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 11 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 12 | #======================================================================================================= 13 | 14 | 15 | plotirf <- function(CAPIRF,IRFPE,labnames,shock) { 16 | 17 | fhor <- dim(CAPIRF)[1] 18 | k <- dim(CAPIRF)[3] 19 | 20 | plotlist <- list() 21 | 22 | for (ii in 1 : k) { 23 | 24 | lbp <- labnames[ii] 25 | 26 | DF <- data.frame(0:(fhor-1),CAPIRF[,,ii,shock],IRFPE[,ii]) 27 | names(DF) <- c("STEP" ,"LOWER", "MEDIAN", "UPPER","P.ESTIMATE") 28 | 29 | P0 <- ggplot(DF , aes(STEP, DF[,5])) + geom_line(colour="blue", size = 1) + 30 | geom_ribbon(data=DF ,aes(ymin=LOWER, ymax=UPPER), alpha=0.4, fill = 'grey') + theme_classic() + 31 | labs(y = '', x = 'Quarters') + ggtitle(labnames[ii]) + theme(plot.title = element_text(size = 12)) + 32 | theme(plot.title = element_text(hjust = 0.5)) + geom_hline(yintercept=0, color = "black", size=0.2) 33 | 34 | plotlist[[ii]] <- ggplotGrob(P0) 35 | 36 | } 37 | 38 | do.call(grid.arrange , c(plotlist,ncol=2)) 39 | 40 | } 41 | 42 | -------------------------------------------------------------------------------- /Alessia Paccagnini/functions/printfevd.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # printfevd.R 3 | #======================================================================================================= 4 | # This function reshapes the Forecast Error Variance Decomposition such that the object has the following 5 | # dimension: [HORIZON x VARIABLE x SHOCK] 6 | # 7 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 8 | # contact: fabioparla123@gmail.com 9 | # Dublin, May 2021 10 | # 11 | # Disclaimer: The views expressed in these teaching materials are those of the authors and do not reflect 12 | # the views of the Central Bank of Ireland or the ESCB. Any errors are our own. 13 | #======================================================================================================= 14 | 15 | printfevd <- function(xfevd) { 16 | 17 | # Set dimensions for the reshape 18 | FHORZ <- dim(xfevd)[3] 19 | EPS <- dim(xfevd)[2] 20 | KVAR <- dim(xfevd)[1] 21 | 22 | # Assign labels 23 | # Endogenous variables 24 | if ( is.null(dimnames(xfevd)[[1]]) == FALSE ) { 25 | 26 | labVAR <- dimnames(xfevd)[[1]] 27 | 28 | } else { 29 | 30 | labVAR <- paste0('y', 1:KVAR) 31 | 32 | } 33 | 34 | # Forecast horizon 35 | if ( is.null(dimnames(xfevd)[[3]]) == FALSE ) { 36 | 37 | labHORZ <- dimnames(xfevd)[[3]] 38 | 39 | } else { 40 | 41 | labHORZ <- paste0('hor', 1:FHORZ) 42 | 43 | } 44 | 45 | # Shocks 46 | if ( is.null(dimnames(xfevd)[[2]]) == FALSE ) { 47 | 48 | labEPS <- dimnames(xfevd)[[2]] 49 | 50 | } else { 51 | 52 | labEPS <- paste0('eps', 1:EPS) 53 | 54 | } 55 | 56 | # Reshape the FEVD 57 | pfevd <- array(0, dim = c(FHORZ, KVAR, EPS) , dimnames = list(labHORZ, labVAR, labEPS) ) # [FHORZ x KVAR x EPS] 58 | 59 | for (jj in 1 : EPS) { 60 | 61 | for (kk in 1 : KVAR) { 62 | 63 | for (hh in 1 : FHORZ) { 64 | 65 | pfevd[hh,kk,jj] <- xfevd[kk,jj,hh] 66 | 67 | } 68 | 69 | } 70 | 71 | } 72 | 73 | return(pfevd) 74 | 75 | } 76 | 77 | 78 | 79 | -------------------------------------------------------------------------------- /Alessia Paccagnini/main.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Alessia Paccagnini/main.R -------------------------------------------------------------------------------- /Alessia Paccagnini/packages/packages.R: -------------------------------------------------------------------------------- 1 | #======================================================================================================= 2 | # packages.R 3 | #======================================================================================================= 4 | # This script uploads packages. 5 | # Note. Uncomment "install.packages" if the package 6 | # has not been installed, yet. 7 | # 8 | # Author: Alessia Paccagnini (UCD) and Fabio Parla (CBI) 9 | # contact: fabioparla123@gmail.com 10 | # Dublin, May 2021 11 | # 12 | # Disclaimer: The views expressed in this code are those of the authors and do not reflect the views 13 | # of the Central Bank of Ireland or the ESCB. 14 | #======================================================================================================= 15 | 16 | 17 | # install.packages("Matrix") 18 | library(Matrix) 19 | 20 | # install.packages('expm') 21 | library(expm) 22 | 23 | # install.packages("ggplot2") 24 | library(ggplot2) 25 | 26 | # install.packages("gridExtra") 27 | library(gridExtra) 28 | 29 | 30 | -------------------------------------------------------------------------------- /Alexandre Lima/Compartilhar.md: -------------------------------------------------------------------------------- 1 | # Share Your Data and Code for - V International Seminar on Statistics with R 2 | 3 | . 4 | -------------------------------------------------------------------------------- /Beatriz Milz/README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>" 11 | ) 12 | ``` 13 | 14 | # Share Your Data and Code 15 | 16 | Palestra: Coleta de dados automatizada e integração contínua utilizando GitHub Actions: Exemplos com o Pacote Mananciais 17 | 18 | Por: [Beatriz Milz](https://beatrizmilz.com/) 19 | 20 | ### Links úteis 21 | 22 | - [Slides](https://beatrizmilz.github.io/2021-SER/) 23 | - [Slides em PDF](https://github.com/eventoseroficial/Data_and_Code/blob/main/Beatriz%20Milz/slides.pdf) 24 | - [Pacote mananciais](https://beatrizmilz.github.io/mananciais/index.html) 25 | - [Exemplo de base de dados](https://github.com/eventoseroficial/Data_and_Code/blob/main/Beatriz%20Milz/dados_exemplo_mananciais.Rds) - gerado no código abaixo! 26 | 27 | 28 | ### Exemplo de uso do pacote 29 | 30 | ```{r grafico, echo=TRUE, dpi = 300} 31 | # Instalar o pacote 32 | # install.packages("devtools") 33 | # devtools::install_github("beatrizmilz/mananciais") 34 | 35 | 36 | # Buscando os dados no pacote 37 | mananciais <- mananciais::dados_mananciais() 38 | 39 | # Exportando os dados para que fiquem disponíveis neste repositório 40 | 41 | readr::write_rds(mananciais, file = "dados_exemplo_mananciais.Rds") 42 | 43 | 44 | # Criando visualizações com os dados 45 | 46 | library(magrittr, include.only = "%>%") 47 | mananciais %>% 48 | ggplot2::ggplot() + 49 | ggplot2::geom_line(ggplot2::aes(x = data, y = volume_porcentagem), color = "#3e7dab") + 50 | ggplot2::scale_y_continuous(breaks = c(-25, 0, 25, 50, 75, 100)) + 51 | ggplot2::facet_wrap(~ sistema, ncol = 2) + 52 | ggplot2::theme_minimal() + 53 | ggplot2::labs(x = "Ano", y = "Volume operacional (%)") 54 | ``` 55 | 56 | 57 | ### Resumo 58 | 59 | O GitHub Actions [GHA](https://docs.github.com/pt/actions) permite automatizar fluxos de trabalho de desenvolvimento de pacotes em R. Nessa palestra, será mostrado alguns exemplos de uso de GitHub Actions no pacote Mananciais, que disponibiliza dados sobre o volume operacional em reservatórios utilizados para abastecimento público na Região Metropolitana de São Paulo. Os exemplos que utilizam GHA são: atualização da base de dados, checagem do pacote, execução de testes e avaliação da cobertura de testes. O pacote foi desenvolvido por Beatriz Milz, e pode ser acessado em: https://beatrizmilz.github.io/mananciais/index.html . Este pacote foi pensado para atender demandas de pessoas pesquisadoras que não somente utilizam R, disponibilizando também a base de dados atualizada diariamente em csv e em xlsx. 60 | 61 | 62 | - [Apresentações passadas disponíveis neste link](https://beatrizmilz.com/apresentacoes.html). 63 | -------------------------------------------------------------------------------- /Beatriz Milz/README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # Share Your Data and Code 5 | 6 | Palestra: Coleta de dados automatizada e integração contínua utilizando 7 | GitHub Actions: Exemplos com o Pacote Mananciais 8 | 9 | Por: [Beatriz Milz](https://beatrizmilz.com/) 10 | 11 | ### Links úteis 12 | 13 | - [Slides](https://beatrizmilz.github.io/2021-SER/) 14 | - [Slides em 15 | PDF](https://github.com/eventoseroficial/Data_and_Code/blob/main/Beatriz%20Milz/slides.pdf) 16 | - [Pacote 17 | mananciais](https://beatrizmilz.github.io/mananciais/index.html) 18 | - [Exemplo de base de 19 | dados](https://github.com/eventoseroficial/Data_and_Code/blob/main/Beatriz%20Milz/dados_exemplo_mananciais.Rds) - 20 | gerado no código abaixo! 21 | 22 | ### Exemplo de uso do pacote 23 | 24 | ``` r 25 | # Instalar o pacote 26 | # install.packages("devtools") 27 | # devtools::install_github("beatrizmilz/mananciais") 28 | 29 | 30 | # Buscando os dados no pacote 31 | mananciais <- mananciais::dados_mananciais() 32 | 33 | # Exportando os dados para que fiquem disponíveis neste repositório 34 | 35 | readr::write_rds(mananciais, file = "dados_exemplo_mananciais.Rds") 36 | 37 | 38 | # Criando visualizações com os dados 39 | 40 | library(magrittr, include.only = "%>%") 41 | mananciais %>% 42 | ggplot2::ggplot() + 43 | ggplot2::geom_line(ggplot2::aes(x = data, y = volume_porcentagem), color = "#3e7dab") + 44 | ggplot2::scale_y_continuous(breaks = c(-25, 0, 25, 50, 75, 100)) + 45 | ggplot2::facet_wrap(~ sistema, ncol = 2) + 46 | ggplot2::theme_minimal() + 47 | ggplot2::labs(x = "Ano", y = "Volume operacional (%)") 48 | ``` 49 | 50 | ![](README_files/figure-gfm/grafico-1.png) 51 | 52 | ### Resumo 53 | 54 | O GitHub Actions [GHA](https://docs.github.com/pt/actions) permite 55 | automatizar fluxos de trabalho de desenvolvimento de pacotes em R. Nessa 56 | palestra, será mostrado alguns exemplos de uso de GitHub Actions no 57 | pacote Mananciais, que disponibiliza dados sobre o volume operacional em 58 | reservatórios utilizados para abastecimento público na Região 59 | Metropolitana de São Paulo. Os exemplos que utilizam GHA são: 60 | atualização da base de dados, checagem do pacote, execução de testes e 61 | avaliação da cobertura de testes. O pacote foi desenvolvido por Beatriz 62 | Milz, e pode ser acessado em: 63 | . Este pacote foi 64 | pensado para atender demandas de pessoas pesquisadoras que não somente 65 | utilizam R, disponibilizando também a base de dados atualizada 66 | diariamente em csv e em xlsx. 67 | 68 | - [Apresentações passadas disponíveis neste 69 | link](https://beatrizmilz.com/apresentacoes.html). 70 | -------------------------------------------------------------------------------- /Beatriz Milz/README_files/figure-gfm/grafico-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Beatriz Milz/README_files/figure-gfm/grafico-1.png -------------------------------------------------------------------------------- /Beatriz Milz/dados_exemplo_mananciais.Rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Beatriz Milz/dados_exemplo_mananciais.Rds -------------------------------------------------------------------------------- /Beatriz Milz/slides.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Beatriz Milz/slides.pdf -------------------------------------------------------------------------------- /Bruna Wundervald/Compartilhar.md: -------------------------------------------------------------------------------- 1 | # Share Your Data and Code for - V International Seminar on Statistics with R 2 | 3 | # Link to complete GitHub repository: https://github.com/brunaw/reg-rf-demo 4 | 5 | 6 | -------------------------------------------------------------------------------- /Bruna Wundervald/code/aux.R: -------------------------------------------------------------------------------- 1 | n_vars <- function(importance) { 2 | vars <- importance 3 | vv <- names(vars)[vars > 0] 4 | length(vv) 5 | } 6 | 7 | acc_test <- function(rf, test){ 8 | 9 | pp <- ranger:::predict.ranger(rf$fit, test)$predictions 10 | 11 | pred_test <- 12 | pp %>% as.data.frame() %>% 13 | pivot_longer(cols = c(good, poor)) %>% 14 | mutate(ind = rep(1:nrow(test), each = 2)) %>% 15 | group_by(ind) %>% 16 | filter(value == max(value)) %>% 17 | pull(name) 18 | 19 | round(sum(pred_test == test$class)/nrow(test), 3) 20 | } 21 | 22 | 23 | '%!in%' <- function(x,y)!('%in%'(x,y)) 24 | 25 | 26 | get_formula <- function(importance){ 27 | vars <- importance 28 | vv <- names(vars)[vars > 0] 29 | form <- paste("class ~ ", paste0(vv, collapse = ' + ')) %>% 30 | as.formula() 31 | form 32 | } 33 | 34 | get_vars <- function(importance){ 35 | vars <- importance 36 | vv <- names(vars)[vars > 0] 37 | vv 38 | } 39 | 40 | modelling_reev <- function(train, forms, 41 | reg_factor = 1, depth = FALSE){ 42 | mtry <- round(sqrt(ncol(model.matrix(forms, train)) - 1)) 43 | 44 | rf_mod <- 45 | rand_forest(trees = 500, mtry = mtry) %>% 46 | set_engine("ranger", importance = "impurity", 47 | regularization.factor = reg_factor, 48 | regularization.usedepth = depth) %>% 49 | set_mode("classification") %>% 50 | parsnip::fit(forms, data = train) 51 | return(rf_mod) 52 | } 53 | -------------------------------------------------------------------------------- /Bruna Wundervald/code/code.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(tidymodels) 3 | library(infotheo) 4 | library(patchwork) 5 | set.seed(2021) 6 | 7 | # Loading data --------- 8 | data('gravier', package = 'datamicroarray') 9 | gravier <- data.frame( 10 | class = gravier$y, 11 | gravier$x 12 | ) 13 | 14 | folds <- rsample::vfold_cv(gravier, v = 5) %>% 15 | dplyr::mutate(train = map(splits, training), 16 | test = map(splits, testing)) 17 | 18 | # Checking class proportions --- 19 | folds %>% 20 | pull(train) %>% 21 | .[[1]] %>% 22 | janitor::tabyl(class) 23 | 24 | folds %>% 25 | pull(test) %>% 26 | .[[1]] %>% 27 | janitor::tabyl(class) 28 | 29 | #---------------------------------------------- 30 | modelling <- function(train, reg_factor = 1, mtry = 1){ 31 | rf_mod <- 32 | rand_forest(trees = 500, mtry = (mtry * ncol(train)) - 1) %>% 33 | set_engine("ranger", importance = "impurity", 34 | regularization.factor = reg_factor) %>% 35 | set_mode("classification") %>% 36 | parsnip::fit(class ~ ., data = train) 37 | return(rf_mod) 38 | } 39 | 40 | penalization <- function(gamma, lambda_0, 41 | data = NULL, imps = NULL, type = "rf"){ 42 | if(type == "rf"){ 43 | imps <- imps/max(imps) 44 | imp_mixing <- imps * gamma + (1 - gamma) * lambda_0 45 | return(imp_mixing) 46 | } else if(type == "MI"){ 47 | mi <- function(data, var){ 48 | mutinformation(c(data$class), data %>% pull(var)) 49 | } 50 | # Calculating the mutual information values 51 | disc_data <- infotheo::discretize(data) 52 | disc_data$class <- as.factor(data$class) 53 | names_data <- names(data)[-1] 54 | mi_vars <- names_data %>% map_dbl(~{ mi(data = disc_data, var = .x) }) 55 | mi_mixing <- (1 - gamma) * lambda_0 + gamma * (mi_vars/max(mi_vars)) 56 | return(mi_mixing) 57 | } 58 | } 59 | 60 | # -------------------------------------------------------------- 61 | # Setting all parameters ------------------------ 62 | mtry <- tibble(mtry = c(0.20, 0.45, 0.85)) 63 | gamma_f <- c(0.3, 0.5, 0.8) 64 | lambda_0_f <- c(0.35, 0.75) 65 | 66 | parameters <- mtry %>% 67 | tidyr::crossing(lambda_0_f, gamma_f) 68 | 69 | # Adds gamma_f and lambda_0_f and run the functions with them ------ 70 | folds_imp <- folds %>% 71 | dplyr::mutate( 72 | # Run the standard random forest model for the 5 folds 73 | model = purrr::map(train, modelling), 74 | importances_std = purrr::map(model, ~{.x$fit$variable.importance})) %>% 75 | tidyr::expand_grid(parameters) %>% 76 | dplyr::mutate(imp_rf = purrr::pmap( 77 | list(gamma_f, lambda_0_f, train, importances_std), type = "rf", 78 | penalization), 79 | imp_mi = purrr::pmap( 80 | list(gamma_f, lambda_0_f, train, importances_std), type = "MI", penalization)) 81 | 82 | saveRDS(folds_imp, file = "results/folds_imp.rds") 83 | 84 | folds_imp %>% 85 | dplyr::select(2, 6:11) %>% 86 | dplyr::slice(1:3) %>% 87 | saveRDS(file = "results/folds_imp_head.rds") 88 | 89 | # Running models with all the new importance values ------ 90 | run_all_models <- folds_imp %>% 91 | dplyr::select(id, model, train, test, imp_rf, imp_mi, mtry, lambda_0_f, gamma_f) %>% 92 | tidyr::gather(type, importance, -train, -test, -mtry, 93 | -id, -model, -lambda_0_f, -gamma_f) %>% 94 | dplyr::mutate(fit_penalized_rf = 95 | purrr::pmap(list(train, importance, mtry), modelling)) 96 | 97 | dim(run_all_models) 98 | saveRDS(run_all_models, file = "results/run_all_models.rds") 99 | 100 | # Evaluating all models ------ 101 | # Extract: 102 | # Important variables, number used, test accuracy 103 | 104 | # First, for the standard random forests we have: 105 | metric_std_rf <- folds_imp %>% 106 | dplyr::group_by(id) %>% 107 | dplyr::slice(1) %>% 108 | dplyr::ungroup() %>% 109 | dplyr::select(id, model, train, test) %>% 110 | dplyr::mutate( 111 | model_importance = purrr::map(model, ~{.x$fit$variable.importance}), 112 | n_var = purrr::map_dbl(model_importance, n_vars), 113 | accuracy_test_std = purrr::map2_dbl( 114 | .x = model, .y = test, ~{ acc_test(.x, test = .y)}), 115 | accuracy_std = 1 -purrr::map_dbl(model, ~{ .x$fit$prediction.error}) 116 | ) %>% 117 | dplyr::select(id, n_var, accuracy_test_std, accuracy_std) 118 | 119 | saveRDS(metric_std_rf, "results/metric_std_rf.rds") 120 | 121 | results <- run_all_models %>% 122 | dplyr::mutate( 123 | model_importance = purrr::map(fit_penalized_rf, ~{.x$fit$variable.importance}), 124 | n_var = purrr::map_dbl(model_importance, n_vars), 125 | accuracy = 1 - purrr::map_dbl(fit_penalized_rf, ~{ .x$fit$prediction.error}), 126 | accuracy_test = purrr::map2_dbl( 127 | .x = fit_penalized_rf, .y = test, ~{ acc_test(.x, .y)})) 128 | 129 | results %>% 130 | dplyr::select(-train, -test, -importance, -model, 131 | -fit_penalized_rf, -model_importance) %>% 132 | dplyr::arrange(id, desc(accuracy_test), 133 | desc(accuracy), n_var) %>% 134 | saveRDS("results/results_table.rds") 135 | 136 | # Plots ---------------------------- 137 | p1 <- results %>% 138 | group_by(mtry, type, gamma_f) %>% 139 | ggplot(aes(y = accuracy_test, x = factor(mtry))) + 140 | facet_wrap(~type + gamma_f, 141 | labeller= label_bquote(gamma~"="~.(gamma_f)~", g("~x[i]~") ="~.(type))) + 142 | geom_boxplot(fill = "#e68c7c") + 143 | labs(y = "Test accuracy", x = "mtry (%)") + 144 | scale_y_continuous(breaks = scales::pretty_breaks()) + 145 | theme_bw(18) 146 | 147 | p1 148 | 149 | p2 <- results %>% 150 | ggplot(aes(y = n_var, x = factor(mtry))) + 151 | facet_wrap(~type + gamma_f, 152 | labeller= label_bquote(gamma~"="~.(gamma_f)~", g("~x[i]~") ="~.(type))) + 153 | geom_boxplot(fill = "#e68c7c") + 154 | labs(y = "Number of variables used", x = "mtry (%)") + 155 | scale_y_continuous(breaks = scales::pretty_breaks()) + 156 | theme_bw(18) 157 | 158 | p2 159 | p1 + p2 + plot_layout(nrow = 1) 160 | 161 | saveRDS(results, "results/results.rds") 162 | # -------------------------------------------------------- 163 | best_models <- results %>% 164 | arrange(desc(accuracy_test), desc(accuracy), n_var) %>% 165 | group_by(id) %>% 166 | slice(1:3) %>% 167 | ungroup() %>% 168 | mutate(new_formula = map(model_importance, get_formula)) 169 | 170 | # Re-evaluating selected variables ----------------- 171 | reev <- tibble( 172 | forms = best_models$new_formula 173 | ) %>% 174 | tidyr::expand_grid(folds) %>% 175 | dplyr::mutate( 176 | reev_models = purrr::map2(train, forms, modelling_reev)) 177 | # 178 | results_reev <- reev %>% 179 | dplyr::mutate( 180 | feat_importance = purrr::map(reev_models, ~{.x$fit$variable.importance}), 181 | n_var = purrr::map_dbl(feat_importance, n_vars), 182 | accuracy = 1 - purrr::map_dbl(reev_models, ~{ .x$fit$prediction.error}), 183 | accuracy_test = purrr::map2_dbl( 184 | .x = reev_models, .y = test, ~{ acc_test(.x, test = .y)})) 185 | 186 | 187 | saveRDS(results_reev, "results/results_reev.rds") 188 | 189 | selected_vars <- results_reev %>% 190 | arrange(desc(accuracy_test), desc(accuracy), n_var) %>% 191 | slice(1:30) %>% 192 | mutate( 193 | ind = 1:n(), 194 | vars = map(feat_importance, get_vars)) %>% 195 | dplyr::select(ind, vars) %>% 196 | unnest() %>% 197 | group_by(vars) %>% 198 | summarise(count = n()) %>% 199 | arrange(desc(count)) 200 | 201 | final_vars <- selected_vars %>% slice(1:15) %>% pull(vars) 202 | final_form <- paste("class ~ ", paste0(final_vars, collapse = ' + ')) %>% 203 | as.formula() 204 | 205 | saveRDS(final_vars, "results/final_vars.rds") 206 | 207 | set.seed(2021) 208 | folds_20 <- rsample::vfold_cv(gravier, v = 20) %>% 209 | dplyr::mutate(train = map(splits, training), 210 | test = map(splits, testing)) 211 | 212 | # Test it in all splits --- 213 | final_results <- folds_20$splits %>% map(~{ 214 | train <- training(.x) 215 | test <- testing(.x) 216 | 217 | rf <- 218 | rand_forest(trees = 500, mtry = 7) %>% 219 | set_engine("ranger", importance = "impurity") %>% 220 | set_mode("classification") %>% 221 | parsnip::fit(final_form, data = train) 222 | 223 | accuracy_test <- acc_test(rf, test = test) 224 | list(accuracy_test = accuracy_test, 225 | accuracy = 1 - rf$fit$prediction.error, 226 | imp = rf$fit$variable.importance) 227 | }) 228 | 229 | saveRDS(final_results, "results/final_results.rds") 230 | 231 | # Final accuracies and importance values 232 | data.frame(accuracy_test = final_results %>% map_dbl("accuracy_test"), 233 | accuracy = final_results %>% map_dbl("accuracy")) %>% 234 | gather(type, value) %>% 235 | group_by(type) %>% 236 | summarise(mean = mean(value), 237 | median = median(value)) 238 | 239 | final_results %>% 240 | map("imp") %>% 241 | bind_rows() %>% 242 | gather(vars, value) %>% 243 | group_by(vars) %>% 244 | summarise(value = mean(value)) %>% 245 | arrange(desc(value)) %>% 246 | ggplot(aes(x = reorder(vars, value), value)) + 247 | geom_linerange( 248 | aes(ymin = min(value), ymax = value), 249 | position = position_dodge(width = 0.5), size = 1.5, 250 | colour = 'wheat1') + 251 | geom_point(colour = "#f5c04a", size = 3) + 252 | ylab("Average importance values") + 253 | xlab("Variables") + 254 | theme_bw(18) + 255 | coord_flip() 256 | # ---------------------------------------------------------------------- -------------------------------------------------------------------------------- /Bruno Tomio/Card image - Twitter.R: -------------------------------------------------------------------------------- 1 | # https://www.garrickadenbuie.com/blog/sharing-xaringan-slides/#get-your-slides-online 2 | 3 | # IT DOES NOT WORK ON UBUNTU (CHROME PROBLEM?) 4 | 5 | #' Screenshot Your Title Slide for Share Image 6 | #' 7 | #' Takes a screenshot of your title slide for sharing on Twitter 8 | #' (and other social media sites). 9 | #' 10 | #' @param slides_rmd Your slides file 11 | #' @param path Path to new share image 12 | screenshot_share_image <- function( 13 | slides_rmd, 14 | path_image = "share-card.png" 15 | ) { 16 | if (!requireNamespace("webshot2", quietly = TRUE)) { 17 | stop( 18 | "`webshot2` is required: ", 19 | 'remotes::install_github("rstudio/webshot2")' 20 | ) 21 | } 22 | 23 | webshot2::rmdshot( 24 | doc = slides_rmd, 25 | file = path_image, 26 | vheight = 600, 27 | vwidth = 600 * 191 / 100, 28 | rmd_args = list( 29 | output_options = list( 30 | nature = list(ratio = "191:100"), 31 | self_contained = TRUE 32 | ) 33 | ) 34 | ) 35 | 36 | path_image 37 | } 38 | 39 | screenshot_share_image("Slides.Rmd") 40 | -------------------------------------------------------------------------------- /Bruno Tomio/Compartilhar.md: -------------------------------------------------------------------------------- 1 | # Share Your Data and Code for - V International Seminar on Statistics with R 2 | 3 | . 4 | -------------------------------------------------------------------------------- /Bruno Tomio/GDP_search.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/GDP_search.gif -------------------------------------------------------------------------------- /Bruno Tomio/Hands-on.R: -------------------------------------------------------------------------------- 1 | # PACKAGES NEEDED #### 2 | 3 | list.of.packages <- c('WDI', 'ggthemes', 'knitr', 'kableExtra', 'rnaturalearth', 4 | 'tidyverse', 'ggrepel', 'gganimate', 'transformr') 5 | new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] 6 | if(length(new.packages)) install.packages(new.packages) 7 | lapply(list.of.packages, library, character.only = T, quietly = T) 8 | 9 | # SLIDE 2 #### 10 | 11 | # Search for "GDP" 12 | WDIsearch('GDP') 13 | 14 | # Save results for "GDP" 15 | GDP_search <- WDIsearch('GDP') 16 | 17 | # SLIDE 3 #### 18 | 19 | # indicator = NY.GDP.PCAP.KD / name = GDP per capita (constant 2010 US$) 20 | indicator <- c("GDP per capita" = 'NY.GDP.PCAP.KD') 21 | dat1 <- WDI(indicator, country=c('FR', 'BR'), end = 2019) 22 | head(dat1) 23 | 24 | # indicators = NY.GDP.PCAP.KD and NY.GDP.PCAP.KN / names = GDP per capita (constant 2010 US$) and GDP per capita (constant LCU) 25 | indicators <- c("GDP per capita (US$)" = 'NY.GDP.PCAP.KD', "GDP per capita (LCU)" = "NY.GDP.PCAP.KN") 26 | dat2 <- WDI(indicators, country=c('FR', 'BR'), end = 2019) 27 | head(dat2) 28 | 29 | # SLIDE 4 #### 30 | 31 | # GDP per capita for France and Brazil 32 | ggplot(dat1, aes(year, `GDP per capita`, color=country)) + geom_line() + 33 | xlab('Year') + ylab('GDP per capita') 34 | 35 | # SLIDE 5 #### 36 | 37 | # GDP per capita (US$ and local currency unity) for France and Brazil 38 | ggplot(dat2, aes(year, color=country)) + 39 | geom_line(aes(year, `GDP per capita (US$)`)) + 40 | geom_line(aes(year, `GDP per capita (LCU)`), linetype = "dashed") + 41 | xlab('Year') + ylab('GDP per capita') + 42 | labs(caption = "GDP per capita (US$), solid; GDP per capita (LCU), dashed") + 43 | theme_economist() + 44 | scale_colour_economist() 45 | 46 | # SLIDE 6 #### 47 | 48 | Data_info <- WDI_data 49 | Data_series <- as.data.frame(Data_info$series) %>% 50 | filter(indicator == "NY.GDP.PCAP.KD") 51 | colnames(Data_series) 52 | Data_series$description 53 | 54 | # SLIDE 7 #### 55 | 56 | Data_countries <- as.data.frame(Data_info$country) 57 | Data_countries %>% 58 | kable("html") %>% 59 | kable_styling(font_size = 11) %>% 60 | scroll_box(width = "100%", height = "60%") 61 | 62 | # SLIDE 8 #### 63 | 64 | # indicator = NY.GDP.PCAP.KD / name = GDP per capita (constant 2010 US$) 65 | indicator <- c("GDP per capita" = 'IT.NET.USER.ZS') 66 | datall <- WDI(indicator, country="all", end = 2019) 67 | head(datall) 68 | 69 | LATAM <- Data_info$country %>% 70 | data.frame() %>% 71 | filter(region == "Latin America & Caribbean") %>% 72 | select(country) %>% 73 | unlist() 74 | 75 | datall %>% 76 | na.omit() %>% 77 | filter(country %in% LATAM) %>% 78 | ggplot(aes(year, `GDP per capita`)) + geom_line() + 79 | facet_wrap(vars(country), scales = "free_y") 80 | 81 | -------------------------------------------------------------------------------- /Bruno Tomio/Hans Rosling’s Gapminder.R: -------------------------------------------------------------------------------- 1 | # PACKAGES NEEDED #### 2 | 3 | list.of.packages <- c('WDI', 'dplyr', 'ggplot2', 'ggthemes', 'knitr', 'kableExtra', 'rnaturalearth', 'tidyverse', 'ggrepel') 4 | new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] 5 | if(length(new.packages)) install.packages(new.packages) 6 | lapply(list.of.packages, library, character.only = T, quietly = T) 7 | 8 | # CODE HRG 1 #### 9 | 10 | indicators <- c(life_exp = "SP.DYN.LE00.IN", 11 | gdp_capita ="NY.GDP.PCAP.CD", 12 | pop = "SP.POP.TOTL") 13 | hrg <- WDI(indicators, country="all", start = "2018", end = "2018") 14 | Data_info <- WDI_data 15 | Data_countries <- as.data.frame(Data_info$country) 16 | hrg %>% 17 | left_join(Data_countries, "iso2c") %>% 18 | filter(region != "Aggregates") %>% # remove aggregates (groups of countries) 19 | ggplot() + 20 | geom_point(aes(x = gdp_capita, y = life_exp, size = pop, color = region)) + 21 | scale_x_continuous( 22 | labels = scales::dollar_format(), 23 | breaks = scales::log_breaks(n = 10)) + 24 | coord_trans(x = 'log10') + 25 | scale_size_continuous( 26 | labels = scales::number_format(scale = 1/1e6, suffix = "m"), 27 | breaks = seq(1e8,1e9, 2e8), 28 | range = c(1,20)) + 29 | theme_minimal() + 30 | labs(title = "An Example of Hans Rosling's Gapminder using WDI (Data for 2018)", 31 | x = "GDP per capita (log scale)", 32 | y = "Life expectancy at birth", 33 | size = "Population", 34 | color = NULL, 35 | caption = "Source: World Bank") 36 | 37 | # CODE HRG 2 #### 38 | 39 | hrg2 <- hrg %>% 40 | left_join(Data_countries, "iso2c") %>% 41 | filter(region != "Aggregates") # remove aggregates (groups of countries) 42 | ggplot(hrg2) + 43 | geom_point( 44 | aes(x = gdp_capita, y = life_exp, size = pop, color = region)) + 45 | scale_x_continuous( 46 | labels = scales::dollar_format(), 47 | breaks = scales::log_breaks(n = 10)) + 48 | coord_trans(x = 'log10') + 49 | scale_size_continuous( 50 | labels = scales::number_format(scale = 1/1e6, suffix = "m"), 51 | breaks = seq(1e8,1e9, 2e8), 52 | range = c(1,20)) + 53 | theme_minimal() + 54 | labs(x = "GDP per capita (log scale)", 55 | y = "Life expectancy at birth", 56 | size = "Population", 57 | color = NULL, 58 | caption = "Source: World Bank") + 59 | geom_label_repel(data = subset(hrg2, life_exp > 84 | life_exp < 55), 60 | aes(x = gdp_capita, y = life_exp, label = country.x), 61 | box.padding = 0.35, 62 | point.padding = 0.5, 63 | segment.color = 'grey50') 64 | 65 | # CODE HRG 3 #### 66 | 67 | ggplot(hrg2) + 68 | geom_point( 69 | aes(x = gdp_capita, y = life_exp, size = pop, color = region)) + 70 | scale_x_continuous( 71 | labels = scales::dollar_format(), 72 | breaks = scales::log_breaks(n = 10)) + 73 | coord_trans(x = 'log10') + 74 | scale_size_continuous( 75 | labels = scales::number_format(scale = 1/1e6, suffix = "m"), 76 | breaks = seq(1e8,1e9, 2e8), 77 | range = c(1,20)) + 78 | theme_minimal() + 79 | labs(x = "GDP per capita (log scale)", 80 | y = "Life expectancy at birth", 81 | size = "Population", 82 | color = NULL, 83 | caption = "Source: World Bank") + 84 | geom_label_repel(data = subset(hrg2, pop > 90000000), # 90 millions 85 | aes(x = gdp_capita, y = life_exp, label = country.x), 86 | box.padding = 0.9, 87 | point.padding = 0.9, 88 | segment.color = 'grey50') 89 | -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-13-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-13-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-14-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-14-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-16-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-16-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-18-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-18-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-20-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-20-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-22-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-22-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-24-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-24-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-26-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-26-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-28-1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-28-1.gif -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-28-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-28-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-30-1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-30-1.gif -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-30-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-30-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-32-1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-32-1.gif -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-32-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-32-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-34-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-34-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-36-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-36-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-38-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-38-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-6-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-6-1.png -------------------------------------------------------------------------------- /Bruno Tomio/Slides_files/figure-html/unnamed-chunk-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/Slides_files/figure-html/unnamed-chunk-7-1.png -------------------------------------------------------------------------------- /Bruno Tomio/WDI - 2021 Talk.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /Bruno Tomio/all-ok.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/eventoseroficial/Data_and_Code_2021/06d2507c14efdf359dfe9280326c0996688f1576/Bruno Tomio/all-ok.PNG -------------------------------------------------------------------------------- /Bruno Tomio/gist.R: -------------------------------------------------------------------------------- 1 | # PACKAGES NEEDED #### 2 | 3 | list.of.packages <- c('WDI', 'ggthemes', 'knitr', 'kableExtra', 'rnaturalearth', 4 | 'tidyverse', 'ggrepel', 'gganimate', 'transformr') 5 | new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] 6 | if(length(new.packages)) install.packages(new.packages) 7 | lapply(list.of.packages, library, character.only = T, quietly = T) 8 | 9 | # Life expectancy at birth, female (years) #### 10 | 11 | indicator <- c("Life expectancy at birth, female (years)" = 'SP.DYN.LE00.FE.IN') 12 | 13 | Data_info <- WDI_data 14 | 15 | datWM6 <- WDI(indicator, country="all",start = '1960', end = '2018') 16 | 17 | name_life <- as.data.frame(Data_info$series) %>% 18 | filter(indicator == "SP.DYN.LE00.FE.IN") %>% 19 | select(name) 20 | 21 | source_life <- as.data.frame(Data_info$series) %>% 22 | filter(indicator == "SP.DYN.LE00.FE.IN") %>% 23 | select(sourceOrganization) 24 | 25 | ne_countries(returnclass = "sf") %>% 26 | left_join(datWM6, c("iso_a2" = "iso2c")) %>% 27 | filter(iso_a2 != "ATA") %>% # remove Antarctica 28 | ggplot() + 29 | geom_sf(aes(fill = `Life expectancy at birth, female (years)`)) + 30 | scale_fill_viridis_c(labels = scales::number_format(scale = 1)) + 31 | theme(legend.position="bottom") + 32 | labs( 33 | title = paste0(name_life, " in {closest_state}"), 34 | fill = NULL, 35 | caption = paste0("Source:", source_life) 36 | ) + 37 | transition_states(year) -------------------------------------------------------------------------------- /Bruno Tomio/libs/clipboard/clipboard.min.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * clipboard.js v2.0.6 3 | * https://clipboardjs.com/ 4 | * 5 | * Licensed MIT © Zeno Rocha 6 | */ 7 | !function(t,e){"object"==typeof exports&&"object"==typeof module?module.exports=e():"function"==typeof define&&define.amd?define([],e):"object"==typeof exports?exports.ClipboardJS=e():t.ClipboardJS=e()}(this,function(){return o={},r.m=n=[function(t,e){t.exports=function(t){var e;if("SELECT"===t.nodeName)t.focus(),e=t.value;else if("INPUT"===t.nodeName||"TEXTAREA"===t.nodeName){var n=t.hasAttribute("readonly");n||t.setAttribute("readonly",""),t.select(),t.setSelectionRange(0,t.value.length),n||t.removeAttribute("readonly"),e=t.value}else{t.hasAttribute("contenteditable")&&t.focus();var o=window.getSelection(),r=document.createRange();r.selectNodeContents(t),o.removeAllRanges(),o.addRange(r),e=o.toString()}return e}},function(t,e){function n(){}n.prototype={on:function(t,e,n){var o=this.e||(this.e={});return(o[t]||(o[t]=[])).push({fn:e,ctx:n}),this},once:function(t,e,n){var o=this;function r(){o.off(t,r),e.apply(n,arguments)}return r._=e,this.on(t,r,n)},emit:function(t){for(var e=[].slice.call(arguments,1),n=((this.e||(this.e={}))[t]||[]).slice(),o=0,r=n.length;o :first-child"); 5 | var i, h, a; 6 | for (i = 0; i < hs.length; i++) { 7 | h = hs[i]; 8 | if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6 9 | a = h.attributes; 10 | while (a.length > 0) h.removeAttribute(a[0].name); 11 | } 12 | }); 13 | -------------------------------------------------------------------------------- /Bruno Tomio/libs/kePrint/kePrint.js: -------------------------------------------------------------------------------- 1 | $(document).ready(function(){ 2 | if (typeof $('[data-toggle="tooltip"]').tooltip === 'function') { 3 | $('[data-toggle="tooltip"]').tooltip(); 4 | } 5 | if ($('[data-toggle="popover"]').popover === 'function') { 6 | $('[data-toggle="popover"]').popover(); 7 | } 8 | }); 9 | -------------------------------------------------------------------------------- /Bruno Tomio/libs/lightable/lightable.css: -------------------------------------------------------------------------------- 1 | /*! 2 | * lightable v0.0.1 3 | * Copyright 2020 Hao Zhu 4 | * Licensed under MIT (https://github.com/haozhu233/kableExtra/blob/master/LICENSE) 5 | */ 6 | 7 | .lightable-minimal { 8 | border-collapse: separate; 9 | border-spacing: 16px 1px; 10 | width: 100%; 11 | margin-bottom: 10px; 12 | } 13 | 14 | .lightable-minimal td { 15 | margin-left: 5px; 16 | margin-right: 5px; 17 | } 18 | 19 | .lightable-minimal th { 20 | margin-left: 5px; 21 | margin-right: 5px; 22 | } 23 | 24 | .lightable-minimal thead tr:last-child th { 25 | border-bottom: 2px solid #00000050; 26 | empty-cells: hide; 27 | 28 | } 29 | 30 | .lightable-minimal tbody tr:first-child td { 31 | padding-top: 0.5em; 32 | } 33 | 34 | .lightable-minimal.lightable-hover tbody tr:hover { 35 | background-color: #f5f5f5; 36 | } 37 | 38 | .lightable-minimal.lightable-striped tbody tr:nth-child(even) { 39 | background-color: #f5f5f5; 40 | } 41 | 42 | .lightable-classic { 43 | border-top: 0.16em solid #111111; 44 | border-bottom: 0.16em solid #111111; 45 | width: 100%; 46 | margin-bottom: 10px; 47 | margin: 10px 5px; 48 | } 49 | 50 | .lightable-classic tfoot tr td { 51 | border: 0; 52 | } 53 | 54 | .lightable-classic tfoot tr:first-child td { 55 | border-top: 0.14em solid #111111; 56 | } 57 | 58 | .lightable-classic caption { 59 | color: #222222; 60 | } 61 | 62 | .lightable-classic td { 63 | padding-left: 5px; 64 | padding-right: 5px; 65 | color: #222222; 66 | } 67 | 68 | .lightable-classic th { 69 | padding-left: 5px; 70 | padding-right: 5px; 71 | font-weight: normal; 72 | color: #222222; 73 | } 74 | 75 | .lightable-classic thead tr:last-child th { 76 | border-bottom: 0.10em solid #111111; 77 | } 78 | 79 | .lightable-classic.lightable-hover tbody tr:hover { 80 | background-color: #F9EEC1; 81 | } 82 | 83 | .lightable-classic.lightable-striped tbody tr:nth-child(even) { 84 | background-color: #f5f5f5; 85 | } 86 | 87 | .lightable-classic-2 { 88 | border-top: 3px double #111111; 89 | border-bottom: 3px double #111111; 90 | width: 100%; 91 | margin-bottom: 10px; 92 | } 93 | 94 | .lightable-classic-2 tfoot tr td { 95 | border: 0; 96 | } 97 | 98 | .lightable-classic-2 tfoot tr:first-child td { 99 | border-top: 3px double #111111; 100 | } 101 | 102 | .lightable-classic-2 caption { 103 | color: #222222; 104 | } 105 | 106 | .lightable-classic-2 td { 107 | padding-left: 5px; 108 | padding-right: 5px; 109 | color: #222222; 110 | } 111 | 112 | .lightable-classic-2 th { 113 | padding-left: 5px; 114 | padding-right: 5px; 115 | font-weight: normal; 116 | color: #222222; 117 | } 118 | 119 | .lightable-classic-2 tbody tr:last-child td { 120 | border-bottom: 3px double #111111; 121 | } 122 | 123 | .lightable-classic-2 thead tr:last-child th { 124 | border-bottom: 1px solid #111111; 125 | } 126 | 127 | .lightable-classic-2.lightable-hover tbody tr:hover { 128 | background-color: #F9EEC1; 129 | } 130 | 131 | .lightable-classic-2.lightable-striped tbody tr:nth-child(even) { 132 | background-color: #f5f5f5; 133 | } 134 | 135 | .lightable-material { 136 | min-width: 100%; 137 | white-space: nowrap; 138 | table-layout: fixed; 139 | font-family: Roboto, sans-serif; 140 | border: 1px solid #EEE; 141 | border-collapse: collapse; 142 | margin-bottom: 10px; 143 | } 144 | 145 | .lightable-material tfoot tr td { 146 | border: 0; 147 | } 148 | 149 | .lightable-material tfoot tr:first-child td { 150 | border-top: 1px solid #EEE; 151 | } 152 | 153 | .lightable-material th { 154 | height: 56px; 155 | padding-left: 16px; 156 | padding-right: 16px; 157 | } 158 | 159 | .lightable-material td { 160 | height: 52px; 161 | padding-left: 16px; 162 | padding-right: 16px; 163 | border-top: 1px solid #eeeeee; 164 | } 165 | 166 | .lightable-material.lightable-hover tbody tr:hover { 167 | background-color: #f5f5f5; 168 | } 169 | 170 | .lightable-material.lightable-striped tbody tr:nth-child(even) { 171 | background-color: #f5f5f5; 172 | } 173 | 174 | .lightable-material.lightable-striped tbody td { 175 | border: 0; 176 | } 177 | 178 | .lightable-material.lightable-striped thead tr:last-child th { 179 | border-bottom: 1px solid #ddd; 180 | } 181 | 182 | .lightable-material-dark { 183 | min-width: 100%; 184 | white-space: nowrap; 185 | table-layout: fixed; 186 | font-family: Roboto, sans-serif; 187 | border: 1px solid #FFFFFF12; 188 | border-collapse: collapse; 189 | margin-bottom: 10px; 190 | background-color: #363640; 191 | } 192 | 193 | .lightable-material-dark tfoot tr td { 194 | border: 0; 195 | } 196 | 197 | .lightable-material-dark tfoot tr:first-child td { 198 | border-top: 1px solid #FFFFFF12; 199 | } 200 | 201 | .lightable-material-dark th { 202 | height: 56px; 203 | padding-left: 16px; 204 | padding-right: 16px; 205 | color: #FFFFFF60; 206 | } 207 | 208 | .lightable-material-dark td { 209 | height: 52px; 210 | padding-left: 16px; 211 | padding-right: 16px; 212 | color: #FFFFFF; 213 | border-top: 1px solid #FFFFFF12; 214 | } 215 | 216 | .lightable-material-dark.lightable-hover tbody tr:hover { 217 | background-color: #FFFFFF12; 218 | } 219 | 220 | .lightable-material-dark.lightable-striped tbody tr:nth-child(even) { 221 | background-color: #FFFFFF12; 222 | } 223 | 224 | .lightable-material-dark.lightable-striped tbody td { 225 | border: 0; 226 | } 227 | 228 | .lightable-material-dark.lightable-striped thead tr:last-child th { 229 | border-bottom: 1px solid #FFFFFF12; 230 | } 231 | 232 | .lightable-paper { 233 | width: 100%; 234 | margin-bottom: 10px; 235 | color: #444; 236 | } 237 | 238 | .lightable-paper tfoot tr td { 239 | border: 0; 240 | } 241 | 242 | .lightable-paper tfoot tr:first-child td { 243 | border-top: 1px solid #00000020; 244 | } 245 | 246 | .lightable-paper thead tr:last-child th { 247 | color: #666; 248 | vertical-align: bottom; 249 | border-bottom: 1px solid #00000020; 250 | line-height: 1.15em; 251 | padding: 10px 5px; 252 | } 253 | 254 | .lightable-paper td { 255 | vertical-align: middle; 256 | border-bottom: 1px solid #00000010; 257 | line-height: 1.15em; 258 | padding: 7px 5px; 259 | } 260 | 261 | .lightable-paper.lightable-hover tbody tr:hover { 262 | background-color: #F9EEC1; 263 | } 264 | 265 | .lightable-paper.lightable-striped tbody tr:nth-child(even) { 266 | background-color: #00000008; 267 | } 268 | 269 | .lightable-paper.lightable-striped tbody td { 270 | border: 0; 271 | } 272 | 273 | -------------------------------------------------------------------------------- /Bruno Tomio/libs/panelset/panelset.css: -------------------------------------------------------------------------------- 1 | /* prefixed by https://autoprefixer.github.io (PostCSS: v7.0.23, autoprefixer: v9.7.3) */ 2 | 3 | .panelset { 4 | width: 100%; 5 | position: relative; 6 | --panel-tabs-border-bottom: #ddd; 7 | --panel-tab-foreground: currentColor; 8 | --panel-tab-background: unset; 9 | --panel-tab-active-foreground: currentColor; 10 | --panel-tab-active-background: unset; 11 | --panel-tab-hover-foreground: currentColor; 12 | --panel-tab-hover-background: unset; 13 | --panel-tab-active-border-color: currentColor; 14 | --panel-tab-hover-border-color: currentColor; 15 | --panel-tab-inactive-opacity: 0.5; 16 | --panel-tab-font-family: inherit; 17 | } 18 | 19 | .panelset * { 20 | box-sizing: border-box; 21 | } 22 | 23 | .panelset .panel-tabs { 24 | display: -webkit-box; 25 | display: flex; 26 | flex-wrap: wrap; 27 | -webkit-box-orient: horizontal; 28 | -webkit-box-direction: normal; 29 | flex-direction: row; 30 | -webkit-box-pack: start; 31 | justify-content: start; 32 | -webkit-box-align: center; 33 | align-items: center; 34 | overflow-y: visible; 35 | overflow-x: auto; 36 | -webkit-overflow-scrolling: touch; 37 | padding: 0 0 2px 0; 38 | box-shadow: inset 0 -2px 0px var(--panel-tabs-border-bottom); 39 | } 40 | 41 | .panelset .panel-tabs * { 42 | -webkit-transition: opacity 0.5s ease; 43 | transition: opacity 0.5s ease; 44 | } 45 | 46 | .panelset .panel-tabs .panel-tab { 47 | min-height: 50px; 48 | display: -webkit-box; 49 | display: flex; 50 | -webkit-box-pack: center; 51 | justify-content: center; 52 | -webkit-box-align: center; 53 | align-items: center; 54 | padding: 0.5em 1em; 55 | font-family: var(--panel-tab-font-family); 56 | opacity: var(--panel-tab-inactive-opacity); 57 | border-top: 2px solid transparent; 58 | border-bottom: 2px solid transparent; 59 | margin-bottom: -2px; 60 | color: var(--panel-tab-foreground); 61 | background-color: var(--panel-tab-background); 62 | list-style: none; 63 | z-index: 5; 64 | } 65 | 66 | .panelset .panel-tabs .panel-tab > a { 67 | color: currentColor; 68 | text-decoration: none; 69 | border: none; 70 | } 71 | 72 | .panelset .panel-tabs .panel-tab > a:focus { 73 | outline: none; 74 | text-decoration: none; 75 | border: none; 76 | } 77 | 78 | .panelset .panel-tabs .panel-tab > a:hover { 79 | text-decoration: none; 80 | border: none; 81 | } 82 | 83 | .panelset .panel-tabs .panel-tab:hover { 84 | border-bottom-color: var(--panel-tab-hover-border-color); 85 | color: var(--panel-tab-hover-foreground); 86 | background-color: var(--panel-tab-hover-background); 87 | opacity: 1; 88 | cursor: pointer; 89 | z-index: 10; 90 | } 91 | 92 | .panelset .panel-tabs .panel-tab:focus { 93 | outline: none; 94 | color: var(--panel-tab-hover-foreground); 95 | border-bottom-color: var(--panel-tab-hover-border-color); 96 | background-color: var(--panel-tab-hover-background); 97 | } 98 | 99 | .panelset .panel-tabs .panel-tab.panel-tab-active { 100 | border-top-color: var(--panel-tab-active-border-color); 101 | color: var(--panel-tab-active-foreground); 102 | background-color: var(--panel-tab-active-background); 103 | opacity: 1; 104 | } 105 | 106 | .panelset .panel { 107 | display: none; 108 | } 109 | 110 | .panelset .panel-active { 111 | display: block; 112 | } 113 | -------------------------------------------------------------------------------- /Bruno Tomio/libs/shareon/shareon.min.js: -------------------------------------------------------------------------------- 1 | /*! 2 | * shareon v1.4.1 by Nikita Karamov 3 | * https://shareon.js.org 4 | */ 5 | 6 | var shareon=function(){"use strict";var t={facebook:t=>"https://www.facebook.com/sharer/sharer.php?u="+t.url,linkedin:t=>`https://www.linkedin.com/shareArticle?mini=true&url=${t.url}&title=${t.title}`,messenger:t=>`https://www.facebook.com/dialog/send?app_id=3619024578167617&link=${t.url}&redirect_uri=${t.url}`,odnoklassniki:t=>`https://connect.ok.ru/offer?url=${t.url}&title=${t.title}${t.media?"&imageUrl="+t.media:""}`,pinterest:t=>`https://pinterest.com/pin/create/button/?url=${t.url}&description=${t.title}${t.media?"&media="+t.media:""}`,pocket:t=>"https://getpocket.com/edit.php?url="+t.url,reddit:t=>`https://www.reddit.com/submit?title=${t.title}&url=${t.url}`,telegram:t=>`https://telegram.me/share/url?url=${t.url}${t.text?"&text="+t.text:""}`,twitter:t=>`https://twitter.com/intent/tweet?url=${t.url}&text=${t.title}${t.via?"&via="+t.via:""}`,viber:t=>`viber://forward?text=${t.title}%0D%0A${t.url}${t.text?"%0D%0A%0D%0A"+t.text:""}`,vkontakte:t=>`https://vk.com/share.php?url=${t.url}&title=${t.title}${t.media?"&image="+t.media:""}`,whatsapp:t=>`whatsapp://send?text=${t.title}%0D%0A${t.url}${t.text?"%0D%0A%0D%0A"+t.text:""}`};const e=()=>{const e=document.getElementsByClassName("shareon");for(let r=0;r{window.open(o,"_blank","noopener,noreferrer").opener=null});break}}}}}};return window.onload=()=>{e()},e}(); 7 | -------------------------------------------------------------------------------- /Bruno Tomio/libs/xaringanExtra-clipboard/xaringanExtra-clipboard.css: -------------------------------------------------------------------------------- 1 | .xaringanextra-clipboard-button { 2 | position: absolute; 3 | top: 0; 4 | right: 0; 5 | font-size: 0.8em; 6 | padding: 0.5em; 7 | display: none; 8 | background-color: transparent; 9 | border: none; 10 | opacity: 0.5; 11 | border-radius: 0; 12 | } 13 | 14 | .xaringanextra-clipboard-button:hover { 15 | background-color: rgba(0, 0, 0, 0.1); 16 | border: none; 17 | opacity: 1; 18 | } 19 | 20 | :hover > .xaringanextra-clipboard-button { 21 | display: block; 22 | transform: translateY(0); 23 | } 24 | -------------------------------------------------------------------------------- /Bruno Tomio/libs/xaringanExtra-clipboard/xaringanExtra-clipboard.js: -------------------------------------------------------------------------------- 1 | /* global slideshow,window,document */ 2 | window.xaringanExtraClipboard = function (selector, text) { 3 | if (!window.ClipboardJS.isSupported()) return 4 | if (!window.xaringanExtraClipboards) window.xaringanExtraClipboards = {} 5 | 6 | const ready = function (fn) { 7 | /* MIT License Copyright (c) 2016 Nuclei */ 8 | /* https://github.com/nuclei/readyjs */ 9 | const completed = () => { 10 | document.removeEventListener('DOMContentLoaded', completed) 11 | window.removeEventListener('load', completed) 12 | fn() 13 | } 14 | if (document.readyState !== 'loading') { 15 | setTimeout(fn) 16 | } else { 17 | document.addEventListener('DOMContentLoaded', completed) 18 | window.addEventListener('load', completed) 19 | } 20 | } 21 | 22 | ready(function () { 23 | const { 24 | button: buttonText = 'Copy Code', 25 | success: successText = 'Copied!', 26 | error: errorText = 'Press Ctrl+C to Copy' 27 | } = text 28 | 29 | const template = '` 31 | 32 | const isRemarkSlideshow = typeof slideshow !== 'undefined' && 33 | Object.prototype.hasOwnProperty.call(slideshow, 'getSlides') 34 | 35 | let siblingSelector = selector || 'pre' 36 | if (!selector && isRemarkSlideshow) { 37 | siblingSelector = '.remark-slides-area ' + siblingSelector 38 | } 39 | 40 | // insert ` 31 | 32 | const isRemarkSlideshow = typeof slideshow !== 'undefined' && 33 | Object.prototype.hasOwnProperty.call(slideshow, 'getSlides') 34 | 35 | let siblingSelector = selector || 'pre' 36 | if (!selector && isRemarkSlideshow) { 37 | siblingSelector = '.remark-slides-area ' + siblingSelector 38 | } 39 | 40 | // insert