Visualization on rdata.lu Blog | Data science with R

Map unemployment using R with ggplot2

Wed, 03 Jan 2018 00:00:00 +0000

In this blog post, I show various ways to create maps using R. You’ll need to install a lot of packages and download two data sets; the unemployment rate in Luxembourg as well as a shapefile.

To get the unemployment rate in Luxembourg, you can take a look at our previous blog post or simply run the following lines:

library(rvest)
library(dplyr)
library(purrr)
library(janitor)
library(tidyr)

page_unemp = read_html("http://www.statistiques.public.lu/stat/TableViewer/tableViewHTML.aspx?ReportId=12950&IF_Language=eng&MainTheme=2&FldrName=3&RFPath=91")

data_raw = page_unemp %>%
  html_nodes(".b2020-datatable") %>% .[[1]] %>% html_table(fill = TRUE)

colnames(data_raw) = data_raw[1, ]

colnames(data_raw)[1:2] = c("division", "variable")

data_raw = data_raw[-c(1,2), ]

unemp_lux = data_raw %>%
  map_df(function(x)(gsub(",", ".", x = x))) %>%
  mutate_at(vars(matches("\\d{4}")), as.numeric) %>%
  gather(key=year, value, -division, -variable) %>%
  spread(variable, value) %>%
  clean_names()

These lines scrape the data off STATEC’s (the national institute of statistics) public tables and puts the raw data into a tidy data frame. Let’s take a look:

head(unemp_lux)

##   division year active_population of_which_non_wage_earners
## 1 Beaufort 2001               688                        85
## 2 Beaufort 2002               742                        85
## 3 Beaufort 2003               773                        85
## 4 Beaufort 2004               828                        80
## 5 Beaufort 2005               866                        96
## 6 Beaufort 2006               893                        87
##   of_which_wage_earners total_employed_population unemployed
## 1                   568                       653         35
## 2                   631                       716         26
## 3                   648                       733         40
## 4                   706                       786         42
## 5                   719                       815         51
## 6                   746                       833         60
##   unemployment_rate_in_percent
## 1                         5.09
## 2                         3.50
## 3                         5.17
## 4                         5.07
## 5                         5.89
## 6                         6.72

Once you have the unemployment data, install the next packages you’ll need to follow the rest of the post:

install.packages(
  c(
    "viridis",  # Optional, but better color scheme than the default
    "broom",    # For tidy()
    "ggplot2",  # To create a basic map
    "ggthemes" # To change the theme of the map
    )
  )

Then install two further packages:

install.packages('rgeos', type='source') # Dependency of rgdal
install.packages('rgdal', type='source') # To read in the shapefile

rgdal might be tricky to install on macOS and Linux. If you’re using Ubuntu, you have to install libgdal-dev, and on macOS you’ll need to install gdal using Homebrew.

There’s a final package to install, but you have to get it from Github (and thus need devtools):

devtools::install_github("dgrtwo/gganimate")

To draw a map, you will need a so-called shapefile. These files contain the geometry of the countries, regions, etc so that it is possible to plot them. The shapefile for Luxembourg can be obtained from Luxembourg’s Open data Portal.

Download the zip, and look for the file called LIMADM_COMMUNES.shp, which contains the geometry of the Luxembourgish communes. Leave it inside the folder Limadmin_SHP, as it contains other files needed by rgdal::readOGR() to read in the shapefile.

library(broom)
library(dplyr)
library(purrr)
library(ggplot2)
library(viridis)
library(rgdal)
library(ggthemes)
library(gganimate)

Now we can read the data, and do some basic cleaning. I comment every step, but run the code line by line to really understand what’s going on!

Read the shapefile:

communes = readOGR("Limadmin_SHP/LIMADM_COMMUNES.shp")

## OGR data source with driver: ESRI Shapefile
## Source: "Limadmin_SHP/LIMADM_COMMUNES.shp", layer: "LIMADM_COMMUNES"
## with 105 features
## It has 4 fields

## Warning in readOGR("Limadmin_SHP/LIMADM_COMMUNES.shp"): Z-dimension
## discarded

“Convert” it to a data frame using broom::tidy(). In the past, this was made with ggplot2::fortify():

communes_df = broom::tidy(communes, region = "COMMUNE")

Remove the cantons from the data, as well as the unemployment rate for the whole country. Then only select the relevant columns and rename them in one go:

unemp_lux = unemp_lux %>%
  filter(!grepl("Canton", division), division != "Grand Duchy of Luxembourg") %>%
  select(commune = division, year, unemp_rate = unemployment_rate_in_percent)

The name of two communes are written differently in the shapefile than in the data. We can change that using gsub(). Change “Haute-Sûre” to “Haute Sûre” in the unemployment data:

unemp_lux$commune = gsub("Haute-Sûre", "Haute Sûre", unemp_lux$commune)

Change “Redange” to “Redange-sur-Attert” in the data frame containing the geometry of the communes:

communes_df$id = gsub("Redange", "Redange-sur-Attert", communes_df$id)

Select relevant columns from the communes data frame, and rename them:

communes_df = communes_df %>%
    select(long, lat, commune = id)

Finally, join the communes data frame (containing the geometry) with the unemployment data, by communes:

final_data = left_join(communes_df, unemp_lux, by = "commune")

Let’s plot the unemployment rate for the latest available year:

final_data2016 = final_data %>%
  filter(year == 2016)

First, let’s plot a basic map using ggplot2. Even if you’re not familiar with ggplot2 the code below should be very straightforward:

