Web Data on rdata.lu Blog | Data science with R

BIKE SERVICES API + SHINY = NICE APP

Tue, 20 Feb 2018 00:00:00 +0000

Hi everyone,

In this blog post, I will be short and I will introduce our shiny application on bike self-service stations.

Your browser does not support the video tag.

The code is in 2 parts, the ui.R file for the interface and the server.R file for the backend. You can check the code on GitHub if you want to download the code and run it on your computer.

JCDecaux provides an API that gives us real time information on each bike self-service station. This infomation is:
•Station id
•Station name
•Address
•Position latitude/longitude
•Presence of a payment terminal
•Presence of a bonus station
•If the station is open
•How many bike stands are in the station
•how many bike stands are available in the station (no bikes on the stand)
•How many bikes are available
•Time of the last api update

The JCDecaux API gives the data under the following format:

{
  "number": 123,
  "contract_name" : "Paris",
  "name": "stations name",
  "address": "address of the station",
  "position": {
    "lat": 48.862993,
    "lng": 2.344294
  },
  "banking": true,
  "bonus": false,
  "status": "OPEN",
  "bike_stands": 20,
  "available_bike_stands": 15,
  "available_bikes": 5,
  "last_update": <timestamp>
}

Hence, our shiny application gets real time information on bike stations in 27 cities.

We also used the modern open-source library leaflet to display city map (open street map).

This application works better on computer than on smartphone because shiny is not fully smartphone friendly. However, Shiny has a user-friendly interface.

If you want to try your own Shiny app, I advice you to check this gallery. It contains a lot of examples that will serve as a good introduction.

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!

Analysis of the Renert - Part 3: Visualizations

Fri, 26 Jan 2018 00:00:00 +0000

This is part 3 of a 3 part blog post. This post uses the data that was scraped in part 1 and prepared in part 2.

Now that we have the data in a nice format, let’s make a frequency plot! First let’s load the data and the packages:

library("tidyverse")
library("ggthemes") # To use different themes and colors
renert_tokenized = readRDS("renert_tokenized.rds")

Using the ggplot2 package, I can produce a plot of the most frequent words.

renert_tokenized %>%
  count(word, sort = TRUE) %>%
  filter(n > 50) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  theme_minimal()

So, the most frequent word is kinnek, meaning King! kinnek is mentioned more times than renert, the name of the hero. Next are här and wollef meaning mister and wolf. In fifth position we have fuuss, for fox. I’ll let you use Google Translate for the other words 😄.

Now, I’m also doing sentiment analysis by using the AFINN list of words. This list of words have a score that gives its sentiment. You can download the original list from here.

Because such a list is not available in Luxembourguish, I have translated it using Google’s translate api. Here is the code to do that:

library("tidyverse")
library("translate") # google translate api
library("tidytext") # to load the AFINN dictionary

api_key = "api_key_goes_here"

set.key(api_key)

afinn = get_sentiments("afinn")

# I wrap the `translate()` function around `purrr::possibly()` so that in case of an
# error, I get the translations that worked back.

possibly_translate = purrr::possibly(translate::translate, otherwise = "error")

afinn_lux = afinn %>%
  mutate(lux = map(word, possibly_translate, source = "en", target = "lb")) %>%
  mutate(lux = unlist(lux))

write_csv(afinn_lux, "afinn_lux.csv")

For the above code to work, you need to have a Google cloud account, which you can create for free.

I did not check the quality of the translations, and I’m sure it’s far from perfect. It’s also available on the Github repository here. Again, contributions more than welcome!

Now, I need to merge the dictionary with the data from each song. First, let’s load the dictionary:

afinn_lux = read.csv("afinn_lux.csv")

# I only keep the `lux` column (and rename it to word) and the `score column`
afinn_lux = afinn_lux %>%
  select(word = lux, score)

How does this dictionary look like? Let’s see:

head(afinn_lux)

##             word score
## 1       opzeginn    -2
## 2     verloossen    -2
## 3       opzeginn    -2
## 4 entfouert ginn    -2
## 5       entlooss    -2
## 6      entfouert    -2

