2020-01-05 17:22:09 +01:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2020 Berends MS, Luz CF et al. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
2019-12-16 11:08:25 +01:00
# Read and format data ----------------------------------------------------
library ( tidyverse )
library ( maps )
2020-01-05 17:22:09 +01:00
library ( httr )
GET_df <- function ( ip ) {
ip <- paste0 ( " https://ipinfo.io/" , ip , " ?token=089aa7765ee912" )
result <- ip %>% GET ( )
stop_for_status ( result )
result %>%
content ( type = " text" , encoding = " UTF-8" ) %>%
jsonlite :: fromJSON ( flatten = TRUE ) %>%
as_tibble ( )
}
2019-12-16 11:08:25 +01:00
# get website analytics
source ( " data-raw/country_analysis_url_token.R" )
url_json <- paste0 ( country_analysis_url ,
" /index.php?&module=API&token_auth=" ,
country_analysis_token ,
" &method=Live.getLastVisitsDetails&idSite=3&language=en&expanded=1&date=2018-01-01,2028-01-01&period=range&filter_limit=-1&format=JSON&segment=&translateColumnNames=1" )
data_json <- jsonlite :: read_json ( url_json )
data <- tibble (
timestamp_server = as.POSIXct ( sapply ( data_json , function ( x ) x $ serverTimestamp ) , origin = " 1970-01-01" ) ,
2020-01-05 17:22:09 +01:00
ipaddress = sapply ( data_json , function ( x ) x $ visitIp ) )
2019-12-20 15:05:58 +01:00
rm ( data_json )
2020-01-05 17:22:09 +01:00
# add country data based on IP address and ipinfo.io API
unique_ip <- unique ( data $ ipaddress )
ip_tbl <- GET_df ( unique_ip [1 ] )
p <- progress_estimated ( n = length ( unique_ip ) - 1 , min_time = 0 )
for ( i in 2 : length ( unique_ip ) ) {
p $ tick ( ) $ print ( )
ip_tbl <- ip_tbl %>%
bind_rows ( GET_df ( unique_ip [i ] ) )
}
2019-12-20 15:05:58 +01:00
2020-01-05 17:22:09 +01:00
# how many?
n_distinct ( ip_tbl $ country )
2019-12-16 11:08:25 +01:00
2020-01-05 17:22:09 +01:00
# add long and lat
ip_tbl <- ip_tbl %>%
separate ( loc , into = c ( " y" , " x" ) , sep = " ," , remove = FALSE , convert = TRUE )
2019-12-16 11:08:25 +01:00
# Plot world map ----------------------------------------------------------
2020-01-05 17:22:09 +01:00
countries_geometry <- sf :: st_as_sf ( map ( ' world' , plot = FALSE , fill = TRUE ) ) %>%
mutate ( countries_code = countrycode :: countrycode ( ID ,
origin = ' country.name' ,
destination = ' iso2c' ,
custom_match = c ( " Ascension Island" = " GB" , # Great Britain
" Azores" = " PT" , # Portugal
" Barbuda" = " GB" , # Great Britain
" Bonaire" = " BQ" , # Bonaire, Saint Eustatius and Saba
" Canary Islands" = " ES" , # Spain
" Chagos Archipelago" = " MU" , # Mauritius
" Grenadines" = " VC" , # Saint Vincent and the Grenadines
" Heard Island" = " AU" , # Australia
" Kosovo" = " XK" ,
" Madeira Islands" = " PT" , # Portugal
" Micronesia" = " FM" ,
" Saba" = " BQ" , # Bonaire, Saint Eustatius and Saba
" Saint Martin" = " MF" ,
" Siachen Glacier" = " IN" , # India
" Sint Eustatius" = " BQ" # Bonaire, Saint Eustatius and Saba
) ) ,
included = as.integer ( countries_code %in% ip_tbl $ country ) ,
not_antarctica = as.integer ( ID != " Antarctica" ) ,
countries_name = ifelse ( included == 1 , ID , NA ) )
countries_plot <- ggplot ( countries_geometry ) +
geom_sf ( aes ( fill = included , colour = not_antarctica ) ,
size = 0.25 ,
show.legend = FALSE ) +
2019-12-16 11:08:25 +01:00
theme_minimal ( ) +
2020-01-05 17:22:09 +01:00
theme ( panel.grid = element_blank ( ) ,
2019-12-16 11:08:25 +01:00
axis.title = element_blank ( ) ,
axis.text = element_blank ( ) ) +
2020-01-05 17:22:09 +01:00
scale_fill_gradient ( low = " white" , high = " #CAD6EA" , ) +
2019-12-16 11:08:25 +01:00
# this makes the border Antarctica turn white (invisible):
2019-12-20 15:05:58 +01:00
scale_colour_gradient ( low = " white" , high = " #81899B" )
2019-12-20 21:06:39 +01:00
countries_plot_mini <- countries_plot
countries_plot_mini $ data <- countries_plot_mini $ data %>% filter ( ID != " Antarctica" )
countries_plot_mini <- countries_plot_mini + scale_colour_gradient ( low = " #81899B" , high = " #81899B" )
countries_plot_big <- countries_plot +
labs ( title = tools :: toTitleCase ( " Countries where the AMR package for R was downloaded from" ) ,
2020-01-05 17:22:09 +01:00
subtitle = paste0 ( " Between March 2018 (first release) and " , format ( Sys.Date ( ) , " %B %Y" ) , " . The dots denote visitors on our website https://gitlab.io/msberends/AMR." ) ) +
2019-12-20 21:06:39 +01:00
theme ( plot.title = element_text ( size = 16 , hjust = 0.5 ) ,
plot.subtitle = element_text ( size = 12 , hjust = 0.5 ) ) +
geom_text ( aes ( x = -170 ,
y = -70 ,
label = stringr :: str_wrap ( paste0 ( " Countries (n = " ,
2020-01-05 17:22:09 +01:00
length ( countries_name [ ! is.na ( countries_name ) ] ) , " ): " ,
paste ( countries_name [ ! is.na ( countries_name ) ] , collapse = " , " ) ) ,
2019-12-20 21:06:39 +01:00
200 ) ) ,
hjust = 0 ,
2020-01-05 17:22:09 +01:00
size = 4 ) +
# points of visitors
geom_point ( data = ip_tbl ,
aes ( x = x , y = y ) ,
size = 1 ,
colour = " #81899B" )
2019-12-20 15:05:58 +01:00
# main website page
ggsave ( " pkgdown/logos/countries.png" ,
width = 6 ,
2019-12-20 21:06:39 +01:00
height = 2.5 ,
2019-12-20 15:05:58 +01:00
units = " in" ,
dpi = 100 ,
2019-12-20 21:06:39 +01:00
plot = countries_plot_mini ,
2019-12-20 15:05:58 +01:00
scale = 1 )
# when clicked - a high res enlargement
ggsave ( " pkgdown/logos/countries_large.png" ,
width = 11 ,
height = 6 ,
units = " in" ,
dpi = 300 ,
2019-12-20 21:06:39 +01:00
plot = countries_plot_big ,
2019-12-20 15:05:58 +01:00
scale = 1.5 )
2019-12-16 11:08:25 +01:00
# Gibberish ---------------------------------------------------------------
2020-01-05 17:22:09 +01:00
#
# p1 <- data %>%
# group_by(country) %>%
# summarise(first = min(timestamp_server)) %>%
# arrange(first) %>%
# mutate(n = row_number()) %>%
# ggplot(aes(x = first, y = n)) +
# geom_line() +
# geom_point(aes(x = max(first), y = max(n)), size = 3) +
# scale_x_datetime(date_breaks = "2 months", date_labels = "%B %Y") +
# labs(x = NULL, y = "Number of countries")
#
# package_releases <- read_html("https://cran.r-project.org/src/contrib/Archive/AMR/") %>%
# rvest::html_table() %>%
# .[[1]] %>%
# as_tibble(.name_repair = "unique") %>%
# filter(`Last modified` != "") %>%
# transmute(version = gsub("[^0-9.]", "",
# gsub(".tar.gz", "", Name)),
# datetime = as.POSIXct(`Last modified`)) %>%
# # add current
# bind_rows(tibble(version = as.character(packageVersion("AMR")),
# datetime = as.POSIXct(packageDate("AMR")))) %>%
# # remove the ones not plottable
# filter(datetime > min(p1$data$first))
#
# p1 + geom_linerange(data = package_releases, aes(x = datetime, ymin = 0, ymax = 80), colour = "red", inherit.aes = FALSE)
#