ggplot_map = ggplot() +
  geom_polygon(data = final_data2016,
               aes(x = long, y = lat, group = commune, fill = unemp_rate)) +
    labs(title = "Unemployment rate in Luxembourg in 2016",
         y = "", x = "", fill = "Unemployment rate") +
    theme_tufte() +
    theme(axis.text.x = element_blank(),
          axis.ticks.x = element_blank(),
          axis.text.y = element_blank(),
          axis.ticks.y = element_blank()) +
    scale_fill_viridis()

Finally, print the map:

print(ggplot_map)

It is also possible to create a map per year using facet_wrap():

facet_map = ggplot() +
  geom_polygon(data = final_data,
               aes(x = long, y = lat,
                   group = commune, fill = unemp_rate)) +
    labs(title = "Unemployment rate in Luxembourg", y = "", x = "", fill = "Unemployment rate") +
    theme_tufte() +
    theme(axis.text.x = element_blank(),
          axis.ticks.x = element_blank(),
          axis.text.y = element_blank(),
          axis.ticks.y = element_blank()) +
    facet_wrap(~year) +
    scale_fill_viridis()

print(facet_map)

We clearly see that unemployment has risen in Luxembourg these past 15 years. This series of maps are great for printing, but since you’re reading this on a screen, why not try to animate these maps? This is possible with gganimate():

library(gganimate)

map_anim = ggplot() +
    geom_polygon(data = final_data,
                 aes(x = long, y = lat, group = group, fill = unemp_rate, frame = year)) +
    labs(title = "Unemployment rate in Luxembourg", y = "", x = "", fill = "Unemployment rate") +
    theme_tufte() +
    theme(axis.text.x = element_blank(),
          axis.ticks.x = element_blank(),
          axis.text.y = element_blank(),
          axis.ticks.y = element_blank()) +
    scale_fill_viridis()


gganimate(map_anim, "map_lux.mp4", interval = 2)

You can create an .mp4 video as well as a .gif. Just change the extension inside the gganimate() function.

That’s it for now. You can also check our interactive map of unemployment in our visualization.

Don't hesitate to follow us on twitter @rdata_lu and to subscribe to our youtube channel.
You can also contact us if you have any comments or suggestions. See you for the next post!

Visualizing box office revenue by genre

Mon, 04 Dec 2017 06:34:55 +0200

After having watched Justice League in cinema, I was impressed by all of the special effects and how good they were. I started wondering myself: How much does a movie like that cost? And most importantly, how big is the box-office revenue for this kind of blockbuster? I found an answer in The Numbers. I have then decided to make a database from the data available on this website. I have retrieved the 500th biggest movie budgets. Initially I just had a database with 5 variables on movies:
• the release date
• the name
• the production budget
• the dosmestic gross
• the worldwide gross
Thereafter, I crossed sources to get more variables. Data was scrapped on Wikipedia and IMDb. We finally get a dataset with 30 variables such as lists of actors, affiches url, distributions, rate and the number of raters from IMDb , etc…
You can find a complete description of the dataset on GitHub. All the data was scrapped via the package rvest.

In this post, I describe the different steps leading to the treemap:

STARTING POINT

First of all we read the data.

db = read.csv("https://cdn.rawgit.com/krosamont/Cinema/dd7eca65/moviedb500.csv",
              stringsAsFactors = FALSE)
#You can excecute the following line to have more information about the variable type.
#str(db)

Then we want to transform variables related to money in numeric variables and the movie realease dates in date variable using tidyverse.

library(tidyverse)

db = db %>%
        mutate( Release.Date = as.Date(Release.Date, "%m/%d/%Y"), 
                Running.time = as.numeric(stringr::str_sub(Running.time,1,3)),
                Rate = as.numeric(Rate),
                Raters = as.numeric(gsub(",", "", Raters)),
                Production.Budget = as.numeric(gsub("[,$]", "",
                                                 Production.Budget)),
                Domestic.Gross = as.numeric(gsub("[,$]", "",
                                                 Domestic.Gross)),
                Worldwide.Gross = as.numeric(gsub("[,$]", "",
                                                 Worldwide.Gross)) ) %>%
        arrange(desc(Worldwide.Gross))

The dataset looks better. As you have seen on top of this post. We want to design a treemap chart to visualize box-office revenue by genre. Let’s see how many movie genres are present in the data frame:

UniqueGenres = unique(db$Genres)
length(UniqueGenres)

## [1] 224

head(UniqueGenres, 5)

## [1] "Action Adventure Fantasy Sci-Fi"                  
## [2] "Action Adventure Sci-Fi"                          
## [3] "Action Crime Thriller"                            
## [4] "Adventure Drama Fantasy Mystery"                  
## [5] "Animation Adventure Comedy Family Fantasy Musical"

There are 224 combinations of genres, which is way too many combinations. We need to reduce them in a way that each movie has 2 genres at the most: A main genre and a subgenre.

MAIN GENRES

Let’s start with a simple barplot to visualize the most-represented genre from the 224 combinations.

library(ggthemes)

all_genres = separate_rows(db %>% 
                           group_by(Genres) %>% 
                           select(Genres) %>% 
                           filter(row_number() ==1),
                           Genres, sep="[[:space:]]")

name_order = names(sort(table(all_genres)))

ggplot(all_genres, aes(Genres)) +
                theme_minimal( ) + 
        geom_bar( stat = "count", fill="#007acc" ) +
        coord_flip() +
        scale_x_discrete(limits = name_order)

We see that Adventure and Action are the most important genres, followed by those between Comedy and Sci-fi. The genres that come after Sci-fi are present in less than 60 combinations of genres. Hence we will consider them as subgenres. We have 8 main genres:
• Adventure
• Action
• Comedy
• Drama
• Family
• ~~Fantasy~~
• Thriller
• ~~Sci-Fi~~
But we also know that Sci-Fi and Fantasy can be seen as subgenres from Adventure or Action. Therefore, we finally keep 6 genres.
We have to check that all movies can have a main genre from the 6 genres that we have choosen. For that, we simply check that each combination have at least one of the main genre :

