Motivation for this

The background to this package linked to a project I undertook about a year ago.

The video relates to the project and the how R really sped up the process.

The exam question was to use a regression model to predict admissions and we had to evaluate, as a consequence, 60 different variations. In Excel, this would have been a nightmare. Again, R to the rescue. You can see the presentation below, if interested:

Getting off my arse and creating the documentation / package

Reflecting and cogitating on the NHS-R conference this year, I thought why not use the remainder of Wednesday evening to hop on to R Studio and start to make this as a package. I found the MIT PDF very helpful: http://web.mit.edu/insong/www/pdf/rpackage_instructions.pdf.

So that is just what I did.

What does this package do?

It simply analyses the results of a logistic regression model and creates an odds plot. This, I found, was an easier way for the strategic audience to engage with the outputs of the tool.

Reflecting on this – I thought this is a really useful little chart and so OddsPlotty was born.

Installing the package

The installation of the package can be achieved by loading up R Studio and then typing in the code below:

1

devtools::install_github("https://github.com/StatsGary/OddsPlotty", dependencies = TRUE)

Once this has been typed into the console or script editor R will automatically look for the package on Github. This subsequently returns and loads the package into the environment, and then you can load this in by using library(OddsPlotty).

Using the package

The vignette I have created on the RPubs website shows how to use the tool: https://rpubs.com/StatsGary/547542.

Outputs from the tool

As this is now a ggplot2 object – you can also use the plot with different themes. The below are three examples of different themes from the tool:

Classic view

This shows, on the test dataset, that the odds of a cancer being benign or malignant, based on the sample I was using, are greater if the measured thickness and bare nuclei are larger. This is a sample machine learning dataset from the package mlbench.

Odds plot dressed in economist view

As you can see – the plot is flexible and allows for lots of customisability.

Edward Tufte would be proud

If you have never heard of Edward Tufte he was one of the pioneers of data visualisation. Read some of his stuff, the visuals are outdated, but the principles still hold true.

On a tangential, I will return to the final output used as an example:

For the full implmentation of how to use this chart with logistic regression models – refer to the aforementioned vignette.

Evolution and iteration