Let’s load the tokenized songs, and merge them with the dictionary:

renert_songs_tokenized = readRDS("renert_songs_tokenized.rds")
  
renert_songs_sentiment = map(renert_songs_tokenized, ~full_join(., afinn_lux))

I can now merge the data in a single data frame and do some further cleaning:

renert_songs_sentiment = renert_songs_sentiment %>%
  bind_rows() %>%
  filter(!is.na(score)) %>%
  filter(!is.na(gesank))

What does the final data look like? Here it is:

head(renert_songs_sentiment)

## # A tibble: 6 x 3
##   word  gesank  score
##   <chr> <chr>   <int>
## 1 rifft éischte    -2
## 2 léiw  éischte    -3
## 3 fest  éischte     2
## 4 fest  éischte     2
## 5 räich éischte     2
## 6 räich éischte     3

We see that there are words that are the same, but with different scores. That’s because the translation of the dictionary was most probably not very good. Oh well, let’s do a boxplot of the sentiment for each song:

order =  c("éischte", "zwete", "drëtte", "véierte", "fënnefte", "sechste", "siwente",
                   "aachte", "néngte", "zéngte", "elefte", "zwielefte", "dräizengte", "véierzengte")

renert_songs_sentiment %>%
  ggplot(aes(gesank, score)) + 
  scale_x_discrete(limits = order) + 
  geom_boxplot() + 
  theme_minimal() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

As we can see, there is no discernible pattern. This can mean two things; either the general sentiment inside each song is fairly neutral, or the the quality of the translation was too bad for the results to make any sense.

That’s it for this series of posts! I hope you enjoyed reading it as much as I enjoyed writing it and analyzing the data!

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!

Analysis of the Renert - Part 2: Data Processing

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

This is part 2 of a 3 part blog post. This post uses the data that we scraped in part 1 and prepares it for further analysis, which is quite technical. If you’re only interested in the results of the analysis, skip to part 3!

First, let’s load the data that we prepared in part 1. Let’s start with the full text:

library("tidyverse")
library("tidytext")
renert = readRDS("renert_full.rds")

I want to study the frequencies of words, so for this, I will use a function from the tidytext package called unnest_tokens() which breaks the text down into tokens. Each token is a word, which will then make it possible to compute the frequencies of words.

So, let’s unnest the tokens:

renert = renert %>%
  unnest_tokens(word, text)

We still need to do some cleaning before continuing. In Luxembourgish, the is written d’ for feminine nouns. For example d’Kaz for the the cat. There’s also a bunch of ’ts in the text, which is it. For example, the second line of the first song:

’T stung Alles an der Bléi,

Everything (it) was on flower,

We can remove these with a couple lines of code:

renert_tokenized = renert %>%
  mutate(word = str_replace_all(word, "d'", "")) %>%
  mutate(word = str_replace_all(word, "'t", ""))

But that’s not all! We still need to remove so called stop words. Stop words are words that are very frequent, such as “and”, and these words usually do not add anything to the analysis. There are no set rules for defining a list of stop words, so I took inspiration for the stop words in English and German, and created my own, which you can get on Github.

stopwords = read.csv("stopwords_lu.csv", header = TRUE)

For my Luxembourgish-speaking compatriots, I’d be glad to get help to make this list better! This list is far from perfect, certainly contains typos, or even words that have no reason to be there! Please help 😅.

Using this list of stop words, I can remove words that don’t add anything to the analysis. Creating a list of stop words for the Luxembourgish language is very challenging, because there might be stop words that come from German, such as “awer”, from the German “aber”, meaning but, but you could also use “mä”, from the French mais, meaning also but. Plus, as a kid, we never really learned how to write Luxembourgish. Actually, most Luxembourguians don’t know how to write Luxembourgish 100% correctly. This is because for a very long time, Luxembourgish was used for oral communication, and French for formal written correspondence. This is changing, and more and more people are learning how to write correctly. I definitely have a lot to learn! Thus, I have certainly missed a lot of stop words in the list, but I am hopeful that others will contribute to the list and make it better! In the meantime, that’s what I’m going to use.