mainGenres= paste(c("Adventure", "Action",  "Comedy", 
                    "Drama", "Family", "Thriller"),
                  collapse="|")

# grepl returns true for each genre combination if at least one of the main genre is present
length(grepl(mainGenres, db$Genres))/length(db$Genres)

## [1] 1

Apparently, this is the case :)

FIRST REDUCTION

We finally add a main genre to all movies.
Be careful, The main genre of each movie will depend on the order in which you attribute the main genre. So the final shape of the output will depend on this step.

#1
db$Genresl1=ifelse(grepl("Family",db$Genres),
                   "Family", db$Genres)

#2
db$Genresl1=ifelse(grepl("Drama", db$Genresl1),
                   "Drama", db$Genresl1)

#3
db$Genresl1=ifelse( grepl("Thriller", db$Genresl1),
                    "Thriller", db$Genresl1)

#4
db$Genresl1=ifelse(grepl("Action", db$Genresl1),
                   "Action", db$Genresl1)

#5
db$Genresl1 =ifelse(grepl("Adventure", db$Genresl1),
                    "Adventure", db$Genresl1)

#6
db$Genresl1=ifelse(grepl("Comedy", db$Genresl1),
                   "Comedy", db$Genresl1)

Now that the main genre were attributed, let’s focus on the subgenre.

SUBGENRES

We have seen that only 6 genres could be considered as main genres. However, in this part we will consider that all genres can be considered as subgenres. Now one of the difficulties is to decide which subgenre to select when there is more than one option. Association rules can help us in this task. We can see which subgenres are the most present for each genre and their level of dependency.

ASSOCIATION RULES

Let’s analyze the different genre combinations through an association rule analysis. We need first to read data as transaction. For that we use the package arules.

library(arules)
#no duplicate combinations!
item_genres = read.transactions("https://cdn.rawgit.com/krosamont/Cinema/dd7eca65/itemGenres.csv",
                                format = "basket", sep=":")

In this post, we will focus ourselves on 2 association rule indicators: the support and the confidence.
Support and confidence are displayed like the result bellow when the function arules::rules is used.

##     lhs              rhs      support     confidence lift     count
## [1] {Documentary} => {Drama}  0.004444444 1.0000000  2.777778  1   
## [2] {War}         => {Drama}  0.057777778 0.9285714  2.579365 13   
## [3] {History}     => {Drama}  0.080000000 0.9473684  2.631579 18   
## [4] {Animation}   => {Family} 0.208888889 0.9591837  2.731852 47

• Support indicates how frequently genres in columns lhs and rhs appear together in the 224 combinations. The first row of the result above means that War and Drama appear together in 5,78% of combinations.

• Confidence is an indication of how often the rule has been found to be true. It can also be seen as a conditional probability. { X => Y } means P(Y | X). This is the probability that the genre Y is also present when we already know that genre X is present. { War => Drama } = 0.929 from the second line of the result above means that Drama will be present in 92,9% of combination where War is present.
But be carefull, this relation is not neccesarly true in the opposite direction!

To see all association rules starting from a confidence level of 30% between 2 genres we write:

rules = apriori(item_genres, 
                parameter=list(support=(1/nrow(item_genres)), 
                confidence=0.3, minlen=2, maxlen=2)  )
ins_rules = inspect(rules) 

ins_rules

If we want to focus on the relationship between subgenres and main genres, we can filter the rhs columns.

mainGenres = unlist(strsplit(mainGenres, "|", fixed = TRUE))
ins_rules = ins_rules %>% 
        #removing the arrow =>
        .[,-2] %>%
        #removing the brackets for both columns, lhs and rhs
        mutate(lhs = trimws(gsub("\\{|\\}","",lhs)),
               rhs = trimws(gsub("\\{|\\}","",rhs))) %>%
        filter(rhs %in% mainGenres) %>%
        group_by(lhs) %>%
        filter(row_number() == 3) %>%
        arrange(lhs, desc(confidence))

ins_rules

## # A tibble: 17 x 6
## # Groups:   lhs [17]
##    lhs       rhs       support confidence  lift count
##    <chr>     <chr>       <dbl>      <dbl> <dbl> <dbl>
##  1 Adventure Action     0.293       0.574 1.17  66.0 
##  2 Animation Adventure  0.169       0.776 1.52  38.0 
##  3 Biography Adventure  0.0133      0.333 0.652  3.00
##  4 Comedy    Adventure  0.187       0.512 1.00  42.0 
##  5 Crime     Comedy     0.0489      0.355 0.974 11.0 
##  6 Drama     Adventure  0.133       0.370 0.725 30.0 
##  7 Family    Adventure  0.249       0.709 1.39  56.0 
##  8 Fantasy   Action     0.129       0.387 0.791 29.0 
##  9 History   Adventure  0.0356      0.421 0.824  8.00
## 10 Musical   Family     0.0622      0.875 2.49  14.0 
## 11 Mystery   Adventure  0.0667      0.500 0.978 15.0 
## 12 Romance   Family     0.0533      0.300 0.854 12.0 
## 13 Sci-Fi    Family     0.0889      0.312 0.890 20.0 
## 14 Sport     Family     0.0222      0.500 1.42   5.00
## 15 Thriller  Adventure  0.138       0.431 0.842 31.0 
## 16 War       Adventure  0.0222      0.357 0.699  5.00
## 17 Western   Adventure  0.0222      0.625 1.22   5.00

BARPLOT