This is just the first cut of the application, however, I would love to hear feedback and potential future developments for the tool. If you have found any issues or problems then leave a post on my Twitter page (using #oddsplottyR).

Please stay posted, as I aim to publish more packages in the future. The quote below resonates with me when it comes to some of the options in the devtools() package:

“It’s still magic even if you know how it’s done.”

― Terry Pratchett, A Hat Full of Sky

An interesting big data thought experiment

The other day on Twitter I saw someone referencing a paper or a seminar or something that was reported to examine the following situation: if you have an urn with a million balls in it of two colours (say red and white) and you want to estimate the proportion of balls that are red, are you better off taking the top 800,000 balls – or stirring the urn and taking a sample of just 10,000? The answer given was the second of these options. The idea is to illustrate the limitations of “big data” methods, which can often be taken to mean samples that are very large but of uncertain quality with regard to representativeness and randomness.

The nature of the Twitter user experience is such that I’ve since lost track of the original post and can’t find it again.

My first thought was “wow, what a great illustration!” My second was “actually, that sounds a bit extreme.” After all, worsening your estimate by 80:1 a pretty severe design effect penalty to pay for non-random sampling. A bit of thinking shows that whether the small, random sample outperforms the bigger one is going to depend very much on how the urn was filled in the first place.

Consider as an extreme example that the urn was filled by pouring in all the balls of one colour, then all of another. In this situation you will certainly be better off with the stirring method (in all that follows, I am going to assume that the stirring is highly effective, and that stirring and sampling equates to taking a simple random sample).

But at the other extreme, if the urn was filled in a completely random order, than either sampling method equates to simple random sampling, and the larger sample will greatly outperform the smaller. In fact, in that case the standard errors from the stirring method will be 8.9 times from the large data method (square root of 80). So the choice between the methods depends on how spatially correlated (in 3 dimensional space) the colour of the balls is within the urn. This is similar to how the need for special time series methods depends on whether there is autocorrelation over time; spatial methods depends on whether there is spatial autocorrelation; and adjusting for survey design effects depends on intra-cluster correlation.

Efficiently simulating filling an urn with balls

To explore just how correlated the balls need to be for the simple random sampling method to be preferred, I ran a simple simulation. In this simulation, the balls are added to the urn one at a time, with no natural stirring. There is an overall probability p of a ball being red (and this is the exact probability of the first ball that goes in being red), but for the second and subsequent balls there is a second probability to be aware of, q, which is the chance that this ball will be forced to be the same colour as the previous ball, rather than pulled from the hyper population with parameter p.

Here’s a simple R function that will generate an urn of size n with those parameters:

Post continues after R code.

library(tidyverse)library(scales)library(Rcpp)library(microbenchmark)#' Simulate filling of an urn with red and white balls, with serial correlation#'#' @param n Number of red and white balls in the urn#' @param p overall hyper-population proportion of red balls#' @param q probability that a ball, when originally placed in the urn in order, will be the same#' colour as the preceding ball rather than randomly chosing between red and white with probability pfill_urn_r<-function(n,p,q){x<-numeric(n)x[1]<-rbinom(1,1,prob=p)for(iin2:n){x[i]<-ifelse(rbinom(1,1,prob=q)==1,x[i-1],rbinom(1,1,prob=p))}return(x)}

However, this R program is too slow for my purposes. I’m going to want to generate many thousands of these urns, with a million balls in each, so time really matters. It was worth re-writing this in C++ via the Rcpp R package.

Post continues after R code.

# C++ version, hopefully much faster:cppFunction('NumericVector fill_urn_c(int n, double p, double q) {  NumericVector x(n);  x[0] = as(rbinom(1, 1, p));  for (int i=1; i(rbinom(1, 1, q)) == 1){    x[i] = x[i-1];   } else {       x[i] = as(rbinom(1, 1, p));   }  }    return x;}')# Check the R and C++ versions give same results:all.equal({set.seed(123);fill_urn_c(30,0.3,0.9)},{set.seed(123);fill_urn_r(30,0.3,0.9)})# Compare speedsmicrobenchmark("C++"=fill_urn_c(10000,0.3,0.9),"R"=fill_urn_r(10000,0.3,0.9))

The C++ function was as easy to write as the R version (helped by the Rcpp function rbinom which makes C++ seem even more familiar to R users) and delivers roughly a 40- or 50-fold speed up. Here’s the results of that benchmarking at the end of the last chunk of code:

Unit: microseconds expr     min       lq      mean   median      uq      max neval  C++   705.9   755.85   991.928   851.15   960.3   6108.1   100    R 31868.7 36086.60 69251.103 41174.25 48143.8 427038.0   100

By the way, the as() in my Rcpp code is needed because rbinom generates a vector (of size one in this case) and I want to treat it as a scalar. There may be a more elegant way of handling this, but this was good enough for my purposes.

Comparing the two sampling methods

To help with comparing the two sampling methods, I write two more functions:

• compare_methods() to run the “big data” and random sampling methods on a single urn and compare their results to the true proportion in that particular urn (using the actual proportion in the urn, not the hypothetical hyper-parameter p)
• overall_results() to generate many urns with the same set of parameters

Post continues after R code.

#------------------Comparing two sampling methods-----------#' Compare two methods of sampling#' #' @param x a vector of 1 and 0 for which we want to estimate the proportion of 1s#' @return a data frame with one row and two columns, showing the difference between two #' methods of sampling and estimating a proportion#' @details The "big data" method takes the most recent 80% as the sample. The "sample" method#' takes a simple random sample.compare_methods<-function(x){n<-length(x)correct<-mean(x)# Method 1 - the most recent 80% of observations:bigdata_method<-mean(tail(x,round(n*0.8)))-correct# Method 2 - simple random sample of 1% of observations:sample_method<-mean(sample(x,round(n*0.01)))-correctreturn(data.frame(bigdata_method=bigdata_method,sample_method=sample_method))}#' Repeated comparison of two methods of sampling#' #' @param m Number of times to run the experiment#' @param n Number of red and white balls in the urn for which we are trying to estimate a proportion#' @param p overall hyper-population proportion of red balls#' @param q probability that a ball, when originally placed in the urn in order, will be the same#' colour as the preceding ball rather than randomly chosing between red and white with probability p#' @details This works by repeated calls to fill_urn_c() and compare_methods()overall_results<-function(m,n,p,q){results<-lapply(1:m,function(j){x<-fill_urn_c(n,p,q)y<-compare_methods(x)return(y)})tmp<-do.call(rbind,results)%>%tidyr::gather(variable,value)%>%dplyr::mutate(m=m,n=n,p=p,q=q)return(tmp)}

Here’s what I get when I compare the two methods for a thousand runs with urns of 10,000 balls each, with p = 0.3 and various values of q:

… and here are the results for the original use case, a thousand runs (at each value of q) of an urn with one million balls:

So we can see in both cases we need a lot of serial correlation between balls (based on the order they go into the urn) for the method of random sampling 1% of the balls to out-perform the brute force selection of the top 80% of balls. Somewhere between a value for q of 0.99 and 0.999 is when the stirring method is clearly better. Remember, q is the probability that any ball going into the urn is the same as the previous ball, before the alternative colour selection being chosen with probability p (0.3 in our case).

Here’s the code for the actual simulations.

Post continues after R code.

#-------------------------------Small urns--------------tmp1<-overall_results(1000,1e4,0.3,0.9)tmp2<-overall_results(1000,1e4,0.3,0.99)tmp3<-overall_results(1000,1e4,0.3,0.999)tmp4<-overall_results(1000,1e4,0.3,0.9999)rbind(tmp1,tmp2,tmp3,tmp4)%>%mutate(variable=case_when(variable=="bigdata_method"~"Sample 80% of balls at top of urn",variable=="sample_method"~"Stir urn and take random sample of 1%"))%>%mutate(q=paste(q,"serial relationship factor"))%>%ggplot(aes(x=value,fill=variable,colour=variable))+geom_density(alpha=0.5)+facet_wrap(~q,scales="free")+labs(fill="Sampling method:",colour="Sampling method:",x="Discrepency between sample proportion and true proportion from entire urn",title="Comparison of 'big data' and random sampling methods",subtitle="Estimating a proportion from an urn of 10,000 red and white balls.Which method works best depends on the degree of serial correlation between balls.",caption="http://freerangestats.info")#----------------------Large urns------------------tmp5<-overall_results(1000,1e6,0.3,0.9)tmp6<-overall_results(1000,1e6,0.3,0.99)tmp7<-overall_results(1000,1e6,0.3,0.999)tmp8<-overall_results(1000,1e6,0.3,0.9999)rbind(tmp5,tmp6,tmp7,tmp8)%>%mutate(variable=case_when(variable=="bigdata_method"~"Sample 80% of balls at top of urn",variable=="sample_method"~"Stir urn and take random sample of 1%"))%>%mutate(q=paste(q,"serial relationship factor"))%>%ggplot(aes(x=value,fill=variable,colour=variable))+geom_density(alpha=0.5)+facet_wrap(~q,scales="free")+labs(fill="Sampling method:",colour="Sampling method:",x="Discrepency between sample proportion and true proportion from entire urn",title="Comparison of 'big data' and random sampling methods",subtitle="Estimating a proportion from an urn of 10,000 red and white balls.Which method works best depends on the degree of serial correlation between balls.",caption="http://freerangestats.info")

One final point – what if we look at the absolute value of the discrepency between each methods estimate of the proportion and its true value. We see basically the same picture.

rbind(tmp5,tmp6,tmp7,tmp8)%>%mutate(variable=case_when(variable=="bigdata_method"~"Sample 80% of balls at top of urn",variable=="sample_method"~"Stir urn and take random sample of 1%"))%>%mutate(q=paste(q,"serial relationship factor"))%>%mutate(value=abs(value))%>%ggplot(aes(x=value,fill=variable,colour=variable))+geom_density(alpha=0.5)+facet_wrap(~q,scales="free")+labs(fill="Sampling method:",colour="Sampling method:",x="Absolute value of discrepency between sample proportion and true proportion from entire urn",title="Comparison of 'big data' and random sampling methods, urn with 1,000,000",subtitle="Estimating a proportion from an urn of 10,000 red and white balls.Which method works best depends on the degree of serial correlation between balls.",caption="http://freerangestats.info")

Reflections

If we thought the data generating process (ie how the urn was filled with balls) resembled my simulation, you would be better off choosing the large sample method (assuming equal cost) unless you had reason to believe the serial relationship factor q was very high. But this doesn’t invalidate the basic idea of the usefulness of random sampling. This is for several reasons:

• The costs are unlikely to be the same. Even with today’s computers, it is easier and cheaper to collect, process and analyse smaller than larger datasets.
• The “big data” method is risky, in the sense that it makes the analyst vulnerable to the true data generating process in a way that simple random sampling doesn’t. With random sampling we can calculate the properties of the statistic exactly and with confidence, so long as our stirring is good. We can’t say the same for the “top 80%” method.
• Related to the point above, the risk is particularly strong if the data generating process is quirkier than my simulation. For example, given my simulated data generating process, both sampling methods produce unbiased results. However, this isn’t always going to be the case. Consider if the urn had been filled on the basis of “put all the red balls in first; then fill up the rest of the urn with white balls”. In this case the “top 80%” method will be very badly biased to underestimate the proportion of red balls (in fact, with p = 0.3, the method will estimate it to be 0.125 – a ghastly result).

That final dot point might sound perverse, but actually it isn’t hard to imagine a real life situation in which data is generated in a way that is comparable to that method. For example, I might have one million observations of the level of sunlight, taken between 1am and 9am on a November morning in a temperate zone.

So my overall conclusion – a small random sample will give better results than a much larger non-random sample, under certain conditions; but more importantly, it is reliable and controls for risk.

Unborking the borked laptop –

Recap

I’m trying to learn some Linux. Ostensibly to do some data science at the command line, because it feels like something I might need to know at some point. I have reclaimed an old Windows laptop ( poorly specced, with missing keys and a penchant for sending the cursor up several lines at once with no prior warning), and I installed a Ubuntu distribution on it.

I then decided to update the distribution, and accidentally lost power during that install. So now, I have a laptop with no Windows, no Linux, and it won’t boot

Day 2

Today the clocks go back 1 hour. That’s supposed to mean an extra hour in bed. That doesn’t happen when you have kids though, so, having staggered to bed at a stupid time in the morning, I am being woken a few hours later. Miraculously, there is no fighting or squabbling (amongst the kids that is), so once breakfast is out the way, I pick up the laptop and retrace my steps from the previous night:

• install 2015 version of Ubuntu from cover disk
• fix the broken APT, which I later discover means Advanced Packaging Tool. Without it, I can’t update.
• Peform a proper installation of Ubuntu 2016 LTS.

At last, I have a decent installation. I take a look at the software centre, which is where you find new programs and tools, and see some new options available. A python interpreter is already installed, Julia is available, and I eventually find an older version of R, so of course, I install that.

It really is old though, so I find myself browsing to CRAN and downloading the latest version. Thankfully, I don’t need to do any command line kung fu to get it installed, which is kind of cheating, but I just want it on there.

Having fired it up, and being glad it worked, I decide to go for RStudio as well.

This is where things start to get interesting – it doesn’t install because of missing / out of date files.

So it’s back to firing up the terminal, and apt-get install to try and find the stuff I need. Ubuntu is pretty good at telling you what is going on, and what the problems are, so I didn’t feel too lost. There was a bit of googling going on, but nothing out of the ordinary.

I’ve written an R package, which builds fine in Windows. I tried a random Linux build using RHub’s online tool, and it failed. So, I wondered if I could download my package from github and build it in Ubuntu.

Once I’d got RStudio installed, I begin installing packages. I figured the biggest bang for my buck was installing tidyverse. Blimey, that took ages. A few things failed (dependencies of dependencies), so there were some false starts getting everything needed, and then it began to build the package.

I had no idea it would take so long. Seriously, it feels like Windows has the edge here.

My first plot in Ubuntu

It’s worth reading that thread as Chris Beeley, Paul Drake and others all chipped in with really good advice.

Various other packages were installed. Data.table was a breeze. Eventually I had what I needed ( data.table, zoo, ggplot2 and magrittr) so I downloaded my package files.

I opened them up in RStudio, and verified that it passed all checks, then built it.

Success, package built, and working in Linux.

I tweeted out some pics, and spawned a bit of discussion amongst several other NHS colleagues – you know who you are. Later on that night, I tried to burn Linux Mint to disk. I used the built in ‘brasero’ disk burner, but it failed. Possibly due to a combination of poor quality disk, and a rickety CD/DVD drive.

Apparently, I should be using a usb-key for this, but it’s been years since I had need for a usb-drive, so did not have one to hand.

I finished off by browsing through an ebook I picked up for free on Amazon (Linux for Beginners by Jason Cannon happened to be on offer a day or so earlier)

It starts off by explaining file directories, and how to navigate them, which is definitely going to take a bit of practice, for someone so used to ‘point and click’ navigation.

So, to recap, some slight progress:

• 2016 LTS installed
• R , RStudio and VS Code installed
• Checked and built my R package on Ubuntu – woohoo
• Informed that Mint was the way to go, as was usb installation
• Lots of practice with apt-get upgrade, apt-get install and apt autoremove

The third maintenance release 1.0.3 of Rcpp, following up on the 10th anniversary and the 1.0.0. release both pretty much exactly one year ago, arrived on CRAN yesterday. This deserves a special shoutout to Uwe Ligges who was even more proactive and helpful than usual. Rcpp is a somewhat complex package with many reverse dependencies, and both the initial check tickles one (grandfathered) NOTE, and the reverse dependencies typically invoke a few false positives too. And in both cases did he move the process along before I even got around to replying to the auto-generated emails. So just a few hours passed between my upload, and the Thanks, on its way to CRAN email—truly excellent work of the CRAN team. Windows and macOS binaries are presumably being built now. The corresponding Debian package was also uploaded as a source package, and binaries have since been built.

Just like for Rcpp 1.0.1 and Rcpp 1.0.2, we have a four month gap between releases which seems appropriate given both the changes still being made (see below) and the relative stability of Rcpp. It still takes work to release this as we run multiple extensive sets of reverse dependency checks so maybe one day we will switch to six month cycle. For now, four months seem like a good pace.

Rcpp has become the most popular way of enhancing R with C or C++ code. As of today, 1832 packages on CRAN depend on Rcpp for making analytical code go faster and further, along with 190 in BioConductor. And per the (partial) logs of CRAN downloads, we are currently running at 1.1 millions downloads per month.

This release features a number of different pull requests by five different contributors as detailed below.

Changes in Rcpp version 1.0.3 (2019-11-08)

• Changes in Rcpp API:

  • Compilation can be sped up by skipping Modules headers via a toggle RCPP_NO_MODULES (Kevin in #995 for #993).

  • Compilation can be sped up by toggling RCPP_NO_RTTI which implies RCPP_NO_MODULES (Dirk in #998 fixing #997).

  • XPtr tags are now preserved in as<> (Stephen Wade in #1003 fixing #986, plus Dirk in #1012).

  • A few more temporary allocations are now protected from garbage collection (Romain Francois in #1010, and Dirk in #1011).

• Changes in Rcpp Modules:

  • Improved initialization via explicit Rcpp:: prefix (Riccardo Porreca in #980).

• Changes in Rcpp Deployment:

  • A unit test for Rcpp Class exposure was updated to not fail under r-devel (Dirk in #1008 fixing #1006).

• Changes in Rcpp Documentation:

  • The Rcpp-modules vignette received a major review and edit (Riccardo Porreca in #982).

  • Minor whitespace alignments and edits were made in three vignettes following the new pinp release (Dirk).

  • New badges for DOI and CRAN and BioConductor reverse dependencies have been added to README.md (Dirk).

  • Vignettes are now included pre-made (Dirk in #1005 addressing #1004)).

  • The Rcpp FAQ has two new entries on ‘no modules / no rtti’ and exceptions across shared libraries (Dirk in #1009).

Thanks to CRANberries, you can also look at a diff to the previous release. Questions, comments etc should go to the rcpp-devel mailing list off the R-Forge page. Bugs reports are welcome at the GitHub issue tracker as well (where one can also search among open or closed issues); questions are also welcome under rcpp tag at StackOverflow which also allows searching among the (currently) 2255 previous questions.

If you like this or other open-source work I do, you can now sponsor me at GitHub. For the first year, GitHub will match your contributions.

This post by Dirk Eddelbuettel originated on his Thinking inside the box blog. Please report excessive re-aggregation in third-party for-profit settings.

var vglnk = { key: '949efb41171ac6ec1bf7f206d57e90b8' }; (function(d, t) {var s = d.createElement(t); s.type = 'text/javascript'; s.async = true;s.src = '//cdn.viglink.com/api/vglnk.js';var r = d.getElementsByTagName(t)[0]; r.parentNode.insertBefore(s, r); }(document, 'script'));

Here’s a common situation: you have a folder full of similarly-formatted CSV or otherwise structured text files that you want to get into R quickly and easily. Reading data into R is one of those tasks that can be a real source of frustration for beginners, so I like collecting real-life examples of the many ways it’s become much easier.

This week in class I was working with country-level historical mortality rate estimates. These are available from mortality.org, a fabulous resource. They have a variety of data available but I was interested in the 1×1 year estimates of mortality for all available countries. By “1×1” I mean that the tables show (for men, women, and in total) age-specific morality rate estimates for yearly ages from 0 to 110 and above, for every available historical year (e.g. from 1850 to 2016 or what have you). So you can have an estimate of the mortality rate for, say, 28 year olds in France in 1935.

Downloading this data gives me a folder of text files, one for each country. (Or rather, country-like unit: there are separate series for, e.g. East Germany, West Germany, and Germany as a whole, for example, along with some countries where sub-populations are broken out historically.) The names of the files are consistently formatted, as is the data inside them, and they have a .txt extension. What I wanted to do was get each one of these files into R, ideally putting them all into a single big table that could be the jumping-off point for subsetting and further analysis.

I know from the documentation provided by mortality.org that the files all have the same basic format, which of course makes things much easier. The data is already clean. It’s just a matter of loading it all in efficiently, or “ingesting” it, to use the charming image that seems to be preferred at present.

Here we go. First, some libraries.

library(tidyverse)library(janitor)library(here)

## here() starts at /Users/kjhealy/Source/demog

We get a list of the filenames in our raw data folder, along with their full paths. Then we take a look at them.

filenames <-dir(path = here("rawdata"),
                 pattern ="*.txt",
                 full.names =TRUE)

filenames

##  [1] "/Users/kjhealy/Source/demog/rawdata/AUS.Mx_1x1.txt"    ##  [2] "/Users/kjhealy/Source/demog/rawdata/AUT.Mx_1x1.txt"    ##  [3] "/Users/kjhealy/Source/demog/rawdata/BEL.Mx_1x1.txt"    ##  [4] "/Users/kjhealy/Source/demog/rawdata/BGR.Mx_1x1.txt"    ##  [5] "/Users/kjhealy/Source/demog/rawdata/BLR.Mx_1x1.txt"    ##  [6] "/Users/kjhealy/Source/demog/rawdata/CAN.Mx_1x1.txt"    ##  [7] "/Users/kjhealy/Source/demog/rawdata/CHE.Mx_1x1.txt"    ##  [8] "/Users/kjhealy/Source/demog/rawdata/CHL.Mx_1x1.txt"    ##  [9] "/Users/kjhealy/Source/demog/rawdata/CZE.Mx_1x1.txt"    ## [10] "/Users/kjhealy/Source/demog/rawdata/DEUTE.Mx_1x1.txt"  ## [11] "/Users/kjhealy/Source/demog/rawdata/DEUTNP.Mx_1x1.txt" ## [12] "/Users/kjhealy/Source/demog/rawdata/DEUTW.Mx_1x1.txt"  ## [13] "/Users/kjhealy/Source/demog/rawdata/DNK.Mx_1x1.txt"    ## [14] "/Users/kjhealy/Source/demog/rawdata/ESP.Mx_1x1.txt"    ## [15] "/Users/kjhealy/Source/demog/rawdata/EST.Mx_1x1.txt"    ## [16] "/Users/kjhealy/Source/demog/rawdata/FIN.Mx_1x1.txt"    ## [17] "/Users/kjhealy/Source/demog/rawdata/FRACNP.Mx_1x1.txt" ## [18] "/Users/kjhealy/Source/demog/rawdata/FRATNP.Mx_1x1.txt" ## [19] "/Users/kjhealy/Source/demog/rawdata/GBR_NIR.Mx_1x1.txt"## [20] "/Users/kjhealy/Source/demog/rawdata/GBR_NP.Mx_1x1.txt" ## [21] "/Users/kjhealy/Source/demog/rawdata/GBR_SCO.Mx_1x1.txt"## [22] "/Users/kjhealy/Source/demog/rawdata/GBRCENW.Mx_1x1.txt"## [23] "/Users/kjhealy/Source/demog/rawdata/GBRTENW.Mx_1x1.txt"## [24] "/Users/kjhealy/Source/demog/rawdata/GRC.Mx_1x1.txt"    ## [25] "/Users/kjhealy/Source/demog/rawdata/HRV.Mx_1x1.txt"    ## [26] "/Users/kjhealy/Source/demog/rawdata/HUN.Mx_1x1.txt"    ## [27] "/Users/kjhealy/Source/demog/rawdata/IRL.Mx_1x1.txt"    ## [28] "/Users/kjhealy/Source/demog/rawdata/ISL.Mx_1x1.txt"    ## [29] "/Users/kjhealy/Source/demog/rawdata/ISR.Mx_1x1.txt"    ## [30] "/Users/kjhealy/Source/demog/rawdata/ITA.Mx_1x1.txt"    ## [31] "/Users/kjhealy/Source/demog/rawdata/JPN.Mx_1x1.txt"    ## [32] "/Users/kjhealy/Source/demog/rawdata/KOR.Mx_1x1.txt"    ## [33] "/Users/kjhealy/Source/demog/rawdata/LTU.Mx_1x1.txt"    ## [34] "/Users/kjhealy/Source/demog/rawdata/LUX.Mx_1x1.txt"    ## [35] "/Users/kjhealy/Source/demog/rawdata/LVA.Mx_1x1.txt"    ## [36] "/Users/kjhealy/Source/demog/rawdata/NLD.Mx_1x1.txt"    ## [37] "/Users/kjhealy/Source/demog/rawdata/NOR.Mx_1x1.txt"    ## [38] "/Users/kjhealy/Source/demog/rawdata/NZL_MA.Mx_1x1.txt" ## [39] "/Users/kjhealy/Source/demog/rawdata/NZL_NM.Mx_1x1.txt" ## [40] "/Users/kjhealy/Source/demog/rawdata/NZL_NP.Mx_1x1.txt" ## [41] "/Users/kjhealy/Source/demog/rawdata/POL.Mx_1x1.txt"    ## [42] "/Users/kjhealy/Source/demog/rawdata/PRT.Mx_1x1.txt"    ## [43] "/Users/kjhealy/Source/demog/rawdata/RUS.Mx_1x1.txt"    ## [44] "/Users/kjhealy/Source/demog/rawdata/SVK.Mx_1x1.txt"    ## [45] "/Users/kjhealy/Source/demog/rawdata/SVN.Mx_1x1.txt"    ## [46] "/Users/kjhealy/Source/demog/rawdata/SWE.Mx_1x1.txt"    ## [47] "/Users/kjhealy/Source/demog/rawdata/TWN.Mx_1x1.txt"    ## [48] "/Users/kjhealy/Source/demog/rawdata/UKR.Mx_1x1.txt"    ## [49] "/Users/kjhealy/Source/demog/rawdata/USA.Mx_1x1.txt"

What does each of these files look like? Let’s take a look at the first one, using read_lines() to show us the top of the file.

read_lines(filenames[1], n_max =5)## [1] "Australia, Death rates (period 1x1), \tLast modified: 26 Sep 2017;  Methods Protocol: v6 (2017)"## [2] ""                                                                                               ## [3] "  Year          Age             Female            Male           Total"                         ## [4] "  1921           0             0.059987        0.076533        0.068444"                        ## [5] "  1921           1             0.012064        0.014339        0.013225"

All the files have a header section like this. When we read the data in we’ll want to ignore that and go straight to the data. But seeing as it’s there, we can make use of it to grab the name of the country. It saves us typing it ourselves. Let’s say we’d also like to have a code-friendly version of those names (i.e., in lower-case with underscores instead of spaces). And finally—while we’re at it—let’s grab those all-caps country codes used in the file names, too. We write three functions:

• get_country_name() grabs the first word or words on the first line of each file, up to the first comma. That’s our country name.
• shorten_name() makes the names lower-case and replaces spaces with underscores, and also shortens “The United States of America” to “USA”.
• make_ccode() wraps a regular expression that finds and extracts the capitalized country codes in the file names.

get_country_name <-function(x){
    read_lines(x, n_max =1)%>%
        str_extract(".+?,")%>%
        str_remove(",")}

shorten_name <-function(x){
    str_replace_all(x," -- "," ")%>%
        str_replace("The United States of America","USA")%>%
        snakecase::to_any_case()}

make_ccode <-function(x){
    str_extract(x,"[:upper:]+((?=\\.))")}

Now we create a tibble of summary information by mapping the functions to the filenames.

countries <- tibble(country = map_chr(filenames, get_country_name),
                        cname = map_chr(country, shorten_name),
                        ccode = map_chr(filenames, make_ccode),
                        path = filenames)

countries

## # A tibble: 49 x 4##    country     cname       ccode path                                      ##                                                        ##  1 Australia   australia   AUS   /Users/kjhealy/Source/demog/rawdata/AUS.M…##  2 Austria     austria     AUT   /Users/kjhealy/Source/demog/rawdata/AUT.M…##  3 Belgium     belgium     BEL   /Users/kjhealy/Source/demog/rawdata/BEL.M…##  4 Bulgaria    bulgaria    BGR   /Users/kjhealy/Source/demog/rawdata/BGR.M…##  5 Belarus     belarus     BLR   /Users/kjhealy/Source/demog/rawdata/BLR.M…##  6 Canada      canada      CAN   /Users/kjhealy/Source/demog/rawdata/CAN.M…##  7 Switzerland switzerland CHE   /Users/kjhealy/Source/demog/rawdata/CHE.M…##  8 Chile       chile       CHL   /Users/kjhealy/Source/demog/rawdata/CHL.M…##  9 Czechia     czechia     CZE   /Users/kjhealy/Source/demog/rawdata/CZE.M…## 10 East Germa… east_germa… DEUTE /Users/kjhealy/Source/demog/rawdata/DEUTE…## # … with 39 more rows

Nice. We could have written each of those operations as anonymous functions directly inside of map_chr(). This would have been more compact. But often it can be useful to break out the steps as shown here, for clarity—especially if map() operations have a tendency to break your brain, as they do mine.

We still haven’t touched the actual data files, of course. But now we can just use this countries table as the basis for reading in, I mean ingesting, everything in the files. We’re going to just add a list column named data to the end of the table and put the data for each country in it. We’ll temporarily unnest it to clean the column names and recode the age variable, then drop the file paths column and nest the data again.

The hard work is done by the map() call. This time we will use ~ formula notation inside map() to write what we want to do. We’re going to feed every filename in path to read_table(), one at a time. We tell read_table() to skip the first two lines of every file it reads, and also tell it that in these files missing data are represented by a . character. Everything read in ends up in a new list column named data.

mortality <- countries %>%
    mutate(data = map(path,~ read_table(., skip =2, na =".")))%>%
    unnest(cols =c(data))%>%
    clean_names()%>%
    mutate(age =as.integer(recode(age,"110+"="110")))%>%
    select(-path)%>%
    nest(data =c(year:total))

mortality


## # A tibble: 49 x 4##    country      cname        ccode           data##                     >##  1 Australia    australia    AUS     [10,434 × 5]##  2 Austria      austria      AUT      [7,881 × 5]##  3 Belgium      belgium      BEL     [19,425 × 5]##  4 Bulgaria     bulgaria     BGR      [7,104 × 5]##  5 Belarus      belarus      BLR      [6,438 × 5]##  6 Canada       canada       CAN     [10,101 × 5]##  7 Switzerland  switzerland  CHE     [15,651 × 5]##  8 Chile        chile        CHL      [1,887 × 5]##  9 Czechia      czechia      CZE      [7,437 × 5]## 10 East Germany east_germany DEUTE    [6,660 × 5]## # … with 39 more rows

And we’re done. Forty nine tables of data smoothly imported and bundled together. Each of the country-level data tables is a row in data that we can take a look at as we like:

mortality %>% 
  filter(country =="Austria")%>% 
  unnest(cols =c(data))## # A tibble: 7,881 x 8##    country cname   ccode  year   age   female     male    total##                        ##  1 Austria austria AUT    1947     0 0.0798   0.0994   0.0899  ##  2 Austria austria AUT    1947     1 0.00657  0.00845  0.00753 ##  3 Austria austria AUT    1947     2 0.00425  0.00469  0.00447 ##  4 Austria austria AUT    1947     3 0.00337  0.00340  0.00339 ##  5 Austria austria AUT    1947     4 0.00235  0.00270  0.00253 ##  6 Austria austria AUT    1947     5 0.00174  0.00195  0.00184 ##  7 Austria austria AUT    1947     6 0.00131  0.00152  0.00142 ##  8 Austria austria AUT    1947     7 0.00132  0.00169  0.00151 ##  9 Austria austria AUT    1947     8 0.00115  0.00149  0.00132 ## 10 Austria austria AUT    1947     9 0.000836 0.000997 0.000918## # … with 7,871 more rows

Now you can get on with the actual analysis.

There isn’t anything especially unusual in the steps shown here. It’s just a pretty common operation that’s worth knowing how to do cleanly. One nice thing about this approach is that it’s immediately applicable to, say, a folder containing the 5-year mortality estimates rather than the 1 year estimates. You don’t have to do anything new, and there’s no mucking around with manually naming files and so on.

No dogs were harmed while making this release

future 1.15.0 is now on CRAN, accompanied by a recent, related update of future.callr 0.5.0. The main update is a change to the Future API:

Although this change does not look much to the world, I’d like to think of this as part of a young person slowly finding themselves. This change in behavior helps us in cases where we create lazy futures upfront;

fs <- lapply(X, future, lazy = TRUE)

Such futures remain dormant until we call value() on them, or, as of this release, when we call resolved() on them. Contrary to value(), resolved() is a non-blocking function that allows us to check in on one or more futures to see if they are resolved or not. So, we can now do:

while (!all(resolved(fs))) {  do_something_else()}

to run that loop until all futures are resolved. Any lazy future that is still dormant will be launched when queried the first time. Previously, we would have had to write specialized code for the lazy=TRUE case to trigger lazy futures to launch. If not, the above loop would have run forever. This change means that the above design pattern works the same regardless of whether we use lazy=TRUE or lazy=FALSE (default). There is now one less thing to worry about when working with futures. Less mental friction should be good.

What else?

The Future API now guarantees that value() relays the “visibility” of a future’s value. For example,

> f <- future(invisible(42))> value(f)> v <- value(f)> v[1] 42

Other than that, I have fixed several non-critical bugs and improved some documentation. See news(package="future") or NEWS for all updates.

What’s next?

• I’ll be talking about futures at rstudio::conf 2020 (San Francisco, CA, USA) at the end of January 2020. Please come and say hi – I am keen to hear your R story.

• I will wrap up the deliverables for the project Future Minimal API: Specification with Backend Conformance Test Suite sponsored by the R Consortium. This project helps to robustify the future ecosystem and validate that all backends fulfill the Future API specification. It also serves to refine the Future API specifications. For example, the above change to resolved() resulted from this project.

• The maintainers of foreach plan to harmonize how foreach() identifies global variables with how the future framework identifies them. The idea is to migrate foreach to use the same approach as future, which relies on the globals package. If you’re curious, you can find out more about this over at the foreach issue tracker. Yeah, the foreach issue tracker is a fairly recent thing – it’s a great addition.

• The progressr package (GitHub only) is a proof-of-concept and a working prototype showing how to signal progress updates when doing parallel processing. It works out of the box with the core Future API and higher-level Future APIs such as future.apply, foreach with doFuture, furrr, and plyr– regardless of what parallel backend is being used. It should also work with all known non-parallel map-reduce frameworks, including baselapply() and purrr. For parallel processing, the “granularity” of progress updates varies with the type of parallel worker used. Right now, you will get live updates for sequential processing, whereas for parallel processing the updates will come in chunks along with the value whenever it is collected for a particular future. I’m working on adding support for “live” progress updates also for some parallel backends including when running on local and remote workers.

Happy futuring!

Links

• future package: CRAN, GitHub
• future.batchtools package: CRAN, GitHub
• future.callr package: CRAN, GitHub
• future.apply package: CRAN, GitHub
• doFuture package: CRAN, GitHub (a foreach adapter)
• progressr package: GitHub
• “So, what happened to the dog?”

At the work recently, I wanted to make some interesting start-up pitch (presentation) ready animated visualization and got some first experience with spatial data (e.g. polygons). I enjoyed working with such a type of data and I wanted to improve on working with them, so I decided to try to visualize something interesting with Bratislava (Slovakia) open-data and OpenStreetMaps. I ended with animated maps of violations on Bratislava streets through the time of 2 and a half years.

Since spatial time series are analyzed in this post, it still sticks with the blog domain and it is time series data mining You can read more about time series forecasting, representations and clustering in my previous blog posts here.

Aaand teaser, what I will create in this blog post:

In this blog post you will learn how to:

• get free city district polygons data from OpenStreetMaps API,
• get free street lines (polygons) coordinates from OpenStreetMaps API,
• visualize polygons and street lines with ggplot2 and ggmap,
• merge spatial data with violation data represented as time series,
• animate spatial data combined with violation time series with gganimate.

Bratislava Open-Data

The ultimate goal is to show where and when are the most dangerous places in the capital of Slovakia – Bratislava. For this task, I will use open-data that cover violations gathered from the city police with locations (city district and street name) and time-stamp.

Firstly, load all the needed packages.

library(data.table)# handling datalibrary(lubridate)# handling timestampslibrary(stringi)# text processinglibrary(osmdata)# OSM data API# library(nominatim) # alternative OSM data APIlibrary(sf)# handling spatial datalibrary(ggplot2)# visualisationslibrary(ggsci)# color palletslibrary(ggmap)# map vislibrary(gganimate)# animationslibrary(magick)# image handling

Then, let’s download the violations data from opendata.bratislava.sk webpage and translate Slovak column names to English.

data_violation_17<-fread("https://opendata.bratislava.sk/dataset/download/852",encoding="Latin-1")data_violation_18<-fread("https://opendata.bratislava.sk/dataset/download/407",encoding="Latin-1")data_violation_19<-fread("https://opendata.bratislava.sk/dataset/download/911",encoding="Latin-1")# colnames to Englishsetnames(data_violation_17,colnames(data_violation_17),c("Date_Time","Group_vio","Type_vio","Street","Place"))setnames(data_violation_18,colnames(data_violation_18),c("Date_Time","Group_vio","Type_vio","Street","Place"))setnames(data_violation_19,colnames(data_violation_19),c("Date_Time","Group_vio","Type_vio","Street","Place"))

Let’s bind all the data together.

data_violation<-rbindlist(list(data_violation_17,data_violation_18,data_violation_19),use.names=T)

Next, I will transform Date_Time to POCIXct format and generate time aggregation features – Year and Month – Year_M.

data_violation[,Date_Time:=dmy_hm(Date_Time)]data_violation[,Date:=date(Date_Time)]# Aggregation featuresdata_violation[,Month:=month(Date_Time)]data_violation[,Year:=year(Date_Time)]data_violation[,Year_M:=Year+Month/100]

Let’s see how many violations have each Place (city district) for whole available period (2017-2019.09):

data_violation[,.N,by=.(Place)]

##                 Place     N##  1:       Stare Mesto 68714##  2:       Karlova Ves 11462##  3:         Petrzalka 17062##  4:          Dubravka  6307##  5:           Ruzinov 21352##  6:           Vajnory  1194##  7:    Pod. Biskupice  1590##  8:           Vrakuna  1262##  9:        Nove Mesto 17964## 10:             Devin   269## 11:              Raca  2390## 12: Devinska Nova Ves  1406## 13:             Lamac  1455## 14:           Jarovce    66## 15:     Zah. Bystrica   928## 16:           Rusovce   753## 17:            Cunovo   569

We can see that Old-town (Stare Mesto) rocks in this statistic..obviously – e.g. lot of tourists. There are also some misunderstand Slavic letters. We should get rid of them – in the blog post there we be lot of handling of these special Slavic (Slovak) symbols.

data_violation[,Place:=stri_trans_general(Place,"Latin-ASCII")]data_violation[.("Eunovo"),on=.(Place),Place:="Cunovo"]data_violation[.("Raea"),on=.(Place),Place:="Raca"]data_violation[.("Vrakuoa"),on=.(Place),Place:="Vrakuna"]data_violation[.("Lamae"),on=.(Place),Place:="Lamac"]

I will extract only types of violations that relate to the bad behavior of people, like harassment, using alcoholic beverages on public space and related things. So, I will not extract traffic violations like bad car parking, etc. For this task, I need to extract codes of violations:

data_violation[,Group_vio_ID:=as.numeric(substr(Group_vio,1,4))]# our codes are: 4836, 5000, 4834, 4700, 4838, 4828, 4839,# 4813, 9803, 4840, 4841, 9809, 3000, 9806, 4900

Polygons of city districts

I want to show a number of crimes per city district and street (so both place information) on a map, so I need to get coordinates of city districts and streets. Let’s get polygons of city districts first using OpenStreetMap API.

poly_sm<-getbb(place_name="Stare Mesto Bratislava",format_out="polygon")poly_nm<-getbb(place_name="Nove Mesto Bratislava",format_out="polygon")poly_ruz<-getbb(place_name="Ruzinov Bratislava",format_out="polygon")poly_raca<-getbb(place_name="Raca Bratislava",format_out="polygon")poly_petr<-getbb(place_name="Petrzalka Bratislava",format_out="polygon")poly_kv<-getbb(place_name="Karlova Ves Bratislava",format_out="polygon")poly_dubr<-getbb(place_name="Dubravka Bratislava",format_out="polygon")poly_vajn<-getbb(place_name="Vajnory Bratislava",format_out="polygon")poly_lamac<-getbb(place_name="Lamac Bratislava",format_out="polygon")poly_vrak<-getbb(place_name="Vrakuna Bratislava",format_out="polygon")poly_pd<-getbb(place_name="Podunajske Biskupice Bratislava",format_out="polygon")poly_jar<-getbb(place_name="Jarovce Bratislava",format_out="polygon")poly_dnv<-getbb(place_name="Devinska Nova Ves Bratislava",format_out="polygon")poly_rus<-getbb(place_name="Rusovce Bratislava",format_out="polygon")poly_zb<-getbb(place_name="Zahorska Bystrica Bratislava",format_out="polygon")poly_devin<-getbb(place_name="Devin Bratislava",format_out="polygon")poly_cun<-getbb(place_name="Cunovo Bratislava",format_out="polygon")

Let’s bind all the districts data of Bratislava.

data_poly_ba<-rbindlist(list(as.data.table(poly_sm)[,Place:="Stare Mesto"],as.data.table(poly_nm[[1]])[,Place:="Nove Mesto"],as.data.table(poly_ruz[[1]])[,Place:="Ruzinov"],as.data.table(poly_raca)[,Place:="Raca"],as.data.table(poly_petr)[,Place:="Petrzalka"],as.data.table(poly_kv[[1]])[,Place:="Karlova Ves"],as.data.table(poly_dubr[[1]])[,Place:="Dubravka"],as.data.table(poly_vajn[[1]])[,Place:="Vajnory"],as.data.table(poly_lamac[[1]])[,Place:="Lamac"],as.data.table(poly_vrak[[1]])[,Place:="Vrakuna"],as.data.table(poly_pd[[1]])[,Place:="Pod. Biskupice"],as.data.table(poly_jar[[1]])[,Place:="Jarovce"],as.data.table(poly_dnv[[1]])[,Place:="Devinska Nova Ves"],as.data.table(poly_rus[[1]])[,Place:="Rusovce"],as.data.table(poly_zb[[1]])[,Place:="Zah. Bystrica"],as.data.table(poly_devin[[1]])[,Place:="Devin"],as.data.table(poly_cun[[1]])[,Place:="Cunovo"]))setnames(data_poly_ba,c("V1","V2"),c("lon","lat"))data_poly_ba[,Place:=factor(Place)]

Let’s visualize simply the districts.

ggplot(data_poly_ba)+geom_polygon(aes(x=lon,y=lat,fill=Place,color=Place))+theme_void()

For animation and visualization purposes, I need to aggregate violations data by districts (Place) and Year+Month columns (Year_M).

data_violation_agg_place<-copy(data_violation[.(c(4836,5000,4834,4700,4838,4828,4839,4813,9803,4840,4841,9809,3000,9806,4900)),on=.(Group_vio_ID),.(N=.N),by=.(Place,Year_M)])

The next step is to merge polygon data with aggregated violation data:

data_places<-merge(data_poly_ba[,.(Place,lon,lat)],data_violation_agg_place[,.(Place,N_violation=N,Year_M)],by="Place",all.y=T,allow.cartesian=T)

Let’s also compute mean coordinates for every district for showing theirs names on a graph.

data_poly_ba_mean_place<-copy(data_poly_ba[,.(lon=mean(lon),lat=mean(lat)),by=.(Place)])

Let’s test visualization of violations on June 2019:

ggplot()+geom_polygon(data=data_places[.(2019.06),on=.(Year_M)],aes(x=lon,y=lat,fill=N_violation,group=Place),color="grey40")+scale_fill_material("grey")+geom_label(data=data_poly_ba_mean_place,aes(x=lon,y=lat,label=Place),color="black",fill="dodgerblue1",alpha=0.65)+theme_void()

Street lines coordinates

The next step is to download street coordinates from OpenStreetMaps.

Firstly, we have to extract unique street names from violation data, and handle Slovak letters and other punctuation for easier matching by street name.

dt_uni_streets<-copy(data_violation[,.(Place=data.table::first(Place)),by=.(Street)])dt_uni_streets[,Street_edit:=gsub(pattern="È",replacement="C",x=Street)]dt_uni_streets[,Street_edit:=gsub(pattern="ò",replacement="n",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="è",replacement="c",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="\u009d",replacement="t",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="¾",replacement="l",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="¼",replacement="L",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="ò",replacement="n",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="_",replacement="",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="ï",replacement="d",x=Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="à",replacement="r",x=Street_edit)]dt_uni_streets[,Street_edit:=stri_trans_general(Street_edit,"Latin-ASCII")]dt_uni_streets[,Street_edit:=sub(" - MC.*","",Street_edit)]dt_uni_streets[,Street_edit:=gsub(pattern="Nam.",replacement="Namestie ",x=Street_edit)]dt_uni_streets[,Street_query:=gsub(pattern=" ",replacement="+",x=Street_edit)]dt_uni_streets[,Street_query:=paste0(Street_query,"+Bratislava")]

Let’s get all streets coordinates of Bratislava just by one (powerful) command, again using OSM API:

ba_bb<-getbb(place_name="Bratislava")bratislava<-opq(bbox=ba_bb)%>%add_osm_feature(key='highway')%>%osmdata_sf()%>%osm_poly2line()

Let’s plot it:

ggplot(data=bratislava$osm_lines)+geom_sf()+theme_bw()

Pretty nice web.

Now, we need to handle again street names downloaded from OSM. I will extract only available streets from violation data:

street_names<-data.table(Street=unique(bratislava$osm_lines$name))street_names[,Street_edit:=gsub(pattern="Ã",replacement="i",x=Street)]street_names[,Street_edit:=gsub(pattern="i©",replacement="e",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="i¡",replacement="a",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="iº",replacement="u",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="ž",replacement="z",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="ľ",replacement="l",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Ä\u008d",replacement="c",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Å¡",replacement="s",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Ľ",replacement="L",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="ň",replacement="n",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="i½",replacement="y",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Å•",replacement="r",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="i³",replacement="o",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="i¤",replacement="a",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Ž",replacement="Z",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Å ",replacement="S",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Å¥",replacement="t",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="ÄŒ",replacement="C",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Ä\u008f",replacement="d",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="i¶",replacement="o",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Å‘",replacement="o",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Ä›",replacement="e",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="Ä›",replacement="e",x=Street_edit)]street_names[,Street_edit:=stri_trans_general(Street_edit,"Latin-ASCII")]street_names[,Street_edit:=gsub(pattern="i-",replacement="i",x=Street_edit)]street_names[,Street_edit:=gsub(pattern="A ",replacement="S",x=Street_edit)]street_names[dt_uni_streets,on=.(Street_edit)]street_names_vio<-copy(street_names[dt_uni_streets,on=.(Street_edit),Street_orig:=i.Street])[!is.na(Street_orig)]

We lost some street data from the dataset by not exact matched street names.

Let’s subset the street data.

ba_streets_vio<-bratislava$osm_linesba_streets_vio<-ba_streets_vio[ba_streets_vio$name%in%street_names_vio$Street,]ba_streets_vio<-ba_streets_vio[!is.na(ba_streets_vio$name),]

Now, I will transform data to standard lon/lat matrix (data.table class) format instead of sf object (I highly recommend this for next ggplot usage).

data_streets_st<-data.table::data.table(sf::st_coordinates(ba_streets_vio$geometry))

Next, I will bound streets by existing polygons of Bratislava and add merging column – Street_edit:

ba_streets_vio$L1<-1:nrow(ba_streets_vio)data_streets_st<-merge(data_streets_st,as.data.table(ba_streets_vio)[,.(L1,name)],by="L1")data_streets_st[street_names_vio[,.(name,Street_edit)],on=.(name),Street_edit:=i.Street_edit]setnames(data_streets_st,c("X","Y"),c("lon","lat"))data_streets_st<-data_streets_st[!lon>data_poly_ba[,max(lon)]]data_streets_st<-data_streets_st[!lon<data_poly_ba[,min(lon)]]data_streets_st<-data_streets_st[!lat>data_poly_ba[,max(lat)]]

Let’s also aggregate violation data by street names and Year + Month (Year_M):

data_violation_agg_street<-copy(data_violation[.(c(4836,5000,4834,4700,4838,4828,4839,4813,9803,4840,4841,9809,3000,9806,4900)),on=.(Group_vio_ID),.(N=.N),by=.(Street,Year_M)])setorder(data_violation_agg_street,Year_M,-N)

Let’s add look-up column Street_edit to aggregated data and merge spatial street data with violation data.

data_violation_agg_street[dt_uni_streets,on=.(Street),Street_edit:=i.Street_edit]data_streets_st<-merge(data_streets_st,data_violation_agg_street[,.(Street_edit,N_violations=N,Year_M)],by="Street_edit",all.y=T,allow.cartesian=TRUE)

Now, I will transform integers of the number of violations to reasonable factors segments:

data_streets_st[N_violations>=11,N_violation_type:="> 11"]data_streets_st[N_violations>=6&N_violations<11,N_violation_type:="(6, 10)"]data_streets_st[N_violations>=3&N_violations<6,N_violation_type:="(3, 5)"]data_streets_st[N_violations<=2,N_violation_type:="< 2"]data_streets_st[,N_violations_per_street:=factor(N_violation_type,levels=c("< 2","(3, 5)","(6, 10)","> 11"))]

levels(data_streets_st$N_violations_per_street)

## [1] "< 2"     "(3, 5)"  "(6, 10)" "> 11"

Let’s see what we extracted so far for streets in one example year-month…

ggplot(data_streets_st[!is.na(L1)][.(2019.06),on=.(Year_M)])+geom_line(aes(lon,lat,group=L1,color=N_violations_per_street),size=1.4)+scale_color_brewer(palette="Reds")+theme_bw()

ggmap

Since, we will use ggmap for visualizations, we need to extract map image of Bratislava:

bbox<-make_bbox(lon,lat,data=data_poly_ba,f=.01)# used our polygonsmap_ba<-get_map(location=bbox,source='stamen',maptype="watercolor")

Now, let’s make it altogether to one visualization – so violations by city districts and also streets for one time-stamp (Year_M).

ggmap(map_ba,extent="device")+geom_polygon(data=data_places[.(2019.06),on=.(Year_M)],aes(x=lon,y=lat,fill=N_violation,group=Place),color="grey40")+scale_fill_material("grey",alpha=0.75)+geom_line(data=data_streets_st[!is.na(L1)][.(2019.06),on=.(Year_M)],aes(lon,lat,group=L1,color=N_violations_per_street),size=1.4)+scale_color_brewer(palette="Reds")+geom_label(data=data_poly_ba_mean_place,aes(x=lon,y=lat,label=Place,fill=NA_real_),color="black",fill="dodgerblue1",alpha=0.75)+labs(fill="N_vio_district",color="N_vio_street")+guides(color=guide_legend(override.aes=list(size=2)))+theme_void()

I will also extract the most violated streets by Year+Month for labeling purposes.

data_streets_st_max<-copy(data_streets_st[!is.na(L1),.SD[N_violations==max(N_violations,na.rm=T)],by=.(Year_M)])data_streets_st_max[,unique(Street_edit)]# the unique month "winners"data_streets_st_max<-copy(data_streets_st_max[,.(lon=mean(lon),lat=mean(lat),Street_edit=first(Street_edit),N_violations=first(N_violations),N_violations_per_street=first(N_violations_per_street)),by=.(Year_M)])

As we noticed so far, the most violated city district is Old-town, so I will create also zoomed visualization for this city district like this (using coord_map function):

ggmap(map_ba)+geom_polygon(data=data_places[.(2019.06),on=.(Year_M)],aes(x=lon,y=lat,fill=N_violation,group=Place),color="grey40")+scale_fill_material("grey",alpha=0.75)+geom_line(data=data_streets_st[!is.na(L1)][.(2019.06),on=.(Year_M)],aes(lon,lat,group=L1,color=N_violations_per_street),size=1.4)+geom_label(data=data_streets_st_max[.(2019.06),on=.(Year_M)],aes(x=lon,y=lat,label=paste0(Street_edit," - ",N_violations)),color="black",fill="firebrick2",size=4.5,alpha=0.75)+scale_color_brewer(palette="Reds")+geom_label(data=data_poly_ba_mean_place,aes(x=lon,y=lat,label=Place,fill=NA_real_),color="black",fill="dodgerblue1",alpha=0.75,size=4.5)+coord_map(xlim=c(data_poly_ba[.("Stare Mesto"),on=.(Place),min(lon)],data_poly_ba[.("Stare Mesto"),on=.(Place),max(lon)]),ylim=c(data_poly_ba[.("Stare Mesto"),on=.(Place),min(lat)],data_poly_ba[.("Stare Mesto"),on=.(Place),max(lat)]))+labs(fill="N_vio_district",color="N_vio_street")+guides(color=guide_legend(ncol=1,override.aes=list(size=2),title.position="top"),fill=guide_legend(nrow=2,title.position="top"))+theme_bw()+theme(axis.text=element_blank(),axis.line=element_blank(),axis.title=element_blank(),axis.ticks=element_blank(),legend.text=element_text(size=13),legend.title=element_text(size=14,face="bold"),legend.background=element_rect(fill="white"),legend.key=element_rect(fill="white"),legend.position="bottom")

Using ggnanimate

We have all prepared to create some interesting animated map. For this purpose, I will use the gganimate package that simply uses the transition_states function that combines our previously prepared ggplot2 and ggmap plot and time feature Year_M. Let’s firstly animate the whole city picture.

gg_ba_anim_lines<-ggmap(map_ba,extent="device")+geom_polygon(data=data_places,aes(x=lon,y=lat,fill=N_violation,group=Place),color="grey40")+scale_fill_material("grey",alpha=0.7)+geom_line(data=data_streets_st[!is.na(L1)],aes(lon,lat,group=L1,color=N_violations_per_street),size=1.4)+scale_color_brewer(palette="Reds")+labs(fill="N_vio_district",color="N_vio_street")+geom_label(data=data_poly_ba_mean_place,aes(x=lon,y=lat,label=Place,fill=NA_real_),color="black",fill="dodgerblue1",alpha=0.75,size=4.5)+transition_states(reorder(Year_M,Year_M),transition_length=2,state_length=1)+labs(title="Year.Month - {closest_state}")+guides(color=FALSE,fill=FALSE)+theme_void()+theme(plot.title=element_text(size=16,face="bold"))# save animation to objectanim_whole<-animate(gg_ba_anim_lines,duration=46,width=700,height=750)

Then, let’s animate zoomed map of Old-town district.

gg_ba_anim_lines_zoom<-ggmap(map_ba,extent="device")+geom_polygon(data=data_places,aes(x=lon,y=lat,fill=N_violation,group=Place),color="grey40")+scale_fill_material("grey",alpha=0.7)+geom_line(data=data_streets_st[!is.na(L1)],aes(lon,lat,group=L1,color=N_violations_per_street),size=1.4)+scale_color_brewer(palette="Reds")+geom_label(data=data_streets_st_max,aes(x=lon,y=lat,label=paste0(Street_edit," - ",N_violations)),color="black",fill="firebrick2",alpha=0.75,size=4.5)+geom_label(data=data_poly_ba_mean_place,aes(x=lon,y=lat,label=Place,fill=NA_real_),color="black",fill="dodgerblue1",alpha=0.75,size=4.5)+coord_map(xlim=c(data_poly_ba[.("Stare Mesto"),on=.(Place),min(lon)],data_poly_ba[.("Stare Mesto"),on=.(Place),max(lon)]),ylim=c(data_poly_ba[.("Stare Mesto"),on=.(Place),min(lat)],data_poly_ba[.("Stare Mesto"),on=.(Place),max(lat)]))+transition_states(reorder(Year_M,Year_M),transition_length=2,state_length=1)+labs(fill="N_vio_district",color="N_vio_street")+guides(color=guide_legend(ncol=1,override.aes=list(size=2),title.position="top"),fill=guide_legend(nrow=2,title.position="top"))+theme_bw()+theme(axis.text=element_blank(),axis.line=element_blank(),axis.title=element_blank(),axis.ticks=element_blank(),legend.text=element_text(size=13),legend.title=element_text(size=14,face="bold"),legend.background=element_rect(fill="white"),legend.key=element_rect(fill="white"),legend.position="bottom")# save animation to objectanim_zoom<-animate(gg_ba_anim_lines_zoom,duration=46,width=700,height=750)