Let’s take a look at some lines of the stop words data frame:

head(stopwords, 20)

##          word
## 1           a
## 2           à
## 3         äis
## 4          är
## 5         ärt
## 6        äert
## 7        ären
## 8         all
## 9       allem
## 10      alles
## 11   alleguer
## 12        als
## 13       also
## 14         am
## 15         an
## 16 anerefalls
## 17        ass
## 18        aus
## 19       awer
## 20        bei

We can remove the stop words from our tokens using an anti_join():

renert_tokenized = renert_tokenized %>%
  anti_join(stopwords)

## Joining, by = "word"

## Warning: Column `word` joining character vector and factor, coercing into
## character vector

Let’s save this for later use:

saveRDS(renert_tokenized, "renert_tokenized.rds")

I now have to do the same for the data that is stored by song. Because this is a list where each element is a data frame, I have to use purrr::map() to map each of the functions I used before to each data frame:

renert_songs = readRDS("renert_songs_df.rds")
renert_songs = map(renert_songs, ~unnest_tokens(., word, text))
renert_songs = map(renert_songs, ~anti_join(., stopwords))
renert_songs = map(renert_songs, ~mutate(., word = str_replace_all(word, "d'", "")))
renert_songs = map(renert_songs, ~mutate(., word = str_replace_all(word, "'t", "")))

Let’s take a look at the object we have:

head(renert_songs[[1]])

## # A tibble: 6 x 1
##   word     
##   <chr>    
## 1 éischte  
## 2 gesank   
## 3 edit     
## 4 päischten
## 5 stung    
## 6 bléi

Looks pretty nice! But I can make it nicer by adding a column containing which song the data refers to. Indeed, the first line of each data frame contains the number of the song. I can extract this information and add it to each data set:

renert_songs = map(renert_songs, ~mutate(., gesank = pull(.[1,1])))

Let’s take a look again:

head(renert_songs[[1]])

## # A tibble: 6 x 2
##   word      gesank 
##   <chr>     <chr>  
## 1 éischte   éischte
## 2 gesank    éischte
## 3 edit      éischte
## 4 päischten éischte
## 5 stung     éischte
## 6 bléi      éischte

Now I can save this object for later use:

saveRDS(renert_songs, "renert_songs_tokenized.rds")

In the final part of this series, I will use the tokenized data as well as the list of songs to create a couple of visualizations!

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!

Analysis of the Renert - Part 1: Scraping

Mon, 22 Jan 2018 00:00:00 +0000

This is part 1 of a 3 part blog post. This post presents the Luxembourgish language as well as the literary work I am going to analyze using the R programming language. Part 2 deals with preparing the data for analysis, and finally part 3 is the analysis. Hope you enjoy!

Luxembourg and the Luxembourgish language

Luxembourg is a small European country, squeezed between France, Belgium and Germany. Over the course of its history, it’s been invaded over and over by either France or Prussia (later Germany). It eventually became a state under the personal possession of William I of the Netherlands in 1815, with a… Prussian garrison to guard its capital, Luxembourg City, from further French invasions. After the Belgian revolution of 1839, the purely French-speaking part of the country was ceded to Belgium and the Luxembourgish-speaking part became what is known today as the Grand-Duchy of Luxembourg. What’s a Grand-Duchy you might wonder?

Luxembourg is the only remaining Grand-Duchy in the world. A Grand-Duchy is like a Kingdom, but instead of a King, we have a Grand Duke. The current monarch is Henri, which means that Luxembourg is a constitutional monarchy with the head of state being the prime minister, Xavier Bettel. As you can imagine, Luxembourg’s history has had a very important impact on the languages we speak today in the country; there are three official languages, French, German, and Luxembourgish. Unlike other countries with several official languages, in Luxembourg, there is not a French, or German, or Luxembourgish speaking part. In Luxembourg, you use one of the three languages based on context.