We create a new variable that we named: withoutMainGenres. This variable is the combination of genres without the main genre. If a movie has the combination: “Drama War Action Biography” and his main genre is “Drama”, then value of withoutMainGenres will be “War Action Biography”. If it’s not clear enough, I suggest that you run the code and to compare the variables withoutMainGenres and Genres. Once this new variable is made, we draw again a barplot to see the ditribution of genres.

db$withoutMainGenres = trimws(mapply(gsub, db$Genresl1, "", db$Genres))

all_genres = separate_rows(db %>% 
                           group_by(withoutMainGenres) %>% 
                           select(withoutMainGenres) %>% 
                           filter(row_number() ==1),
                           withoutMainGenres, 
                           sep="[[:space:]]") %>% 
             rename( Genres=withoutMainGenres) %>%
             filter(nchar(Genres)>0)

name_order = names(sort(table(all_genres)))

ggplot(all_genres, aes(Genres)) +
                theme_minimal( ) + 
        geom_bar( stat = "count", fill="#007acc" ) +
        coord_flip() +
        scale_x_discrete(limits = name_order)

We see that there are still a lot of adventure movies. We use the result seen in the association rules and the barplot to make the subgenres.
We begin with the genre Animation because we want to regroup all of these movies in the same category. Then we add subgenres in an ascending order, from the less important to the most one.
However, movies from musical, music and horror genres are added at the end of the script because the attribution of these genres for the movie in our dataset is questionable.

db$Genresl2=ifelse(grepl("Animation",db$withoutMainGenres), 
                   "Animation", db$withoutMainGenres)
db$Genresl2=ifelse(grepl("Documentary",db$Genresl2),
                   "Documentary", db$Genresl2)
db$Genresl2=ifelse(grepl("Biography", db$Genresl2), 
                   "Biography", db$Genresl2)
db$Genresl2=ifelse(grepl("Western",db$Genresl2), 
                   "Western", db$Genresl2)
db$Genresl2=ifelse(grepl("Sport",db$Genresl2), 
                   "Sport", db$Genresl2)
db$Genresl2=ifelse(grepl("War",db$Genresl2), 
                   "War", db$Genresl2)
db$Genresl2=ifelse(grepl("Mystery",db$Genresl2), 
                   "Mystery", db$Genresl2)
db$Genresl2=ifelse(grepl("Romance",db$Genresl2), 
                   "Romance", db$Genresl2)
db$Genresl2=ifelse(grepl("Crime",db$Genresl2), 
                   "Crime", db$Genresl2)
db$Genresl2=ifelse(grepl("Drama",db$Genresl2), 
                   "Drama", db$Genresl2)
db$Genresl2=ifelse(grepl("Fantasy",db$Genresl2), 
                   "Fantasy", db$Genresl2)
db$Genresl2=ifelse(grepl("Sci-Fi",db$Genresl2), 
                   "Sci-Fi", db$Genresl2)
db$Genresl2=ifelse(grepl("Comedy",db$Genresl2), 
                   "Comedy", db$Genresl2)
db$Genresl2=ifelse(grepl("Thriller",db$Genresl2), 
                   "Thriller", db$Genresl2)
db$Genresl2=ifelse(grepl("Adventure",db$Genresl2), 
                   "Adventure", db$Genresl2)
db$Genresl2=ifelse(grepl("Musical",db$Genresl2), 
                   "Musical", db$Genresl2)
db$Genresl2=ifelse(grepl("Music",db$Genresl2), 
                   "Music", db$Genresl2)
db$Genresl2=ifelse(grepl("Horror",db$Genresl2), 
                   "Horror", db$Genresl2)
db$Genresl2=ifelse(db$Genresl2=="",
                   db$Genresl1, db$Genresl2)

Now that we have our 2 levels of genres. We can build our treemap!

TREEMAP WITH TREEMAPIFY

To design the treemap, we need to regroup movies by main genres and subgenres, then we sum their Worlwide Gross revenue.

summary.Genre = db %>%
        group_by(Genresl1, Genresl2) %>%
        summarise(Sum_Gross = sum(Worldwide.Gross))

Finally we design the treemap using ggplot2 and treemapify:

library(treemapify)

ggplot(summary.Genre, aes(area = Sum_Gross ,
                          fill = Genresl1, label = Genresl2,
                          subgroup =Genresl1)) +
        geom_treemap() +
        geom_treemap_subgroup_border() +
        geom_treemap_subgroup_text(place = "centre", 
                                   grow = T, 
                                   alpha = 0.5, 
                                   colour = "black", 
                                   fontface = "italic", 
                                   min.size = 0) +
        geom_treemap_text(colour = "white", 
                          place = "topleft", 
                          reflow = T)

Here we have a first result but we can do better by adding some interactivity.

TREEMAP WITH HIGHCHARTER

Let’s add some interactivity using the package highcharter. We use the github version (there are more functions).

devtools::install_github("jbkunst/highcharter")

