Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

no binding notes left #167

Merged
merged 1 commit into from
Feb 5, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 27 additions & 8 deletions R/check_nuts2013.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,26 @@
check_nuts2013 <- function (dat) {

## For non-standard evaluation -------------------------------------
change <- geo <- code13 <- code16 <- NULL
. <- change <- geo <- code13 <- code16 <- nuts_level <- NULL
regional_changes_2016 <- NULL

## The data is not loaded into the global environment --------------
.myDataEnv <- new.env(parent=emptyenv()) # the local environment

getData <- function(dataset) {
isLoaded <- function(dataset) {
exists(x = dataset, envir = .myDataEnv)
}
if (!isLoaded(dataset)) {
if ( dataset == "regional_changes_2016")
data(regional_changes_2016, envir=.myDataEnv)
} else if ( dataset == "nuts_correspondence") {
data(nuts_correspondence, envir=.myDataEnv)
}
.myDataEnv[[dataset]]
}

getData(dataset = "regional_changes_2016")

unchanged_regions <- regional_changes_2016 %>%
filter ( change == 'unchanged')
Expand All @@ -33,17 +52,16 @@ check_nuts2013 <- function (dat) {
## Changed regions to be looked up by their NUTS2016 codes -----------
regional_changes_by_2016 <- regional_changes_2016 %>%
mutate ( geo = code16 ) %>%
filter ( !is.na(code13))

nrow(regional_changes_by_2016)
filter ( !is.na(code13) )

## adding those that have no equivalent in the previous group
## some regions have to be identified by their old and new codes -----
regional_changes_by_2013 <- regional_changes_2016 %>%
mutate ( geo = code13 ) %>%
filter ( !is.na(code13)) %>%
filter ( !is.na(code13) ) %>%
anti_join ( regional_changes_by_2016,
by = c("code13", "code16", "name", "nuts_level", "change", "geo"))
by = c("code13", "code16", "name",
"nuts_level", "change", "geo") )

## Region can be found by new or old NUTS code -----------------------

Expand Down Expand Up @@ -82,12 +100,13 @@ check_nuts2013 <- function (dat) {

eu_country_vector <- eurostat::eu_countries$code
tmp_country_vector <- unique ( substr(tmp$geo, 1, 2) )
not_EU_country_vector <- tmp_country_vector [! tmp_country_vector %in% eu_country_vector]
not_EU_country_vector <- tmp_country_vector [! tmp_country_vector %in%
eu_country_vector]

if ( length(not_EU_country_vector) > 0 ) {
## The correspondence table only covers EU regions.
message ( "Not checking for regional label consistency in non-EU countries\n",
"In this data frame: ", not_EU_country_vector )
"In this data frame non-EU country: ", not_EU_country_vector )
}

tmp
Expand Down
23 changes: 22 additions & 1 deletion R/convert_to_nuts2016.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@
#' If not called before, the function will use the helper function
#' \code{\link{check_nuts2013}} and \code{\link{harmonize_geo_code}}
#' @importFrom dplyr mutate filter rename arrange case_when
#' @importFrom dplyr left_join inner_join anti_join
#' @importFrom dplyr left_join inner_join anti_join right_join semi_join
#' @importFrom tidyselect all_of
#' @examples
#' \dontrun{
Expand All @@ -34,6 +34,27 @@

convert_to_nuts2016 <- function (dat) {

. <- nuts_level <- geo <- code13 <- code16 <- time <- name <- NULL
type <- nuts_correspondence <- regional_changes_2016 <- NULL

.myDataEnv <- new.env(parent=emptyenv()) # the local environment

getData <- function(dataset) {
isLoaded <- function(dataset) {
exists(x = dataset, envir = .myDataEnv)
}
if (!isLoaded(dataset)) {
if ( dataset == "regional_changes_2016")
data(regional_changes_2016, envir=.myDataEnv)
} else if ( dataset == "nuts_correspondence") {
data(nuts_correspondence, envir=.myDataEnv)
}
.myDataEnv[[dataset]]
}

getData(dataset = "regional_changes_2016")
getData(dataset = "nuts_correspondence")

if ( ! all(c("change", "code16", "code13") %in% names (dat)) ) {
tmp <- harmonize_geo_code(dat)
} else {
Expand Down
29 changes: 25 additions & 4 deletions R/harmonize_geo_code.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@
#' If not called before, the function will use the helper function
#' \code{\link{check_nuts2013}}
#' @importFrom dplyr mutate filter rename arrange add_count
#' @importFrom dplyr left_join full_join anti_join
#' @importFrom dplyr left_join full_join anti_join right_join semi_join
#' @importFrom tidyselect all_of
#' @importFrom stringr str_sub
#' @examples
Expand All @@ -33,12 +33,33 @@ harmonize_geo_code <- function ( dat ) {

## For non-standard evaluation -------------------------------------
change <- tmp <- geo <- nuts_level <- code13 <- code16 <- NULL
remaining_eu_data <- resolution <- NULL
. <- n <- remaining_eu_data <- resolution <- time <- values <- NULL
regional_changes_2016 <- NULL

## Check if geo information is present ------------------------------
if ( ! 'geo' %in% names(dat) ) {
stop ("There is no 'geo' column in the inserted data. This is an error.") }
stop ("There is no 'geo' column in the inserted data. This is an error.")
}

## Load the correspondence tables, but not to the global environment --

.myDataEnv <- new.env(parent=emptyenv()) # the local environment

getData <- function(dataset) {
isLoaded <- function(dataset) {
exists(x = dataset, envir = .myDataEnv)
}
if ( !isLoaded(dataset) ) {
if ( dataset == "regional_changes_2016" )
data(regional_changes_2016, envir=.myDataEnv)
} else if ( dataset == "nuts_correspondence" ) {
data(nuts_correspondence, envir=.myDataEnv)
.myDataEnv[[dataset]]
}
}

getData(dataset = "regional_changes_2016")

unchanged_regions <- regional_changes_2016 %>%
filter ( change == 'unchanged' )

Expand Down Expand Up @@ -125,7 +146,7 @@ harmonize_geo_code <- function ( dat ) {
full_join ( cannot_be_found, by = all_of(names ( cannot_be_found )) )

if ( nrow ( eu_joined %>%
semi_join ( labelled_by_other,
dplyr::semi_join ( labelled_by_other,
by = all_of(names (eu_joined))) ) > 0 ) {
stop ( "Joining error between EU and non-EU regions")
}
Expand Down