For example, the laws are all written in French, and French is mostly the language used for official or formal written correspondence.German has traditionally been the language of the press and the police. And finally Luxembourgish is the language Luxembourguians use to speak with one another. This means that on a given day, most people here might switch between these three languages; of course, add English to the pile, which is rapidly growing in the country due to all the English speaking expats that come here to work (coughbrexitcough).

There is also a sizable Portuguese community in Luxembourg, so you’ll hear a lot of Portuguese on the streets too, as well as Italian. Around 50% of the inhabitants of Luxembourg are foreign born, mostly from other EU countries. The Italians, Portuguese and a lot of others have emigrated to Luxembourg starting in the 60s to work in the metallurgic sector, and later, in the construction sector. The children of these emigrants usually speak five languages; their mother tongue, say, Portuguese, the three official languages of the country, and finally English.

You might wonder what Luxembourgish sounds like? Here is a video of our Prime Minister talking in Luxembourgish:

Here is another video of him speaking French:

Here he’s speaking German :

And here English :

On the English video, you might notice the typical accent Luxembourguians have when speaking English 😄

The text we’re analysing

The text I’ll be analyzing is called Renert oder de Fuuss am Frack an a Maansgréisst, published in 1872 by Michel Rodange. My high school was named after Michel Rodange by the way! Renert is a fable featuring a sly fox as the main character, called Renert. He gets in trouble because of his shenanigans and gets sentenced to death by the Lion King. However, through further lies and deceptions, he manages to escape. After some tribulations, he proves his worth to the King by winning a duel against the wolf and becomes an aristocrat. Because it was written in the 19th century, the way some words are written may be different that how we write them in modern Luxembourgish, which might create some problems when analyzing the text.

Now starts the technical part. If you’re only interested in the results, you can skip to part 3!

Scraping the data

First of all, let’s load (or install if you don’t have them) the needed packages:

install.packages(c("tidyverse",
                   "tidytext",
                   "janitor"))

library("tidyverse")
library("tidytext")
library("janitor")

The tidyverse is a collection of packages that are very useful for a lot of different tasks. If you are not familiar with these packages, check out the tidyverse website.

tidytext is a package that uses the same principles than the tidyverse, but for text analysis. You can learn more about it here which is the book I took inspiration from for this series of blog posts.

The full text of the Renert is available here, so I’m going to use rvest, to get the text into R:

renert_link = "https://wikisource.org/wiki/Renert"

renert_raw = renert_link %>%
  xml2::read_html() %>%
  rvest::html_nodes(".mw-parser-output") %>%
  rvest::html_text() %>%
  str_split("\n", simplify = TRUE) %>%
  .[1, -c(1:24)]

I download the text using read_html() from the xml2 package (which gets loaded by the tidyverse) and then find the nodes that interest me, in this case mw-parser-output. Then I extract the text from this node, and split it on the \n character, to get a big vector where each element is a line of text. I also remove the 24 first lines, which are mostly blank. Let’s take a look at the first five lines:

renert_raw[1:5]

## [1] "Éischte Gesank.[edit]"       ""                           
## [3] "Et war esou ëm d'Päischten," "'T stung Alles an der Bléi,"
## [5] "An d'Villercher di songen"

The Renert is divided into 14 songs, so I’d like to create a list with 14 elements, where each element is the text of a song. Every song is titled “First Song”, “Second Song” etc, so I first check on which lines I find the word Gesank, which identifies the start of a song.

(indices = grepl("Gesank", renert_raw) %>% which(isTRUE(.)))

##  [1]    1  605  885 1172 1555 1906 2441 2664 2995 3686 4214 4625 5116 5963

indices contains the indices of where the songs start. So I need to create the indices of when the songs end. If you think about it, the first songs ends where the second song begins, minus 1. So I create a new vector of indices, by first removing the index for the first song, substracting 1, and then adding the index for the last line (using length(renert_raw)).

(indices2 = c(indices[-1] - 1, length(renert_raw)))

##  [1]  604  884 1171 1554 1905 2440 2663 2994 3685 4213 4624 5115 5962 6506