library(highcharter)
hctreemap2(data = db,
           group_vars = c("Genresl1", "Genresl2"),
           size_var = "Worlwide.Gross",
           color_var = "Genresl2",
           layoutAlgorithm = "squarified",
           levelIsConstant = FALSE,
           levels = list(
                   list(level = 1, 
                        dataLabels = list(enabled = TRUE)),
                   list(level = 2, 
                        dataLabels = list(enabled = FALSE))
           )) %>% 
        hc_tooltip(pointFormat = "<b>{point.name}</b>:<br>
                   Worlwide Gross: $ {point.value:,.0f}")

The following error message appears:
Error in hctreemap2(data = db, group_vars = c(“Genresl1”, “Genresl2”) :
Treemap data uses same label at multiple levels.

We can’t design a 2 levels treemap with highcharter because main genres and subgenres share some genres. Hence, R is a great tool for data manipulation but javascript is a better tool for visualization.

We can easily design a 2 levels responsive treemap with the library highchart in javascript.

Don’t hesitate to follow us on twitter @rdata_lu and to subscribe to our youtube channel.
You can also contact us if you have any comments or suggestions. See you for the next post!

Easy peasy STATA-like marginal effects with R

Thu, 26 Oct 2017 06:45:48 +0200

Model interpretation is essential in the social sciences. If one wants to know the effect of variable x on the dependent variable y, marginal effects are an easy way to get the answer. STATA includes a margins command that has been ported to R by Thomas J. Leeper of the London School of Economics and Political Science. You can find the source code of the package on github. In this short blog post, I demo some of the functionality of margins.

First, let’s load some packages:

library(ggplot2)
library(tibble)
library(broom)
library(margins)
library(Ecdat)

As an example, we are going to use the Participation data from the Ecdat package:

data(Participation)

?Participation

Labor Force Participation

Description

a cross-section

number of observations : 872

observation : individuals

country : Switzerland

Usage

data(Participation)
Format

A dataframe containing :

lfp
labour force participation ?

lnnlinc
the log of nonlabour income

age
age in years divided by 10

educ
years of formal education

nyc
the number of young children (younger than 7)

noc
number of older children

foreign
foreigner ?

Source

Gerfin, Michael (1996) “Parametric and semiparametric estimation of the binary response”, Journal of Applied Econometrics, 11(3), 321-340.

References

Davidson, R. and James G. MacKinnon (2004) Econometric Theory and Methods, New York, Oxford University Press, http://www.econ.queensu.ca/ETM/, chapter 11.

Journal of Applied Econometrics data archive : http://qed.econ.queensu.ca/jae/.

The variable of interest is lfp: whether the individual participates in the labour force or not. To know which variables are relevant in the decision to participate in the labour force, one could estimate a logit model, using glm().

logit_participation = glm(lfp ~ ., data = Participation, family = "binomial")

Now that we ran the regression, we can take a look at the results. I like to use broom::tidy() to look at the results of regressions, as tidy() returns a nice data.frame, but you could use summary() if you’re only interested in reading the output:

tidy(logit_participation)

##          term    estimate  std.error  statistic      p.value
## 1 (Intercept) 10.37434616 2.16685216  4.7877499 1.686617e-06
## 2     lnnlinc -0.81504064 0.20550116 -3.9661122 7.305449e-05
## 3         age -0.51032975 0.09051783 -5.6378920 1.721444e-08
## 4        educ  0.03172803 0.02903580  1.0927211 2.745163e-01
## 5         nyc -1.33072362 0.18017027 -7.3859224 1.514000e-13
## 6         noc -0.02198573 0.07376636 -0.2980454 7.656685e-01
## 7  foreignyes  1.31040497 0.19975784  6.5599678 5.381941e-11

From the results above, one can only interpret the sign of the coefficients. To know how much a variable influences the labour force participation, one has to use margins():

effects_logit_participation = margins(logit_participation)

## Warning in warn_for_weights(model): 'weights' used in model estimation are
## currently ignored!

print(effects_logit_participation)

## Average marginal effects

## glm(formula = lfp ~ ., family = "binomial", data = Participation)

##  lnnlinc     age     educ     nyc       noc foreignyes
##  -0.1699 -0.1064 0.006616 -0.2775 -0.004584     0.2834

Using summary() on the object returned by margins() provides more details:

summary(effects_logit_participation)

##      factor     AME     SE       z      p   lower   upper
##         age -0.1064 0.0176 -6.0494 0.0000 -0.1409 -0.0719
##        educ  0.0066 0.0060  1.0955 0.2733 -0.0052  0.0185
##  foreignyes  0.2834 0.0399  7.1102 0.0000  0.2053  0.3615
##     lnnlinc -0.1699 0.0415 -4.0994 0.0000 -0.2512 -0.0887
##         noc -0.0046 0.0154 -0.2981 0.7656 -0.0347  0.0256
##         nyc -0.2775 0.0333 -8.3433 0.0000 -0.3426 -0.2123

And it is also possible to plot the effects with base graphics:

plot(effects_logit_participation)

This uses the basic R plotting capabilities, which is useful because it is a simple call to the function plot() but if you’ve been using ggplot2 and want this graph to have the same look as the others made with ggplot2 you first need to save the summary in a variable. Let’s overwrite this effects_logit_participation variable with its summary:

effects_logit_participation = summary(effects_logit_participation)

And now it is possible to use ggplot2 to create the same plot:

ggplot(data = effects_logit_participation) +
  geom_point(aes(factor, AME)) +
  geom_errorbar(aes(x = factor, ymin = lower, ymax = upper)) +
  geom_hline(yintercept = 0) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45))

So an infinitesimal increase, in say, non-labour income (lnnlinc) of 0.001 is associated with a decrease of the probability of labour force participation by 0.001*17 percentage points.

You can also extract the marginal effects of a single variable, with dydx():

head(dydx(Participation, logit_participation, "lnnlinc"))

##   dydx_lnnlinc
## 1  -0.15667764
## 2  -0.20014487
## 3  -0.18495109
## 4  -0.05377262
## 5  -0.18710476
## 6  -0.19586986

Which makes it possible to extract the effects for a list of individuals that you can create yourself:

my_subjects = tribble(
    ~lfp,  ~lnnlinc, ~age, ~educ, ~nyc, ~noc, ~foreign,
    "yes",   10.780,  7.0,     4,    1,    1,    "yes",
     "no",     1.30,  9.0,     1,    4,    1,    "yes"
)

dydx(my_subjects, logit_participation, "lnnlinc")

##   dydx_lnnlinc
## 1  -0.09228119
## 2  -0.17953451