I can now create a list of sequences, called song_lines which contains the indices for all the songs:

song_lines = map2(indices, indices2,  ~seq(.x,.y))

And using this list of indices, I can now extract the songs into a list:

renert_songs = map(song_lines, ~`[`(renert_raw, .))

I’ll save this object for later use, using saveRDS():

saveRDS(renert_songs, "renert_songs.rds")

I will also save a version of the above list, but where each element of the list is a data frame. This will make analysis much easier later.

renert_songs_df = map(renert_songs, ~data_frame(text = .))
saveRDS(renert_songs_df, "renert_songs_df.rds")

I also need to have the full text as a single character object, so I reduce my list into a single object and also save it:

renert_full = reduce(renert_songs, c)

renert_full = data_frame(text = renert_full) %>%
  filter(!grepl("Gesank", text))

saveRDS(renert_full, "renert_full.rds")

This is the end of part 1. In part 2, we are going to prepare the data for analysis, and in part 3 we are going to analyze it.

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!

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!

Scraping data from the local elections

Fri, 27 Oct 2017 06:34:55 +0200

One of my journalist friend was looking at the result of the local election in Luxembourg and he was dissatisfied because he was unable to compare the results of all the communes. In fact, he wanted to compare the number of women that were candidates in each commune. So I asked him to hold on and I came back one hour later with this script that enables him to collect results of all communes in one table.

At the beginning, it was private code but I thought that it could be another great scraping example after the excellent post written by my colleague Bruno Rodrigues about scraping data from STATEC public tables.

So let’s get started. First, let’s load some packages:

#we have to load the packages if they are not installed on your computer,
#begin with the commented following lines:
#install.packages( "rvest" )
#install.packages( "tidyverse" )
#install.packages( "stringr" )

library(rvest) #to scrap
library(dplyr) #to manipulate data
library(stringr) #to manipulate string

We want to collect results of all communes in one data frame. We go to http://www.elections.public.lu and we collect data that is seen in the GIF bellow:

After clicking on different communes, we notice that the URLs have the same format. They have 3 parts :
1: “http://www.elections.public.lu/fr/elections-communales/2017/resultats/communes/”, the first part of the URL.
2: “communes_names” the name of the city is the second part of the URL.
3: “.html” is the last part.

For example, the complete URL for the commune of Luxembourg will be: http://www.elections.public.lu/fr/elections-communales/2017/resultats/communes/luxembourg.html

There are 103 communes, so we have to put all of them in a list. We scrape the 103 communes in one list via the script bellow :

url = "http://www.elections.public.lu/fr/elections-communales/2017/resultats/communes/bech.html"
communes = read_html(url) %>% 
        html_nodes("#communes #communes-az li") %>%
        html_text()

We verify that we have a list of 103 vectors and then we check the 5 first rows.

length(communes)

## [1] 103

head(communes,5)

## [1] "\r\n        Beaufort\r\n                a rendu l'ensemble de ses résultats\r\n    " 
## [2] "\r\n        Bech\r\n                a rendu l'ensemble de ses résultats\r\n    "     
## [3] "\r\n        Beckerich\r\n                a rendu l'ensemble de ses résultats\r\n    "
## [4] "\r\n        Berdorf\r\n                a rendu l'ensemble de ses résultats\r\n    "  
## [5] "\r\n        Bertrange\r\n                a rendu l'ensemble de ses résultats\r\n    "

It seems that the 103 communes are present but we still have to clean the data.

#Data is not cleaned and there are some useless characters that need to be removed.
#We need to clean data.
communes = gsub("a rendu l'ensemble de ses résultats"," ", communes )
communes = trimws(gsub("\r\n","",communes ))
communes = gsub("/Attert","-sur-attert", communes )
communes = gsub(" - ", "-",communes )
communes = gsub(" ", "-",communes )
communes = gsub("'", "-",communes )
communes = gsub("é", "e",communes )
communes = gsub("û", "u",communes )
communes = gsub("ä", "a",communes )

#Lower case
communes = tolower(communes)

head(communes, 5)

## [1] "beaufort"  "bech"      "beckerich" "berdorf"   "bertrange"

Now that we have the list of the 103 communes, we will write a function that will enable us to collect data that we want to display in our data frame.

#Function to have the result for one commune.
  result = function(x){
  #scrapping data
  vote = read_html(paste("http://www.elections.public.lu/fr/elections-communales/2017/resultats/communes/",x,".html", sep="")) %>% 
          html_nodes("#lux-number .lux-number ul li") %>%
          html_text()%>%.[-1]
  
  #Conditions need to be added to have clean data.
  #Here we add a trick, the vector 14 and 15 are the only ones that   haven't the string "\r\n".
  #So we add "\r\n" to these vectors.
  if(nchar(vote[14]) > 21){
          vote[14] = gsub("ble","ble\r\n", vote[14],perl = FALSE)
  }
  if(nchar(vote[15]) > 21){
          vote[15] = gsub("mé","mé\r\n", vote[15],perl = FALSE)
  }
  #We split vectors to dissociate the results (numbers) and the titles   (letters).
  vote = unlist(str_split(vote, "\r\n"))
  vote = trimws(vote)
  vote = vote[vote != ""]
  
  #Here we have similar title so we change them to not be confused.
  #Candidat Lux means Luxemburgish Candidates  & Electeur Lux means   Luxemburgish voters. 
  vote[7] = gsub("Lux", "Candidat Lux", vote[7] )
  vote[9] = gsub("Non Lu", "Candidat Non Lu", vote[9] )
  vote[13] = gsub("Lux", "Electeur Lux", vote[13] )
  vote[15] = gsub("Non Lu", "Electeur Non Lu", vote[15]  )
  
  #We create the data frame.
  #Vector with pair indice value are the results (the column val).
  pair = (1:15)*2
  
  #Vectors with odd index value are the titles (the column title).
  impair = (1:15)*2 - 1
  res = data.frame(communes = rep(x,15), title = vote[impair], val =   vote[pair])
  return(res)
}

Then we use the lapply() function to apply this function to the 103 communes and bind them in one data frame:

#We use the result function on all the communes.
res = lapply(communes, result)
#We bind the rows to have a complete data frame with all the results from all communes
#then we bind all the result.
df = do.call(rbind, res)

To see the 5 first rows of our new data frame:

#Now the data that we have look like this:
head(df,5)

##   communes                       title val
## 1 beaufort                       Total  10
## 2 beaufort                      Femmes   5
## 3 beaufort                      Hommes   5
## 4 beaufort     Candidat Luxembourgeois  10
## 5 beaufort Candidat Non Luxembourgeois   0

As you can see, it’s looking good but we are not completely satisfied because we would like to transpose data to have one result in one column. To this end, we use the tidyr package.

library(tidyr)

#Transposing data will enables us to make analysis faster.
#We transform val in a numeric variable then we transpose data.

tdf = df %>%
        mutate(val = as.numeric(gsub(" ", "", val))) %>%
        spread(title, val)

To see the 5 first rows of our new data frame:

#Now the data that we have look like this:
head(tdf,5)

##    communes Blancs Candidat Luxembourgeois Candidat Non Luxembourgeois
## 1  beaufort     78                      10                           0
## 2      bech      0                       8                           0
## 3 beckerich     67                      10                           1
## 4   berdorf     23                      20                           0
## 5 bertrange     75                      45                           7
##   Dans l'urne Electeur Luxembourgeois Electeur Non Luxembourgeois Femmes
## 1        1144                    1170                         114      5
## 2           0                     699                          95      1
## 3        1396                    1393                         137      2
## 4         857                     850                          79      7
## 5        2935                    2972                         478     22
##   Grand total exprimé Grand total possible Hommes Inscrits Nuls Total
## 1                4021                 9234      5     1284   40    10
## 2                   0                    0      7      794    0     8
## 3                5792                11637      9     1530   36    11
## 4                4929                 7371     13      929   15    20
## 5               32880                35620     30     3450  120    52
##   Valables Votes par correspondance
## 1     1026                       71
## 2        0                        0
## 3     1293                      109
## 4      819                       57
## 5     2740                      269