I used the tribble() function from the tibble package to create this test data set, row by row. Then, using dydx(), I get the marginal effect of variable lnnlinc for these two individuals. No doubt that this package will be a huge help convincing more social scientists to try out R and make a potential transition from STATA easier.

Don’t hesitate to follow us on twitter @rdata_lu and to subscribe to our youtube channel.
You can also contact us if you have any comments or suggestions. See you for the next post!

Barplot with ggplot2/plotly

Mon, 16 Oct 2017 00:00:00 +0000

Hello everyones,

I just finished my MOOC on Foundations of strategic business analitycs. It was interresting and at the end of this course, I had to present a graph that was suppose to be relevent for a business organization. Different datasets were availables: speed dating, Co2 emissons, bike sharing, loans, telecom churn, fuel prices, medical expense refunds and more. I have chosen to work on the medical expense refunds. This dataset gives amount of refunded drugs, number of refunded drugs, drugs name and drugs category for each month from july to december 2016. There are 84 categories of drugs.

As the french health insurance is a public institution, it may be more interesting to find a way to monitore data than finding a way to refund less drugs… Hence, it may not be readable to show the 84 categories, so I have decided to select just some of them.

First of all, I wanted to make an analysis about the five drugs categories the most refunded per month. But quickly, I realized that I had to use a line chart instead of the barplot because the chart was not really explicit (see below).

I was not happy with my first result, so I have decided to make a new graph about the fifteen drugs categories the most refunded in the whole 2nd semester of 2016.

#We need to modify some of our previous table because we select 15 categories.
res_all2 = tous_presc %>%
        group_by(label) %>%
        summarise_each(funs(sum)) %>%
        filter(!is.na(label)) %>%
        arrange(desc(`Montant remboursé \n2016-07`)) %>%
        filter( row_number() %in% c(1:15) ) %>%
        as.data.frame()

top_med = res_all2$label

res_city2 = city_presc %>%
        group_by(label) %>%
        summarise_each(funs(sum)) %>%
        filter(!is.na(label) & label %in% top_med) %>%
        arrange(desc(`Montant remboursé \n2016-07`)) %>%
        as.data.frame() 
res_city2$`type of prescriber` = "private practitioner"

res_hop2 = hop_presc %>%
        group_by(label) %>%
        summarise_each(funs(sum)) %>%
        filter(!is.na(label) & label %in% top_med) %>%
        arrange(desc(`Montant remboursé \n2016-07`))  %>%
        as.data.frame() 
res_hop2$`type of prescriber` = "salaried practitioner"

df2 = rbind(res_city2, res_hop2)
df2$`type of prescriber` = toupper(df2$`type of prescriber`)
df2$`type of drugs` = df2$label
#translate in english
df2$`type of drugs` = gsub("IMMUNOSUPPRESSEURS","IMMUNOSUPPRESSIVES", df2$`type of drugs`)
df2$`type of drugs` = gsub("MEDICAMENTS DU DIABETE","DIABETES MEDICINES", df2$`type of drugs`)
df2$`type of drugs` = gsub("ANTITHROMBOTIQUES","ANTITHROMBOTICS", df2$`type of drugs`)
df2$`type of drugs` = gsub("ANTIVIRAUX A USAGE SYSTEMIQUE","ANTIVIRALS FOR SYSTEMIC USE", df2$`type of drugs`)
df2$`type of drugs` = gsub("ANTINEOPLASIQUES","ANTINEOPLASTICS", df2$`type of drugs`)
df2$`type of drugs` = gsub("AGENTS MODIFIANT LES LIPIDES","LIPID MODIFYING AGENT", df2$`type of drugs`)
df2$`type of drugs` = gsub("ANTIBACTERIENS A USAGE SYSTEMIQUE","SYSTEMIC ANTIBACTERIAL", df2$`type of drugs`)
df2$`type of drugs` = gsub("IMMUNOSTIMULANTS","IMMUNOSTIMULANTS", df2$`type of drugs`)
df2$`type of drugs` = gsub("MEDICAMENTS AGISSANT SUR LE SYSTEME RENINE-ANGIOTENSINE","DRUGS AFFECT THE RENIN-ANGIOTENSIN SYSTEM", df2$`type of drugs`)
df2$`type of drugs` = gsub("MEDICAMENTS OPHTALMOLOGIQUES","OPHTHALMIC DRUGS", df2$`type of drugs`)
df2$`type of drugs` = gsub("MEDICAMENTS POUR LES SYNDROMES OBSTRUCTIFS DES VOIES AERIENNES","DRUGS AGAINST OBSTRUCTIVE PULMONARY DISEASE", df2$`type of drugs`)
df2$`type of drugs` = gsub("MEDICAMENTS POUR LES TROUBLES DE L'ACIDITE","DRUGS AGAINST ACIDITY TROUBLE", df2$`type of drugs`)
df2$`type of drugs` = gsub("PSYCHOLEPTIQUES","PSYCHOLEPTICS", df2$`type of drugs`)
df2$`type of drugs` = gsub("THERAPEUTIQUE ENDOCRINE","ENDOCRINE THERAPY", df2$`type of drugs`)

colnames(df2) = c("label", "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER", "PRESCRIBERS", "DRUGS" )
dfdata2 = melt( df2[,-1], id.vars=c("DRUGS", "PRESCRIBERS")) %>%
        rename(montant=value, date=variable) %>%
        arrange(date, DRUGS, PRESCRIBERS) %>% 
        group_by(DRUGS, PRESCRIBERS) %>%
        summarise(refund=sum(montant)) %>%
        as.data.frame() 