Now you can export the table in excel or play with your data in R!

readr::write_excel_csv(tdf,"election_lux.csv")
#To know where your file is saved, we use the following function:
#setwd()

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!

Scraping data from STATEC's public tables

Fri, 21 Apr 2017 06:34:55 +0200

A lot of open data is available in Luxembourg’s open data portal, but sometimes, it is not very easy to download. In the video below, I give you an example of such data and show how you can use rvest to get the data easily.

After watching the video, take a look at the code below. This code does two things; first it scrapes the data, and then it puts the data in a tidy format fur further processing.

So to summarize the idea of the video; instead of clicking the buttons to download each year’s data (which you would have to do 15 times), it is easier to simple turn off javascript and then scrape the html version of the table. It would be possible, albeit with much more effort, to scrape the tables with javascript enabled, by using a tool such as phantomjs. But since we have the possibility to view the table in html, why not take advantage of it?

To scrape the data, you will need first to install the rvest and then load it (and let’s also load the other needed packages)

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

Now, using rvest::read_html(), we can download the whole html page:

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

Now, we need to extract the table from the html page, and we do this by using rvest::html_nodes() and by providing this function with the name of the class of the object we’re interested in, namely, the table.

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


head(data_raw)

##                          X1                         X2      X3      X4
## 1                      Year                       Year    2001    2002
## 2             Specification                       Year    2001    2002
## 3 Grand Duchy of Luxembourg  Total employed population 180,084 182,004
## 4 Grand Duchy of Luxembourg     of which: Wage-earners 162,407 164,277
## 5 Grand Duchy of Luxembourg of which: Non-wage-earners  17,677  17,727
## 6 Grand Duchy of Luxembourg                 Unemployed   5,393   6,773
##        X5      X6      X7      X8      X9     X10     X11     X12     X13
## 1    2003    2004    2005    2006    2007    2008    2009    2010    2011
## 2    2003    2004    2005    2006    2007    2008    2009    2010    2011
## 3 183,419 186,325 187,380 192,095 197,486 202,203 204,127 207,923 214,094
## 4 165,509 168,214 169,194 174,045 179,176 183,705 185,369 188,983 194,893
## 5  17,910  18,111  18,186  18,050  18,310  18,498  18,758  18,940  19,201
## 6   8,359   9,426  10,653  10,297   9,670  11,496  14,816  15,567  16,159
##       X14     X15     X16     X17      X18
## 1    2012    2013    2014    2015     2016
## 2    2012    2013    2014    2015 Measures
## 3 219,168 223,407 228,423 233,130  236,100
## 4 199,741 203,535 208,238 212,530  215,430
## 5  19,427  19,872  20,185  20,600   20,670
## 6  16,963  19,287  19,362  18,806   18,185

As you can see, we got the data in quite a nice format, but it still needs to be cleaned a bit. Let’s do this.

First, let’s use the first row as the header of the data set and then remove it:

colnames(data_raw) <- data_raw[2, ]
colnames(data_raw)[1:2] <- c("division", "variable")
data_raw <- data_raw[-c(1,2), ]
head(data_raw)