dfdata2$DRUGS = reorder(dfdata2$DRUGS, desc(dfdata2$refund))
#t=The total amount of refunded drugs
global_amout = sum(t(
        tous_presc %>%
                group_by(label) %>%
                filter(is.na(label)) %>%
                .[13,-7]))

#the percentage of the total refunded drugs that represents each category
dfdata2 = dfdata2 %>%
        group_by(DRUGS) %>%
        mutate( total = sum(refund),
                perct = paste(round(100*sum(refund)/global_amout,2),"%", sep=""),
                perct = ifelse(PRESCRIBERS=="SALARIED PRACTITIONER", " ", perct )) %>%
        as.data.frame()



q = ggplot(dfdata2, aes(x=DRUGS, y=refund, group=PRESCRIBERS, fill=DRUGS, alpha=PRESCRIBERS))+
        geom_bar(stat="identity",position="stack",color="black")+ 
        ggtitle("Top 15 of refunded drugs categories for the 2nd semester of 2016")+
        scale_alpha_manual(values=c(0.2,0.75))+
        geom_text(aes(label=perct, y=total+2),alpha=1, color="black", position=position_dodge(width=0.2), vjust=-0.6, size=4) + 
        scale_y_continuous(labels = function(x) paste0(formatC(x/1000000, format="d", digits=0, big.mark = ","), " €"))+
        labs(x=" ", y="refunded amount (in million €)") + 
        annotate("text", x=4.25, y=821000000, label= "(Percentage of total refunded amount)", size=4.5) +
        annotate("text", x=11.3, y=890000000, label= "Total Amount of refunded drugs: 9,384,395,518 €", size=6) + 
        theme_minimal(base_size = 15)+
        theme(  
                panel.grid.major.x = element_blank(),
                panel.grid.minor.x = element_blank(),
                legend.text = element_text(size = 10),
                plot.title = element_text(size=23,face="bold", hjust=0.5),
                axis.text.x = element_blank(),
                axis.ticks.x = element_blank(),
                axis.title.x = element_text(size=12, face="bold"),
                axis.title.y = element_text(size=14,face="bold"),
                strip.text.x = element_text(face="italic", size=11))


print(q)

Great, now we can add an interactive touch with the library(plotly).

#We apply this library to add some interactivity in the previous graph
library(plotly)

#We add some new variables to add to the tooltip
dfdata2 = dfdata2 %>%
        group_by(DRUGS) %>%
        mutate( total = sum(refund),
                perct = paste(round(100*refund/global_amout,2),"%", sep=""),
                perct_in_cat = paste(round(100*refund/sum(refund),2),"%", sep=""),
                perct_total_cat =  paste(round(100*sum(refund)/global_amout,2),"%", sep="") ) %>%
        as.data.frame()

q = ggplot(dfdata2, aes(x=DRUGS, y=refund, group=PRESCRIBERS, fill=DRUGS,
                         alpha=PRESCRIBERS,
                         #here we custom the tooltip
                         text = paste("<b>type of drugs:</b> ", tolower(DRUGS),"</br>",

                                                                                                     "</br><b>type of prescribers:</b> ", tolower(PRESCRIBERS),
                                                                                                           "</br><b>refunded amount:</b> ", paste0(formatC(refund, format="d", digits=0, big.mark = ","), " €"),
                                                                                                           "</br><b>total refunded amount:</b> ", paste0(formatC(total, format="d", digits=0, big.mark = ","), " €"),
                                                                                                           "</br><b>percentage of total refunded amount for the prescriber:</b> ", perct,
                                                                                                           "</br><b>percentage of total refunded amount for the category:</b> ", perct_total_cat, 
                                                                                                           "</br><b>percentage of refunded amount in this category:</b> ", perct_in_cat )
                         
))+
        geom_bar(stat="identity",position="stack", colour="black", size=0.2)+ 
        scale_alpha_manual(values=c(0.2,0.75))+
        scale_y_continuous(labels = function(x) paste0(formatC(x/1000000, format="d", digits=0, big.mark = ","), " €"))+
        labs(x=" ", y="refunded amount (in million €)") + 
        annotate("text", x= 8, y=930000000, label= "Top 15 of refunded drugs categories for the 2nd semester of 2016", size=5, face="bold") + 
        annotate("text", x=8, y=890000000, label= "Total Amount of refunded drugs: 9,384,395,518 €", size=4) + 
        theme_minimal(base_size = 15)+
        theme(  
                panel.grid.major.x = element_blank(),
                panel.grid.minor.x = element_blank(),
                legend.text = element_text(size = 10),
                #we remove the legend.
                legend.position = "none",
                plot.title = element_text(size=12,face="bold", hjust=0.1),
                axis.text.x = element_blank(),
                axis.ticks.x = element_blank(),
                axis.title.x = element_text(size=12),
                axis.title.y = element_text(size=14),
                strip.text.x = element_text(face="italic", size=11))


ggplotly(q, tooltip = c("text"))

And now it’s done! I hope you enjoy this post.

Don’t hesitate to follow us on twitter @rdata_lu and to subscribe to our youtube channel.
You can also contact us if you have any comments or suggestions. See you for the next post!

Let's make ggplot2 purrr again

Mon, 09 Oct 2017 06:45:48 +0200

Update: I’ve included another way of saving a separate plot by group in this article, as pointed out by @monitus. Actually, this is the preferred solution; using dplyr::do() is deprecated, according to Hadley Wickham himself.

I’ll be honest: the title is a bit misleading. I will not use purrr that much in this blog post. Actually, I will use one single purrr function, at the very end. I use dplyr much more. However Make ggplot2 purrr sounds better than Make ggplot dplyr or whatever the verb for dplyr would be.

Also, this blog post was inspired by a stackoverflow question and in particular one of the answers. So I don’t bring anything new to the table, but I found this stackoverflow answer so useful and so underrated (only 16 upvotes as I’m writing this!) that I wanted to write something about it.

Basically the idea of this blog post is to show how to create graphs using ggplot2, but by grouping by a factor variable beforehand. To illustrate this idea, let’s use the data from the Penn World Tables 9.0. The easiest way to get this data is to install the package called pwt9 with:

install.packages("pwt9")

and then load the data with:

data("pwt9.0")

Now, let’s load the needed packages. I am also using ggthemes which makes themeing your ggplots very easy. I’ll be making Tufte-style plots.

library(ggplot2)
library(ggthemes)
library(dplyr)
library(tidyr)
library(purrr)
library(pwt9)

First let’s select a list of countries:

country_list <- c("France", "Germany", "United States of America", "Luxembourg", "Switzerland", "Greece")

small_pwt <- pwt9.0 %>%
  filter(country %in% country_list)

Let’s us also order the countries in the data frame as I have written them in country_list:

small_pwt <- small_pwt %>%
  mutate(country = factor(country, levels = country_list, ordered = TRUE))

You might be wondering why this is important. At the end of the article, we are going to save the plots to disk. If we do not re-order the countries inside the data frame as in country_list, the name of the files will not correspond to the correct plots!

Update: While this can still be interesting to know, especially if you want to order the bars of a barplot made with ggplot2, I included a suggestion by @expersso that does not require your data to be ordered!

Now when you want to plot the same variable by countries, say avh (Average annual hours worked by persons engaged), the usual way to do this is with one of facet_wrap() or facet_grid():

ggplot(data = small_pwt) + theme_tufte() +
  geom_line(aes(y = avh, x = year)) +
  facet_wrap(~country)

ggplot(data = small_pwt) + theme_tufte() +
  geom_line(aes(y = avh, x = year)) +
  facet_grid(country~.)

As you can see, for this particular example, facet_grid() is not very useful, but do notice its argument, country~., which is different from facet_wrap()’s argument. This way, I get the graphs stacked horizontally. If I had used facet_grid(~country) the graphs would be side by side and completely unreadable.

Now, let’s go to the meat of this post: what if you would like to have one single graph for each country? You’d probably think of using dplyr::group_by() to form the groups and then the graphs. This is the way to go, but you also have to use dplyr::do(). This is because as far as I understand, ggplot2 is not dplyr-aware, and using an arbitrary function with groups is only possible with dplyr::do().

Update: As explained in the intro above, I also added the solution that uses tidyr::nest():

# Ancient, deprecated way of doing this
plots <- small_pwt %>%
  group_by(country) %>%
  do(plot = ggplot(data = .) + theme_tufte() +
       geom_line(aes(y = avh, x = year)) +
       ggtitle(unique(.$country)) +
       ylab("Year") +
       xlab("Average annual hours worked by persons engaged"))

And this is the approach that uses tidyr::nest():

# Preferred approach
plots <- small_pwt %>%
  group_by(country) %>%
  nest() %>%
  mutate(plot = map2(data, country, ~ggplot(data = .x) + theme_tufte() +
       geom_line(aes(y = avh, x = year)) +
       ggtitle(.y) +
       ylab("Year") +
       xlab("Average annual hours worked by persons engaged")))

If you know dplyr at least a little bit, the above lines should be easy for you to understand. But notice how we get the title of the graphs, with ggtitle(unique(.$country)), which was actually the point of the stackoverflow question.

Update: The modern version uses tidyr::nest(). Its documentation tells us:

There are many possible ways one could choose to nest columns inside a data frame. nest() creates a list of data frames containing all the nested variables: this seems to be the most useful form in practice. Let’s take a closer look at what it does exactly:

small_pwt %>%
  group_by(country) %>%
  nest() %>%
  head()

## # A tibble: 6 x 2
##   country                  data              
##   <ord>                    <list>            
## 1 Switzerland              <tibble [65 × 46]>
## 2 Germany                  <tibble [65 × 46]>
## 3 France                   <tibble [65 × 46]>
## 4 Greece                   <tibble [65 × 46]>
## 5 Luxembourg               <tibble [65 × 46]>
## 6 United States of America <tibble [65 × 46]>

This is why I love lists in R; we get a tibble where each element of the column data is itself a tibble. We can now apply any function that we know works on lists.

What might be surprising though, is the object that is created by this code. Let’s take a look at plots:

print(plots)

## # A tibble: 6 x 3
##   country                  data               plot    
##   <ord>                    <list>             <list>  
## 1 Switzerland              <tibble [65 × 46]> <S3: gg>
## 2 Germany                  <tibble [65 × 46]> <S3: gg>
## 3 France                   <tibble [65 × 46]> <S3: gg>
## 4 Greece                   <tibble [65 × 46]> <S3: gg>
## 5 Luxembourg               <tibble [65 × 46]> <S3: gg>
## 6 United States of America <tibble [65 × 46]> <S3: gg>

As dplyr::do()’s documentation tells us, the return values get stored inside a list. And this is exactly what we get back; a list of plots! Lists are a very flexible and useful class, and you cannot spell list without purrr (at least not when you’re a neRd).

Here are the final lines that use purrr::map2() to save all these plots at once inside your working directory:

Update: I have changed the code below which does not require your data frame to be ordered according to the variable country_list.

# file_names <- paste0(country_list, ".pdf")

map2(paste0(plots$country, ".pdf"), plots$plot, ggsave)

As I said before, if you do not re-order the countries inside the data frame, the names of the files and the plots will not match. Try running all the code without re-ordering, you’ll see!

Don’t hesitate to follow us on twitter @rdata_lu and to subscribe to our youtube channel.
You can also contact us if you have any comments or suggestions. See you for the next post!