##                    division                   variable    2001    2002
## 3 Grand Duchy of Luxembourg  Total employed population 180,084 182,004
## 4 Grand Duchy of Luxembourg     of which: Wage-earners 162,407 164,277
## 5 Grand Duchy of Luxembourg of which: Non-wage-earners  17,677  17,727
## 6 Grand Duchy of Luxembourg                 Unemployed   5,393   6,773
## 7 Grand Duchy of Luxembourg          Active population 185,477 188,777
## 8 Grand Duchy of Luxembourg   Unemployment rate (in %)    2.91    3.59
##      2003    2004    2005    2006    2007    2008    2009    2010    2011
## 3 183,419 186,325 187,380 192,095 197,486 202,203 204,127 207,923 214,094
## 4 165,509 168,214 169,194 174,045 179,176 183,705 185,369 188,983 194,893
## 5  17,910  18,111  18,186  18,050  18,310  18,498  18,758  18,940  19,201
## 6   8,359   9,426  10,653  10,297   9,670  11,496  14,816  15,567  16,159
## 7 191,778 195,751 198,033 202,392 207,156 213,699 218,943 223,490 230,253
## 8    4.36    4.82    5.38    5.09    4.67    5.38    6.77    6.97    7.02
##      2012    2013    2014    2015 Measures
## 3 219,168 223,407 228,423 233,130  236,100
## 4 199,741 203,535 208,238 212,530  215,430
## 5  19,427  19,872  20,185  20,600   20,670
## 6  16,963  19,287  19,362  18,806   18,185
## 7 236,131 242,694 247,785 251,936  254,285
## 8    7.18    7.95    7.81    7.46     7.15

This is starting to look nice, but we need to replace the “,” with “.” and then convert the columns to numeric.

data_raw %>%
  map_df(function(x)(gsub(",", ".", x = x))) %>%
  mutate_at(vars(matches("\\d{4}")), as.numeric
            ) -> clean_unemp

head(clean_unemp)

## # A tibble: 6 x 18
##   division    variable    `2001` `2002` `2003` `2004` `2005` `2006` `2007`
##   <chr>       <chr>        <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
## 1 Grand Duch… Total empl… 180    182    183    186    187    192    197   
## 2 Grand Duch… of which: … 162    164    166    168    169    174    179   
## 3 Grand Duch… of which: …  17.7   17.7   17.9   18.1   18.2   18.0   18.3 
## 4 Grand Duch… Unemployed    5.39   6.77   8.36   9.43  10.7   10.3    9.67
## 5 Grand Duch… Active pop… 185    189    192    196    198    202    207   
## 6 Grand Duch… Unemployme…   2.91   3.59   4.36   4.82   5.38   5.09   4.67
## # ... with 9 more variables: `2008` <dbl>, `2009` <dbl>, `2010` <dbl>,
## #   `2011` <dbl>, `2012` <dbl>, `2013` <dbl>, `2014` <dbl>, `2015` <dbl>,
## #   Measures <chr>

This line: map_df(function(x)(gsub(",", ".", x = x))) calls purrr::map_df(), which maps a function to each column of a data frame. The function in question is function(x)(gsub(",", ".", x = x)), which is an anonymous function (meaning it does not have a name) wrapped around gsub. This function looks for the string “,” and replaces it with “.” in a single column of the data frame. But because we’re mapping this function to all the columns of the data frame with purrr::map_df(), this substitution happens in each column. We’ not done yet, because these columns are still holding characters. We need to convert each column to a numeric vector and this is what happens in the next line, mutate_at(vars(matches("\\d{4}")), as.numeric). Each column that contains exactly for digits (hence the "\\d{4}") is converted to numeric with dplyr::mutate_at().

Now, one last step to really have the data in a nice format:

clean_unemp %>% 
    gather(key=year, value, -division, -variable) %>%
    spread(variable, value) %>%
    clean_names(
           ) -> clean_unemp

head(clean_unemp)

## # A tibble: 6 x 8
##   division year  active_population of_which_non_wage_e… of_which_wage_ear…
##   <chr>    <chr> <chr>             <chr>                <chr>             
## 1 Beaufort 2001  688               85                   568               
## 2 Beaufort 2002  742               85                   631               
## 3 Beaufort 2003  773               85                   648               
## 4 Beaufort 2004  828               80                   706               
## 5 Beaufort 2005  866               96                   719               
## 6 Beaufort 2006  893               87                   746               
## # ... with 3 more variables: total_employed_population <chr>,
## #   unemployed <chr>, unemployment_rate_in_percent <chr>

By using tidyr::gather() and then tidyr::spread() we get a nice data set where each column is a variable and each row is an observation. I advise you run the above code line by line and try to understand what each function does. We finish by cleaning the names of the variables with janitor::clean_names() and that’s it.

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!