├── .dockerignore ├── .github ├── .gitignore └── workflows │ └── pkgdown.yaml ├── .gitignore ├── DESCRIPTION ├── Dockerfile ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── app_config.R ├── app_server.R ├── app_ui.R ├── data.R ├── ll_bbox.R ├── ll_create_folders.R ├── ll_export_sf_to_kml.R ├── ll_find_file.R ├── ll_find_pop_centre.R ├── ll_get_adm_ocha.R ├── ll_get_electoral_districts_it.R ├── ll_get_lau_eu.R ├── ll_get_lau_nuts_concordance.R ├── ll_get_lau_pt.R ├── ll_get_nuts.R ├── ll_get_nuts_eu.R ├── ll_get_nuts_it.R ├── ll_get_population_grid.R ├── ll_get_population_grid_high_resolution.R ├── ll_get_us.R ├── ll_get_world.R ├── ll_match_geo.R ├── ll_osm.R ├── ll_osm_download.R ├── ll_set_folder.R ├── mod_file_input.R ├── run_app.R └── utils-pipe.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── data-raw ├── ll_codes.R ├── ll_lau_nuts_concordance_links.R ├── ll_lau_pt_id.R ├── ll_osm_bboxes.R ├── ll_osm_countries.R ├── ll_osm_it_gpkg.R ├── ocha_administrative_boundaries_links.R └── population_grid_hr_links.R ├── data ├── ll_administrative_boundaries_ocha_metadata.rda ├── ll_codes.rda ├── ll_lau_nuts_concordance_links.rda ├── ll_lau_pt_id.rda ├── ll_osm_bboxes.rda ├── ll_osm_countries.rda ├── ll_osm_it_gpkg.rda └── population_grid_hr_metadata.rda ├── inst ├── app │ └── www │ │ └── img │ │ └── edjnet_logo_full.svg └── golem-config.yml ├── latlon2map.Rproj ├── man ├── ll_app.Rd ├── ll_bbox.Rd ├── ll_create_folders.Rd ├── ll_export_sf_to_kml.Rd ├── ll_find_file.Rd ├── ll_find_pop_centre.Rd ├── ll_get_adm_ocha.Rd ├── ll_get_electoral_districts_it.Rd ├── ll_get_gadm.Rd ├── ll_get_lau_eu.Rd ├── ll_get_lau_nuts_concordance.Rd ├── ll_get_lau_pt.Rd ├── ll_get_nuts_eu.Rd ├── ll_get_nuts_it.Rd ├── ll_get_nuts_us.Rd ├── ll_get_population_grid.Rd ├── ll_get_population_grid_hr.Rd ├── ll_get_world.Rd ├── ll_match.Rd ├── ll_osm_countries.Rd ├── ll_osm_download.Rd ├── ll_osm_download_it.Rd ├── ll_osm_extract_it.Rd ├── ll_osm_extract_roads.Rd ├── ll_osm_get_lau_streets.Rd ├── ll_osm_get_nuts_streets.Rd ├── ll_osm_get_roads.Rd ├── ll_osm_it_gpkg.Rd ├── ll_set_folder.Rd ├── pipe.Rd └── population_grid_hr_metadata.Rd └── vignettes ├── .gitignore ├── figure ├── bologna_lau_hr-1.png ├── it_nuts2_hr-1.png ├── it_nuts2_lr-1.png ├── pop_weighted_centre_palmanova-1.png ├── pop_weighted_centre_palmanova_hr-1.png ├── sweden_be_4_3-1.png ├── sweden_bw_thin-1.png ├── uk_lau-1.png └── viewnna_pop_grid-1.png ├── removing_the_boring.Rmd └── removing_the_boring.Rmd.orig /.dockerignore: -------------------------------------------------------------------------------- 1 | .RData 2 | .Rhistory 3 | .git 4 | .gitignore 5 | manifest.json 6 | rsconnect/ 7 | Rproj.user 8 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .Rbuildignore 6 | inst/doc 7 | ll_data 8 | docs 9 | example.rds 10 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: latlon2map 2 | Title: Facilitates matching lat/lon data with administrative units and other geographic shapes 3 | Version: 0.0.0.9008 4 | Authors@R: 5 | person(given = "Giorgio", 6 | family = "Comai", 7 | role = c("aut", "cre"), 8 | email = "g@giorgiocomai.eu") 9 | Description: Facilitates matching lat/lon data with administrative units and other geographic shapes 10 | License: GPL-3 11 | Imports: 12 | config, 13 | golem, 14 | shiny, 15 | attempt, 16 | DT, 17 | glue, 18 | htmltools, 19 | readr, 20 | fs, 21 | magrittr, 22 | sf, 23 | tibble, 24 | ggplot2, 25 | dplyr, 26 | htmlwidgets, 27 | xml2, 28 | purrr, 29 | countrycode, 30 | cli 31 | Encoding: UTF-8 32 | LazyData: true 33 | RoxygenNote: 7.2.3 34 | Suggests: 35 | leaflet, 36 | knitr, 37 | rmarkdown 38 | VignetteBuilder: knitr 39 | Roxygen: list(markdown = TRUE) 40 | Depends: 41 | R (>= 2.10) 42 | URL: https://giocomai.github.io/latlon2map/ 43 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM rocker/r-ver:4.0.5 2 | RUN apt-get update && apt-get install -y gdal-bin git-core libcurl4-openssl-dev libgdal-dev libgeos-dev libgeos++-dev libgit2-dev libicu-dev libpng-dev libproj-dev libssl-dev libudunits2-dev libxml2-dev make pandoc pandoc-citeproc && rm -rf /var/lib/apt/lists/* 3 | RUN echo "options(repos = c(CRAN = 'https://cran.rstudio.com/'), download.file.method = 'libcurl', Ncpus = 4)" >> /usr/local/lib/R/etc/Rprofile.site 4 | RUN R -e 'install.packages("remotes")' 5 | RUN Rscript -e 'remotes::install_version("magrittr",upgrade="never", version = "2.0.1")' 6 | RUN Rscript -e 'remotes::install_version("glue",upgrade="never", version = "1.4.2")' 7 | RUN Rscript -e 'remotes::install_version("tibble",upgrade="never", version = "3.1.2")' 8 | RUN Rscript -e 'remotes::install_version("ggplot2",upgrade="never", version = "3.3.3")' 9 | RUN Rscript -e 'remotes::install_version("purrr",upgrade="never", version = "0.3.4")' 10 | RUN Rscript -e 'remotes::install_version("htmltools",upgrade="never", version = "0.5.1.1")' 11 | RUN Rscript -e 'remotes::install_version("fs",upgrade="never", version = "1.5.0")' 12 | RUN Rscript -e 'remotes::install_version("xml2",upgrade="never", version = "1.3.2")' 13 | RUN Rscript -e 'remotes::install_version("knitr",upgrade="never", version = "1.33")' 14 | RUN Rscript -e 'remotes::install_version("attempt",upgrade="never", version = "0.3.1")' 15 | RUN Rscript -e 'remotes::install_version("htmlwidgets",upgrade="never", version = "1.5.3")' 16 | RUN Rscript -e 'remotes::install_version("shiny",upgrade="never", version = "1.6.0")' 17 | RUN Rscript -e 'remotes::install_version("config",upgrade="never", version = "0.3.1")' 18 | RUN Rscript -e 'remotes::install_version("rmarkdown",upgrade="never", version = "2.8")' 19 | RUN Rscript -e 'remotes::install_version("leaflet",upgrade="never", version = "2.0.4.1")' 20 | RUN Rscript -e 'remotes::install_version("dplyr",upgrade="never", version = "1.0.6")' 21 | RUN Rscript -e 'remotes::install_version("sf",upgrade="never", version = "0.9-8")' 22 | RUN Rscript -e 'remotes::install_version("readr",upgrade="never", version = "1.4.0")' 23 | RUN Rscript -e 'remotes::install_version("DT",upgrade="never", version = "0.18")' 24 | RUN Rscript -e 'remotes::install_version("golem",upgrade="never", version = "0.3.1")' 25 | RUN Rscript -e 'remotes::install_version(package = "writexl")' 26 | RUN Rscript -e 'remotes::install_version(package = "readODS")' 27 | RUN Rscript -e 'remotes::install_version(package = "readxl")' 28 | RUN Rscript -e 'remotes::install_version(package = "leaflet")' 29 | 30 | RUN mkdir /build_zone 31 | ADD . /build_zone 32 | WORKDIR /build_zone 33 | RUN R -e 'remotes::install_local(upgrade="never")' 34 | RUN rm -rf /build_zone 35 | EXPOSE 3838 36 | CMD ["R", "-e", "options('shiny.port'=3838,shiny.host='0.0.0.0');latlon2map::ll_app(max_file_size = 500, ll_folder_path = '/ll_data')"] 37 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(ll_app) 5 | export(ll_bbox) 6 | export(ll_create_folders) 7 | export(ll_export_sf_to_kml) 8 | export(ll_find_file) 9 | export(ll_find_pop_centre) 10 | export(ll_get_adm_ocha) 11 | export(ll_get_electoral_districts_it) 12 | export(ll_get_gadm) 13 | export(ll_get_lau_eu) 14 | export(ll_get_lau_nuts_concordance) 15 | export(ll_get_lau_pt) 16 | export(ll_get_nuts_eu) 17 | export(ll_get_nuts_it) 18 | export(ll_get_nuts_us) 19 | export(ll_get_population_grid) 20 | export(ll_get_population_grid_hr) 21 | export(ll_get_world) 22 | export(ll_match) 23 | export(ll_osm_download) 24 | export(ll_osm_download_it) 25 | export(ll_osm_extract_it) 26 | export(ll_osm_extract_roads) 27 | export(ll_osm_get_lau_streets) 28 | export(ll_osm_get_nuts_streets) 29 | export(ll_osm_get_roads) 30 | export(ll_set_folder) 31 | import(shiny) 32 | importFrom(config,get) 33 | importFrom(golem,activate_js) 34 | importFrom(golem,add_resource_path) 35 | importFrom(golem,bundle_resources) 36 | importFrom(golem,favicon) 37 | importFrom(golem,with_golem_options) 38 | importFrom(magrittr,"%>%") 39 | importFrom(shiny,NS) 40 | importFrom(shiny,shinyApp) 41 | importFrom(shiny,tagList) 42 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # latlon2map 0.0.0.9005 2 | 3 | - Added a `NEWS.md` file to track changes to the package. 4 | - add "date_extracted" attribute to cached OpenStreetMap files 5 | -------------------------------------------------------------------------------- /R/app_config.R: -------------------------------------------------------------------------------- 1 | #' Access files in the current app 2 | #' 3 | #' @param ... Character vector specifying directory and or file to 4 | #' point to inside the current package. 5 | #' 6 | #' @noRd 7 | app_sys <- function(...) { 8 | system.file(..., package = "latlon2map") 9 | } 10 | 11 | 12 | #' Read App Config 13 | #' 14 | #' @param value Value to retrieve from the config file. 15 | #' @param config R_CONFIG_ACTIVE value. 16 | #' @param use_parent Logical, scan the parent directory for config file. 17 | #' 18 | #' @importFrom config get 19 | #' 20 | #' @noRd 21 | get_golem_config <- function(value, 22 | config = Sys.getenv("R_CONFIG_ACTIVE", "default"), 23 | use_parent = TRUE) { 24 | config::get( 25 | value = value, 26 | config = config, 27 | # Modify this if your config file is somewhere else: 28 | file = app_sys("golem-config.yml"), 29 | use_parent = use_parent 30 | ) 31 | } 32 | -------------------------------------------------------------------------------- /R/app_ui.R: -------------------------------------------------------------------------------- 1 | #' The application User-Interface 2 | #' 3 | #' @param request Internal parameter for `{shiny}`. 4 | #' DO NOT REMOVE. 5 | #' @import shiny 6 | #' @noRd 7 | app_ui <- function(request) { 8 | tagList( 9 | # Leave this function for adding external resources 10 | golem_add_external_resources(), 11 | # List the first level UI elements here 12 | shiny::fluidPage( 13 | sidebarLayout( 14 | sidebarPanel = 15 | shiny::sidebarPanel( 16 | mod_file_input_ui("file_input_ui_1"), 17 | # shiny::radioButtons(inputId = "file_type", 18 | # label = "File type", 19 | # choices = c(".csv", 20 | # ".tsv", 21 | # ".xlsx", 22 | # ".ods"), 23 | # inline = TRUE), 24 | shiny::radioButtons( 25 | inputId = "map_type", 26 | label = "Map type", 27 | choices = c( 28 | "Static", 29 | "Dynamic" 30 | ), 31 | selected = "Static", 32 | inline = TRUE 33 | ), 34 | shiny::uiOutput(outputId = "latitude_selector_ui"), 35 | shiny::uiOutput(outputId = "longitude_selector_ui"), 36 | shiny::uiOutput(outputId = "other_columns_selector_ui"), 37 | shiny::uiOutput(outputId = "filter_columns_selector_ui"), 38 | shiny::uiOutput(outputId = "filter_columns_string_ui"), 39 | shiny::uiOutput(outputId = "long_range_UI"), 40 | shiny::uiOutput(outputId = "lat_range_UI"), 41 | shiny::uiOutput(outputId = "reset_full_range_UI"), 42 | shiny::uiOutput(outputId = "sample_size_UI"), 43 | shiny::conditionalPanel( 44 | condition = "input.highlight_mode=='Manually selected rows'&input.map_type=='Static'", 45 | shiny::checkboxInput( 46 | inputId = "only_selected", 47 | label = "Show only selected rows", 48 | value = FALSE 49 | ) 50 | ), 51 | shiny::checkboxInput( 52 | inputId = "colour_code_check", 53 | label = "Colour-code data on the map", 54 | value = FALSE 55 | ), 56 | shiny::conditionalPanel( 57 | condition = "input.colour_code_check==true", 58 | shiny::radioButtons( 59 | inputId = "highlight_mode", 60 | label = "Colour-code in map based on:", 61 | choices = c( 62 | "Manually selected rows", 63 | "Data columns" 64 | ) 65 | ), 66 | shiny::conditionalPanel( 67 | condition = "input.highlight_mode=='Data columns'", 68 | shiny::helpText("Make sure you have included all relevant columns in `Additional column(s)` above"), 69 | shiny::uiOutput(outputId = "colour_column_selector_ui"), 70 | shiny::uiOutput(outputId = "size_column_selector_ui"), 71 | ) 72 | ), 73 | shiny::checkboxInput( 74 | inputId = "geolocate_panel", 75 | label = "Geolocate points", 76 | value = FALSE 77 | ), 78 | shiny::conditionalPanel( 79 | condition = "input.geolocate_panel==true", 80 | shiny::radioButtons( 81 | inputId = "geolocate_selector", 82 | label = "Geolocate by", 83 | choices = c( 84 | "Country (World)", 85 | "NUTS0", 86 | "NUTS1", 87 | "NUTS2", 88 | "NUTS3", 89 | "LAU" 90 | ), 91 | selected = "Country (World)", 92 | inline = TRUE 93 | ), 94 | shiny::radioButtons( 95 | inputId = "join_type", 96 | label = "Match only if within, or also if near (e.g. offshore)?", 97 | choices = c( 98 | "Within", 99 | "Nearest" 100 | ) 101 | ) 102 | ), 103 | shiny::HTML("
"), 104 | # shiny::h3(tags$a("A tool by EDJNet", href='https://www.europeandatajournalism.eu/')), 105 | shiny::h3(tags$a(tags$img(src = fs::path("www", "img", "edjnet_logo_full.svg")), href = "https://www.europeandatajournalism.eu/")) 106 | ), 107 | mainPanel = 108 | shiny::mainPanel( 109 | shiny::conditionalPanel(condition = "input.map_type=='Static'", { 110 | shiny::plotOutput( 111 | outputId = "map_gg", 112 | dblclick = "map_gg_dblclick", 113 | brush = "map_gg_brush" 114 | ) 115 | }), 116 | shiny::conditionalPanel(condition = "input.map_type=='Dynamic'", { 117 | leaflet::leafletOutput("map_lf") 118 | }), 119 | DT::DTOutput(outputId = "df_DT_clicked"), 120 | DT::DTOutput(outputId = "df_DT"), 121 | shiny::downloadButton( 122 | outputId = "download_df_csv", 123 | label = "Download dataset (csv)" 124 | ), 125 | shiny::downloadButton( 126 | outputId = "download_df_ods", 127 | label = "Download dataset (ods)" 128 | ), 129 | shiny::downloadButton( 130 | outputId = "download_df_xlsx", 131 | label = "Download dataset (xlsx)" 132 | ), 133 | shiny::hr(), 134 | shiny::HTML("N.B. Remember to set the sample slider to its maximum value in order to include all data if this is your final export"), 135 | shiny::hr(), 136 | shiny::downloadButton( 137 | outputId = "download_map_gg_png", 138 | label = "Download static map as image (png)" 139 | ), 140 | shiny::downloadButton( 141 | outputId = "download_map_gg_pdf", 142 | label = "Download static map as pdf" 143 | ), 144 | shiny::downloadButton( 145 | outputId = "download_map_lf_html", 146 | label = "Download dynamic map as html" 147 | ), 148 | shiny::hr(), 149 | shiny::HTML("© EuroGeographics for the administrative boundaries") 150 | ), 151 | position = c("left", "right"), 152 | fluid = TRUE 153 | ) 154 | ) 155 | ) 156 | } 157 | 158 | #' Add external Resources to the Application 159 | #' 160 | #' This function is internally used to add external 161 | #' resources inside the Shiny application. 162 | #' 163 | #' @import shiny 164 | #' @importFrom golem add_resource_path activate_js favicon bundle_resources 165 | #' @noRd 166 | golem_add_external_resources <- function() { 167 | add_resource_path( 168 | "www", app_sys("app/www") 169 | ) 170 | 171 | tags$head( 172 | favicon(), 173 | bundle_resources( 174 | path = app_sys("app/www"), 175 | app_title = "latlon2map" 176 | ) 177 | # Add here other external resources 178 | # for example, you can add shinyalert::useShinyalert() 179 | ) 180 | } 181 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' Countries and geographic entities for which shapefiles are made availabile by Geofabrik 2 | #' 3 | #' A dataset with all names of countries, continents, as included in the Geofabrik database. 4 | #' They are used to download files with `ll_osm_download()` 5 | #' 6 | #' Links to shapefiles are stored as tibbles. Unnest to see them, e.g. 7 | #' `ll_osm_countries %>% tidyr::unnest(link)` 8 | #' or for a single country: 9 | #' `ll_osm_countries %>% dplyr::filter(country == "italy") %>% tidyr::unnest(link)` 10 | #' 11 | #' @format A tibble 12 | #' \describe{ 13 | #' \item{continent}{Name of the continent} 14 | #' \item{country}{Name of the country} 15 | #' \item{link}{Link to shapefiles in a tibble} 16 | #' } 17 | #' @source \url{http://download.geofabrik.de/} 18 | "ll_osm_countries" 19 | 20 | 21 | 22 | 23 | #' Geographic entities in Italy for which geopackage files are availabile 24 | #' 25 | #' A dataset with all names of geographic entities available for direct download as geopackage files 26 | #' They are used to download files with `ll_osm_download_it()` 27 | #' 28 | #' @format A list of tibbles 29 | #' @source \url{https://osmit-estratti.wmcloud.org/} 30 | "ll_osm_it_gpkg" 31 | 32 | 33 | #' A data frame with links to High Resolution Population Density Maps distributed by Facebook on HDX 34 | #' 35 | #' It is used to download files with `ll_get_population_grid_hr()` 36 | #' 37 | #' 38 | #' @format A tibble 39 | #' \describe{ 40 | #' \item{country}{Name of the country in English} 41 | #' \item{country_code}{Two letter code as used by eurostat, see also `countrycode::codelist$eurostat`} 42 | #' \item{download_ulr}{Link to zipped dataset} 43 | #' \item{url}{Link to page describing the dataset} 44 | #' } 45 | #' @source \url{https://data.humdata.org/} 46 | "population_grid_hr_metadata" 47 | -------------------------------------------------------------------------------- /R/ll_bbox.R: -------------------------------------------------------------------------------- 1 | #' Provide a bounding box with a consistent, user given ratio 2 | #' 3 | #' This is useful in particular to make geom_sf()-based ggplots with consistent aspect ratio. 4 | #' 5 | #' @param sf An sf object. 6 | #' @param ratio Defaults to "4:3". A chacters string, in the form of e.g. "4:3" or "16:9" or "1:1" (other values possible) 7 | #' 8 | #' @return A bounding box vector, same as with `sf::st_bbox()`, but with the given ratio set and compatible with crs 4326. 9 | #' @export 10 | #' 11 | #' @examples 12 | #' \dontrun{ 13 | #' # The following two graphs will have same 4:3 aspect ratio 14 | #' ll_set_folder("~/R/") 15 | #' library("ggspatial") 16 | #' 17 | #' sf_location <- ll_get_nuts_it(name = "Palmanova", level = "lau", resolution = "low") 18 | #' 19 | #' ggplot() + 20 | #' annotation_map_tile(type = "osm", zoomin = -1, cachedir = fs::path(ll_set_folder(), "ll_data")) + 21 | #' geom_sf(data = sf::st_as_sfc(ll_bbox(sf_location)), fill = NA, color = NA) + 22 | #' geom_sf( 23 | #' data = sf_location, 24 | #' colour = "darkred", 25 | #' size = 2, 26 | #' fill = NA, 27 | #' alpha = 0.8 28 | #' ) 29 | #' 30 | #' 31 | #' sf_location <- ll_get_nuts_it(name = "Pinzolo", level = "lau", resolution = "low") 32 | #' 33 | #' ggplot() + 34 | #' annotation_map_tile(type = "osm", zoomin = -1, cachedir = fs::path(ll_set_folder(), "ll_data")) + 35 | #' geom_sf(data = sf::st_as_sfc(ll_bbox(sf_location)), fill = NA, color = NA) + 36 | #' geom_sf( 37 | #' data = sf_location, 38 | #' colour = "darkred", 39 | #' size = 2, 40 | #' fill = NA, 41 | #' alpha = 0.8 42 | #' ) 43 | #' } 44 | #' 45 | ll_bbox <- function(sf, 46 | ratio = "4:3") { 47 | bbox <- sf::st_bbox(sf %>% sf::st_transform(crs = 3857)) 48 | 49 | horizontal_original <- as.numeric(bbox[3] - bbox[1]) 50 | vertical_original <- as.numeric(bbox[4] - bbox[2]) 51 | 52 | original_ratio_n <- horizontal_original / vertical_original 53 | 54 | desired_ratio_m <- stringr::str_split( 55 | string = ratio, 56 | pattern = ":", 57 | n = 2, 58 | simplify = TRUE 59 | ) %>% 60 | as.numeric() 61 | 62 | desired_ratio_n <- desired_ratio_m[1] / desired_ratio_m[2] 63 | 64 | if (desired_ratio_n == original_ratio_n) { 65 | # do nothing 66 | } else if (desired_ratio_n < original_ratio_n) { 67 | vertical_fixed <- horizontal_original / desired_ratio_n 68 | change <- (vertical_fixed - vertical_original) / 2 69 | bbox[2] <- bbox[2] - change 70 | bbox[4] <- bbox[4] + change 71 | } else if (desired_ratio_n > original_ratio_n) { 72 | horizontal_fixed <- vertical_original * desired_ratio_n 73 | change <- (horizontal_fixed - horizontal_original) / 2 74 | 75 | 76 | bbox[1] <- bbox[1] - change 77 | bbox[3] <- bbox[3] + change 78 | } 79 | return(bbox %>% sf::st_as_sfc() %>% 80 | sf::st_transform(crs = 4326) %>% 81 | sf::st_bbox()) 82 | } 83 | -------------------------------------------------------------------------------- /R/ll_create_folders.R: -------------------------------------------------------------------------------- 1 | #' Create folders to store geographic data 2 | #' 3 | #' @param geo The geographic unit of reference as a two-letter code 4 | #' @param level E.g. NUTS0, NUTS1, or county, state, ecc. 5 | #' @param resolution Either resolution level as given by the data distributor, or generic such as "high", "low", or "default 6 | #' @param file_type By defaults, it creates folder for zip, shp, and rds files. 7 | #' 8 | #' @return 9 | #' @export 10 | #' 11 | #' @examples 12 | ll_create_folders <- function(geo, 13 | level, 14 | resolution, 15 | year, 16 | file_type = c("shp", "zip", "rds")) { 17 | base_folder <- ll_set_folder() 18 | purrr::walk(file_type, .f = function(x) { 19 | fs::dir_create(fs::path(base_folder, "ll_data", x, geo, level, resolution, year), recurse = TRUE) 20 | }) 21 | } 22 | -------------------------------------------------------------------------------- /R/ll_export_sf_to_kml.R: -------------------------------------------------------------------------------- 1 | #' Export sf objects into kml file that can be used with Google Earth, Google Maps, etc. 2 | #' 3 | #' Attention: this function requires libkml. 4 | #' 5 | #' Attention: label styling is not currently functional, likely due to issues in passing arguments to libkml. In order to change label size, use label_scale, which directly edits the xml file. 6 | #' 7 | #' For further details on the exact meaning of each of the parameters, please consult the documentation of OGR (used by GDAL to pass parameters to .kml): https://gdal.org/user/ogr_feature_style.html 8 | #' 9 | #' @param sf An object of class `sf` 10 | #' @param path Path where to save the .kml output. 11 | #' @param name Column to be used for names. 12 | #' @param description Column to be used for description. 13 | #' @param keep_other_columns Logical, defaults to TRUE. If you don't want to keep in the output data columns present in the original `sf` object, set this to FALSE. 14 | #' @param label_text Column to be used as label text. Defaults to NULL. Corresponds to "LABEL" element in OGR. 15 | #' @param label_font Font family to be used for the font. Defaults to "Roboto Sans, Noto Sans, Helvetica" 16 | #' @param label_size Size of the label. Defaults to "24pt" 17 | #' @param label_scale Scale of label. Defaults to NULL. If given, changes label size (e.g. 1 = default, 2 = twice as big, 0.5, half as big, etc.) 18 | #' @param label_placement Defaults to "m" (centre and middle-aligned). For more options, check: https://gdal.org/user/ogr_feature_style.html 19 | #' @param icon_url Defaults to "" for no URL. Corresponds to "SYMBOL" in OGR. In case of wrong inputs, Google Earth may show you an ugly yellow pushpin instead (i.e. default to http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png). Available icons offered by Google available at this link: http://kml4earth.appspot.com/icons.html 20 | #' @param icon_colour Defaults to "#000000ff" (i.e. black, with 100% opacity). 21 | #' @param icon_scale Defaults to NULL. If given, changes icon size (e.g. 1 = default, 2 = twice as big, 0.5, half as big, etc.) 22 | #' @param line_colour Defaults to "#ffffffff" (i.e. white, with 100% opacity). Line corresponds to "PEN" in OGR. Accepts 8-digit hex codes to include transparency. 23 | #' @param line_width Defaults to "3pt". Line corresponds to "PEN" in OGR. Besides pt (points), other acceptable units are `g`: Map Ground Units (whatever the map coordinate units are), `px` Pixels, `pt` Points (1/72 inch), `mm` Millimeters, `cm` Centimeters, `in` Inches. 24 | #' @param fill_colour Defaults to NULL. Fill corresponds to "BRUSH" in OGR. If given, colour to be used for filling polygons. 25 | #' 26 | #' @return 27 | #' @export 28 | #' 29 | #' @examples 30 | ll_export_sf_to_kml <- function(sf, 31 | path, 32 | name = NULL, 33 | keep_other_columns = TRUE, 34 | description = NULL, 35 | label_text = NULL, 36 | label_font = "Roboto Sans, Noto Sans, Helvetica", 37 | label_size = "24pt", 38 | label_placement = "m", 39 | label_scale = NULL, 40 | line_colour = "#ffffffff", 41 | line_width = "3px", 42 | icon_url = "", 43 | icon_colour = "#000000ff", 44 | icon_scale = NULL, 45 | fill_colour = NULL) { 46 | if (is.null(fill_colour) == FALSE) { 47 | brush <- paste0("BRUSH(fc:", fill_colour, ");") 48 | } else { 49 | brush <- "" 50 | } 51 | 52 | if (is.null(label_text) == FALSE) { 53 | label <- paste0("LABEL(f:", label_font, ",s:", label_size, ",t:", label_text, ",m:", label_placement, ")") 54 | } else { 55 | label <- "" 56 | } 57 | 58 | sf_pre_kml <- sf %>% 59 | dplyr::mutate(OGR_STYLE = paste0( 60 | brush, 61 | "PEN(c:", line_colour, ",w:", line_width, ");", 62 | "SYMBOL(c:", icon_colour, ',id:"', icon_url, '");', 63 | label 64 | )) 65 | 66 | if (keep_other_columns == FALSE) { 67 | sf_pre_kml <- sf_pre_kml %>% 68 | dplyr::select(OGR_STYLE) 69 | } 70 | 71 | if (is.null(name) == FALSE) { 72 | sf_pre_kml[["name"]] <- sf[[name]] 73 | } 74 | 75 | if (is.null(description) == FALSE) { 76 | sf_pre_kml[["description"]] <- sf[[description]] 77 | } 78 | 79 | sf::st_write( 80 | obj = sf_pre_kml, 81 | dsn = path, 82 | driver = "libkml" 83 | ) 84 | 85 | if (is.null(label_scale) == FALSE | is.null(icon_scale) == FALSE) { 86 | xml_list <- xml2::read_xml(x = path) %>% 87 | xml2::as_list() 88 | id_of_placemarks <- seq_along(purrr::pluck(xml_list, "kml", "Document", "Document"))[-1] 89 | 90 | for (i in id_of_placemarks) { 91 | if (is.element("Style", names(xml_list[["kml"]][["Document"]][["Document"]][[i]])) == FALSE) { 92 | new_item_location <- length(xml_list[["kml"]][["Document"]][["Document"]][[i]]) + 1 93 | xml_list[["kml"]][["Document"]][["Document"]][[i]][[new_item_location]] <- "Style" 94 | } 95 | 96 | if (is.null(label_scale) == FALSE) { 97 | if (is.element("LabelStyle", names(xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]])) == FALSE) { 98 | new_item_location <- length(xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]]) + 1 99 | xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][[new_item_location]] <- "LabelStyle" 100 | } 101 | 102 | new_item_location <- length(xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][["LabelStyle"]]) + 1 103 | xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][["LabelStyle"]][[new_item_location]] <- "scale" 104 | xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][["LabelStyle"]][["scale"]][[1]] <- label_scale 105 | } 106 | 107 | if (is.null(icon_scale) == FALSE) { 108 | if (is.element("LabelStyle", names(xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]])) == FALSE) { 109 | new_item_location <- length(xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]]) + 1 110 | xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][[new_item_location]] <- "IconStyle" 111 | } 112 | 113 | new_item_location <- length(xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][["IconStyle"]]) + 1 114 | xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][["IconStyle"]][[new_item_location]] <- "scale" 115 | xml_list[["kml"]][["Document"]][["Document"]][[i]][["Style"]][["IconStyle"]][["scale"]][[1]] <- icon_scale 116 | } 117 | } 118 | xml_list %>% 119 | xml2::as_xml_document() %>% 120 | xml2::write_xml(file = path) 121 | } 122 | } 123 | -------------------------------------------------------------------------------- /R/ll_find_file.R: -------------------------------------------------------------------------------- 1 | #' Find file names. Mostly used internally 2 | #' 3 | #' @param geo 4 | #' @param level 5 | #' @param resolution 6 | #' @param year 7 | #' @param name Name of specific dataset being downloaded. Defaults to abl, i.e. administrative boundary line 8 | #' @param file_type 9 | #' 10 | #' @return 11 | #' @export 12 | #' 13 | #' @examples 14 | ll_find_file <- function(geo, 15 | level, 16 | resolution, 17 | year, 18 | name = "abl", 19 | file_type = "rds") { 20 | base_folder <- ll_set_folder() 21 | name <- stringr::str_replace_all(string = name, pattern = "[[:punct:]]", replacement = "_") 22 | file_name <- paste0(paste(c(geo, level, resolution, year), collapse = "-"), "-", name, ".", file_type) 23 | full_path <- fs::path(base_folder, "ll_data", file_type, geo, level, resolution, year, file_name) 24 | if (file_type == "shp") { 25 | full_path %>% fs::path_dir() 26 | } else { 27 | full_path 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /R/ll_find_pop_centre.R: -------------------------------------------------------------------------------- 1 | #' Find the population-weighted centre of a municipality 2 | #' 3 | #' @param sf_location 4 | #' @param sf_population_grid 5 | #' @param power Defaults to 2. To give more weight to cells with higher population density, raise the number of residents by the power of. 6 | #' @param join Defaults to sf::st_intersects. 7 | #' @param adjusted If adjusted is set to TRUE, join is ignored. The population of cells along the boundary line are weighted by the share of the cell included within the border. 8 | #' 9 | #' @return 10 | #' @export 11 | #' 12 | #' @examples 13 | #' 14 | #' ll_set_folder("~/R/") 15 | #' name <- "Pinzolo" 16 | #' sf_location <- ll_get_nuts_it(name = name, level = "lau", resolution = "high") 17 | #' 18 | #' lau_grid_name_temp <- stringr::str_c(name, "_lau_high-st_intersects") 19 | #' 20 | #' sf_location_grid <- ll_get_population_grid( 21 | #' match_sf = sf_location, 22 | #' match_name = lau_grid_name_temp, 23 | #' match_country = "IT", 24 | #' join = sf::st_intersects 25 | #' ) 26 | #' 27 | #' 28 | #' pop_centre <- ll_find_pop_centre( 29 | #' sf_location = sf_location, 30 | #' sf_population_grid = sf_location_grid, 31 | #' power = 2 32 | #' ) 33 | ll_find_pop_centre <- function(sf_location, 34 | sf_population_grid, 35 | power = 2, 36 | join = sf::st_intersects, 37 | adjusted = FALSE) { 38 | if (is.element("TOT_P", colnames(sf_population_grid))) { 39 | sf_population_grid <- sf_population_grid %>% 40 | dplyr::rename(population = TOT_P) 41 | } else if (is.element("TOT_P_2018", colnames(sf_population_grid))) { 42 | sf_population_grid <- sf_population_grid %>% 43 | dplyr::rename(population = TOT_P_2018) 44 | } else if (is.element("POP_2020", colnames(sf_population_grid))) { 45 | sf_population_grid <- sf_population_grid %>% 46 | dplyr::rename(population = POP_2020) 47 | } else if (is.element("Population", colnames(sf_population_grid))) { 48 | sf_population_grid <- sf_population_grid %>% 49 | dplyr::rename(population = Population) 50 | } 51 | 52 | 53 | if (adjusted == TRUE) { 54 | # adjust population for cells that intersect the boundary 55 | intersect_grid_sf <- sf::st_filter( 56 | x = sf_population_grid, 57 | y = sf_location, 58 | .predicate = sf::st_intersects 59 | ) 60 | within_grid_sf <- sf::st_filter( 61 | x = sf_population_grid, 62 | y = sf_location, 63 | .predicate = sf::st_within 64 | ) 65 | boundary_grid_sf <- dplyr::anti_join(intersect_grid_sf, 66 | within_grid_sf %>% 67 | sf::st_drop_geometry(), 68 | by = "GRD_ID" 69 | ) 70 | boundary_grid_adjusted_df <- boundary_grid_sf %>% 71 | sf::st_drop_geometry() 72 | 73 | boundary_grid_adjusted_df$population_adjusted <- boundary_grid_sf$population * as.numeric(sf::st_area(sf::st_intersection( 74 | boundary_grid_sf, 75 | sf_location 76 | )) / sf::st_area(boundary_grid_sf)) 77 | 78 | sf_location_grid <- intersect_grid_sf %>% 79 | dplyr::left_join( 80 | y = boundary_grid_adjusted_df %>% 81 | dplyr::select(GRD_ID, population_adjusted), 82 | by = "GRD_ID" 83 | ) %>% 84 | dplyr::mutate(population = dplyr::if_else(condition = is.na(population_adjusted), 85 | true = population, 86 | false = population_adjusted 87 | )) 88 | } else { 89 | sf_location_grid <- sf::st_filter( 90 | x = sf_population_grid, 91 | y = sf_location, 92 | .predicate = join 93 | ) 94 | } 95 | 96 | 97 | sf_polygon <- sf_location %>% 98 | dplyr::select(geometry) %>% 99 | sf::st_cast(to = "POLYGON") %>% 100 | dplyr::mutate(id = dplyr::row_number()) 101 | 102 | if (nrow(sf_polygon) > 1) { 103 | df_pop_by_polygon <- purrr::map_dfr( 104 | .x = seq_along(along.with = 1:nrow(sf_polygon)), 105 | .f = function(x) { 106 | temp <- sf::st_filter( 107 | x = sf_location_grid, 108 | y = sf_polygon %>% dplyr::slice(x), 109 | .predicate = join 110 | ) %>% 111 | sf::st_drop_geometry() 112 | 113 | if (nrow(temp) == 0) { 114 | tibble::tibble(population = 0, id = x) 115 | } else { 116 | temp %>% 117 | dplyr::summarise( 118 | population = (sum(population)), 119 | id = x 120 | ) 121 | } 122 | } 123 | ) 124 | 125 | sf_location <- sf_polygon %>% 126 | dplyr::slice(which.max(df_pop_by_polygon$population)) 127 | 128 | sf_location_grid <- sf::st_filter( 129 | x = sf_location_grid, 130 | y = sf_location, 131 | .predicate = join 132 | ) 133 | } 134 | 135 | 136 | sf_pop_centre <- dplyr::bind_cols( 137 | sf_location_grid %>% 138 | sf::st_drop_geometry() %>% 139 | dplyr::select(population), 140 | sf_location_grid %>% 141 | sf::st_centroid() %>% 142 | sf::st_transform(crs = 4326) %>% 143 | sf::st_coordinates() %>% 144 | tibble::as_tibble() 145 | ) %>% 146 | dplyr::summarise( 147 | x = weighted.mean(x = X, w = population^power), 148 | y = weighted.mean(x = Y, w = population^power) 149 | ) %>% 150 | sf::st_as_sf(coords = c("x", "y"), crs = 4326) 151 | 152 | # sf_location_grid %>% 153 | # dplyr::filter(population>=median(population)) 154 | 155 | 156 | # if the pop-weighted centre is out of the boundary, 157 | # take the closest cell, crop it with the boundary, 158 | # and use the centroid of the remaining part 159 | 160 | if (sf::st_is_valid(sf_location %>% sf::st_transform(4326))==FALSE) { 161 | # deal with invalid lau 162 | if (sf::st_intersects( 163 | x = sf_location %>% sf::st_transform(3857), 164 | y = sf_pop_centre %>% sf::st_transform(3857), 165 | sparse = FALSE 166 | ) == FALSE) { 167 | sf_cell <- sf_location_grid %>% 168 | dplyr::slice(sf::st_nearest_feature( 169 | x = sf_pop_centre %>% sf::st_transform(3857), 170 | y = sf_location_grid %>% sf::st_transform(3857) 171 | )) 172 | 173 | sf_cell_intersection <- sf::st_intersection( 174 | sf_cell %>% sf::st_transform(3857), 175 | sf_location %>% sf::st_transform(3857) 176 | ) 177 | 178 | sf_pop_centre <- sf::st_centroid(sf_cell_intersection) %>% 179 | sf::st_transform(crs = 4326) 180 | } 181 | 182 | } else if (sf::st_intersects( 183 | x = sf_location, 184 | y = sf_pop_centre, 185 | sparse = FALSE 186 | ) == FALSE) { 187 | sf_cell <- sf_location_grid %>% 188 | dplyr::slice(sf::st_nearest_feature( 189 | x = sf_pop_centre, 190 | y = sf_location_grid 191 | )) 192 | 193 | sf_cell_intersection <- sf::st_intersection( 194 | sf_cell, 195 | sf_location 196 | ) 197 | 198 | sf_pop_centre <- sf::st_centroid(sf_cell_intersection) %>% 199 | sf::st_transform(crs = 4326) 200 | } 201 | sf_pop_centre 202 | } 203 | -------------------------------------------------------------------------------- /R/ll_get_adm_ocha.R: -------------------------------------------------------------------------------- 1 | #' Get administrative boundary lines from OCHA database 2 | #' 3 | #' Source: https://data.humdata.org/ 4 | #' 5 | #' @param geo A twe letter country code, such as "IT" for Italy and "DE" for Germany 6 | #' @param match_name A name to be used for local caching if a subset of the grid is used. It is the responsibility of the user to keept it consistent. If not given, data are not cached locally. 7 | #' @param source_url A direct link to the zipped version of the csv file in the original database, if automatic download with the country code does not work. For example, for Italy this would be "https://data.humdata.org/dataset/0eb77b21-06be-42c8-9245-2edaff79952f/resource/1e96f272-7d86-4108-b4ca-5a951a8b11a0/download/population_ita_2019-07-01.csv.zip" 8 | #' @param silent 9 | #' 10 | #' @return 11 | #' @export 12 | #' 13 | #' @examples 14 | #' 15 | #' if (interactive) { 16 | #' ll_get_adm_ocha(geo = "UA", level = 3) 17 | #' } 18 | ll_get_adm_ocha <- function(geo, 19 | level = 0, 20 | match_name = NULL, 21 | source_url = NULL, 22 | silent = FALSE) { 23 | if (silent == FALSE) { 24 | 25 | } 26 | 27 | if (is.null(geo) == FALSE) { 28 | geo <- stringr::str_to_upper(string = geo) 29 | } 30 | 31 | current_slice <- latlon2map::ll_administrative_boundaries_ocha_metadata %>% 32 | dplyr::filter(.data$country_code==geo) %>% 33 | dplyr::distinct() 34 | 35 | if (is.null(source_url)==TRUE) { 36 | source_url <- current_slice %>% 37 | dplyr::pull(download_url) 38 | } 39 | 40 | 41 | year <- current_slice %>% 42 | dplyr::pull(last_modified) %>% 43 | stringr::str_extract(pattern = "[[:digit:]]{4}") 44 | 45 | if (is.null(match_name) == FALSE) { 46 | rds_file_location <- ll_find_file( 47 | geo = geo, 48 | level = level, 49 | resolution = "ocha", 50 | year = year, 51 | name = paste0(match_name), 52 | file_type = "rds" 53 | ) 54 | } else { 55 | rds_file_location <- ll_find_file( 56 | geo = geo, 57 | level = level, 58 | resolution = "ocha", 59 | year = year, 60 | name = paste0("ocha_administrative"), 61 | file_type = "rds" 62 | ) 63 | } 64 | 65 | if (fs::file_exists(rds_file_location)) { 66 | return(readRDS(file = rds_file_location)) 67 | } 68 | 69 | 70 | ll_create_folders( 71 | geo = geo, 72 | level = level, 73 | resolution = "ocha", 74 | year = year, 75 | file_type = c("zip", "shp", "rds") 76 | ) 77 | 78 | 79 | if (fs::file_exists(rds_file_location)) { 80 | sf <- readRDS(file = rds_file) 81 | return(sf) 82 | } 83 | 84 | shp_folder <- ll_find_file( 85 | geo = geo, 86 | level = level, 87 | resolution = "ocha", 88 | year = year, 89 | name = paste0("ocha_administrative"), 90 | file_type = "shp" 91 | ) 92 | 93 | zip_file <- ll_find_file( 94 | geo = geo, 95 | level = level, 96 | resolution = "ocha", 97 | year = year, 98 | name = paste0("ocha_administrative"), 99 | file_type = "zip" 100 | ) 101 | 102 | if (fs::file_exists(zip_file) == FALSE) { 103 | download.file( 104 | url = source_url, 105 | destfile = zip_file 106 | ) 107 | } 108 | 109 | file_name <- stringr::str_split(source_url, "/") %>% 110 | unlist() %>% 111 | dplyr::last() %>% 112 | stringr::str_replace("_csv\\.zip$|\\.csv\\.zip$", ".csv") %>% 113 | stringr::str_to_lower() 114 | 115 | if (fs::file_exists(fs::path(shp_folder, file_name)) == FALSE) { 116 | unzip( 117 | zipfile = zip_file, 118 | exdir = shp_folder, 119 | junkpaths = TRUE 120 | ) 121 | fs::dir_walk( 122 | path = shp_folder, 123 | fun = function(x) { 124 | fs::file_move( 125 | path = x, 126 | new_path = fs::path( 127 | fs::path_dir(x), 128 | stringr::str_to_lower(fs::path_file(x)) 129 | ) 130 | ) 131 | } 132 | ) 133 | } 134 | 135 | all_shp_files_df <- tibble::tibble(file_location = fs::dir_ls(path = shp_folder, recurse = FALSE, type = "file", glob = "*.shp")) %>% 136 | dplyr::mutate(file = fs::path_file(.data$file_location)) %>% 137 | dplyr::mutate(level = stringr::str_extract(string = .data$file, pattern = "[[:digit:]]+")) 138 | 139 | selected_level <- level 140 | 141 | current_level_shp_file <- all_shp_files_df %>% 142 | dplyr::filter(.data$level == as.character(selected_level)) %>% 143 | dplyr::slice(1) %>% 144 | dplyr::pull(file_location) 145 | 146 | current_sf <- sf::st_read(current_level_shp_file) %>% 147 | sf::st_transform(crs = 4326) 148 | 149 | saveRDS( 150 | object = current_sf, 151 | file = rds_file_location 152 | ) 153 | 154 | return(current_sf) 155 | } 156 | 157 | -------------------------------------------------------------------------------- /R/ll_get_electoral_districts_it.R: -------------------------------------------------------------------------------- 1 | #' Get Italian electoral districts (CC-BY Istat) 2 | #' 3 | #' 2022 / WGS 84 / UTM zone 32N 4 | #' 5 | #' Column names metadata: 6 | #' 7 | ##' \itemize{ 8 | ##' \item{COD_REG Codice della regione/circoscrizione elettorale del Senato della Repubblica} 9 | ##' \item{DEN_REG Denominazione della regione amministrativa/circoscrizione elettorale Senato della Repubblica} 10 | ##' \item{COD_PRO Codice della provincia} 11 | ##' \item{DEN_P_CM Denominazione della provincia o città metropolitana} 12 | ##' \item{COD_CM Codice della città metropolitana} 13 | ##' \item{PRO_COM Codice del comune} 14 | ##' \item{DEN_COM Denominazione del comune} 15 | ##' \item{CAP_DEN Denominazione del capoluogo di provincia o città metropolitana} 16 | ##' \item{POP_2011 Popolazione - Censimento 2011 } 17 | ##' \item{ASC_COD Codice concatenato comune e area sub-comunale} 18 | ##' \item{ASC_COD1 Codice progressivo area sub-comunale} 19 | ##' \item{ASC_COD2 Codice alfanumerico dell'area sub-comunale attribuito dal comune} 20 | ##' \item{ASC_NOME Denominazione dell'area sub-comunale} 21 | ##' \item{ASC_TIPO Tipologia di area-sub-comunale} 22 | ##' \item{CIRC_COD Codice della circoscrizione elettorale della Camera dei deputati} 23 | ##' \item{CIRC_DEN Denominazione della circoscrizione elettorale della Camera dei deputati} 24 | ##' \item{CU20_COD Codice del collegio elettorale uninominale della Camera dei deputati} 25 | ##' \item{CP20_COD Codice del collegio elettoraleplurinominale della Camera dei deputati} 26 | ##' \item{SU20_COD Codice del collegio elettorale uninominale del Senato della Repubblica} 27 | ##' \item{SP20_COD Codice del collegio elettorale plurinominale del Senato della Repubblica} 28 | ##' \item{CU20_DEN Denominazione del collegio elettorale uninominale della Camera dei deputati} 29 | ##' \item{CP20_DEN Denominazione del collegio elettorale plurinominale della Camera dei deputati} 30 | ##' \item{SU20_DEN Denominazione del collegio elettorale uninominale del Senato della Repubblica} 31 | ##' \item{SP20_DEN Denominazione del collegio elettorale plurinominale del Senato della Repubblica} 32 | ##' \item{CU20_C1 Sigla del collegio elettorale uninominale della Camera dei deputati} 33 | ##' \item{CP20_C1 Sigla del collegio elettorale plurinominale della Camera dei deputati} 34 | ##' \item{SU20_C1 Sigla del collegio elettorale uninominale del Senato della Repubblica} 35 | ##' \item{SP20_C1 Sigla del collegio elettorale plurinominale del Senato della Repubblica} 36 | ##' } 37 | #' 38 | #' @param level Defaults to "Circoscrizioni_Camera". Valid values: 39 | ##' \itemize{ 40 | ##' \item{"Circoscrizioni_Camera"}: Basi geografiche delle circoscrizioni elettorali - Camera dei deputati 41 | ##' \item{"Regioni_Senato"}: Basi geografiche delle circoscrizioni elettorali - Senato della Repubblica 42 | ##' \item{"CAMERA_CollegiPLURINOMINALI_2020"}: Basi geografiche dei collegi elettorali plurinominali - Camera dei deputati 43 | ##' \item{"CAMERA_CollegiUNINOMINALI_2020"}: Basi geografiche dei collegi elettorali uninominali - Camera dei deputati 44 | ##' \item{"SENATO_CollegiPLURINOMINALI_2020"}: Basi geografiche dei collegi elettorali plurinominali - Senato della Repubblica 45 | ##' \item{"SENATO_CollegiUNINOMINALI_2020"}: Basi geografiche dei collegi elettorali uninominali - Senato della Repubblica 46 | ##' \item{"UT_Collegi2020"}: Basi geografiche delle unità territoriali che formano i collegi elettorali (comuni e aree sub-comunali, limitatamente ai comuni di Torino, Genova, Milano, Roma, Napoli e Palermo con territorio ripsrtito su più di un collegio). Geografia comunale vigente alla data della pubblicazione 47 | ##' } 48 | #' @param year Defaults to 2022 (latest available). Currently no other year accepted. 49 | #' @param no_check_certificate Logical, defaults to TRUE. Enable only if certificate issues, and if you are aware of the security implications. 50 | #' 51 | #' @return 52 | #' @export 53 | #' 54 | #' @examples 55 | #' ll_set_folder(fs::path(fs::path_home_r(), "R")) 56 | #' ll_get_electoral_districts_it() 57 | #' ll_get_electoral_districts_it(name = "Lombardia 2") 58 | #' ll_get_electoral_districts_it() %>% ggplot2::ggplot() + ggplot2::geom_sf() + ggplot2::labs(title = "Circoscrizioni Camera") 59 | #' ll_get_electoral_districts_it(level = "SENATO_CollegiUNINOMINALI_2020") %>% ggplot2::ggplot() + ggplot2::geom_sf() + ggplot2::labs(title = "Collegi uninominali - Senato") 60 | ll_get_electoral_districts_it <- function(name = NULL, 61 | level = "Circoscrizioni_Camera", 62 | year = 2022, 63 | silent = FALSE, 64 | no_check_certificate = FALSE) { 65 | if (silent == FALSE) { 66 | usethis::ui_info(x = "https://www.istat.it/it/archivio/273443") 67 | usethis::ui_info(x = "Istat (CC-BY)") 68 | } 69 | 70 | if (year == 2020) { 71 | year <- 2022 72 | } 73 | 74 | resolution <- "standard" 75 | 76 | if (is.null(name) == FALSE) { 77 | rds_file_location <- ll_find_file( 78 | geo = "it_elections", 79 | level = level, 80 | resolution = resolution, 81 | year = year, 82 | name = paste0(level, "-", stringr::str_replace_all(string = name, pattern = "[[:punct:]]", replacement = "_")), 83 | file_type = "rds" 84 | ) 85 | 86 | if (fs::file_exists(rds_file_location)) { 87 | return(readRDS(file = rds_file_location)) 88 | } 89 | } 90 | 91 | 92 | rds_file <- ll_find_file( 93 | geo = "it_elections", 94 | level = level, 95 | resolution = resolution, 96 | year = year, 97 | name = "electoral_districts", 98 | file_type = "rds" 99 | ) 100 | 101 | if (fs::file_exists(rds_file)) { 102 | sf <- readRDS(file = rds_file) 103 | } else { 104 | ll_create_folders( 105 | geo = "it_elections", 106 | level = level, 107 | resolution = resolution, 108 | year = year 109 | ) 110 | ll_create_folders( 111 | geo = "it_elections", 112 | level = "all_levels", 113 | resolution = resolution, 114 | year = year 115 | ) 116 | 117 | shp_folder <- ll_find_file( 118 | geo = "it_elections", 119 | level = "all_levels", 120 | resolution = resolution, 121 | year = year, 122 | name = "electoral_districts", 123 | file_type = "shp" 124 | ) 125 | 126 | 127 | source_url <- "https://www.istat.it/storage/Basi%20Geografiche%202022/Collegi_Elettorali_BasiGeografiche.zip" 128 | 129 | zip_file <- ll_find_file( 130 | geo = "it_elections", 131 | level = "all_levels", 132 | resolution = resolution, 133 | year = year, 134 | name = "electoral_districts", 135 | file_type = "zip" 136 | ) 137 | 138 | 139 | if (fs::file_exists(zip_file) == FALSE) { 140 | if (isTRUE(no_check_certificate)) { 141 | download.file(url = source_url, destfile = zip_file, method = "wget", extra = "--no-check-certificate") 142 | } else { 143 | download.file(url = source_url, destfile = zip_file) 144 | } 145 | } 146 | 147 | unzip(zipfile = zip_file, exdir = shp_folder) 148 | 149 | sf <- sf::read_sf(fs::path( 150 | shp_folder, 151 | "Collegi_Elettorali_BasiGeografiche", 152 | level 153 | )) 154 | 155 | saveRDS(object = sf, file = rds_file) 156 | } 157 | 158 | if (is.null(name) == FALSE) { 159 | if (level == "Circoscrizioni_Camera") { 160 | sf <- sf %>% 161 | dplyr::filter(CIRC_DEN == name) 162 | } else if (level == "Regioni_Senato") { 163 | sf <- sf %>% 164 | dplyr::filter(DEN_REG == name) 165 | } else if (level == "CAMERA_CollegiPLURINOMINALI_2020") { 166 | sf <- sf %>% 167 | dplyr::filter(is.na(CP20_DEN)==FALSE) %>% 168 | dplyr::filter(CP20_DEN == name) 169 | } else if (level == "CAMERA_CollegiUNINOMINALI_2020") { 170 | sf <- sf %>% 171 | dplyr::filter(CU20_DEN == name) 172 | } else if (level == "SENATO_CollegiPLURINOMINALI_2020") { 173 | sf <- sf %>% 174 | dplyr::filter(is.na(SP20_DEN)==FALSE) %>% 175 | dplyr::filter(SP20_DEN == name) 176 | } else if (level == "SENATO_CollegiUNINOMINALI_2020") { 177 | sf <- sf %>% 178 | dplyr::filter(is.na(SU20_DEN)==FALSE) %>% 179 | dplyr::filter(SU20_DEN == name) 180 | } else if (level == "SENATO_CollegiPLURINOMINALI_2020") { 181 | sf <- sf %>% 182 | dplyr::filter(is.na(SP20_DEN)==FALSE) %>% 183 | dplyr::filter(SP20_DEN == name) 184 | } else if (level == "SENATO_CollegiUNINOMINALI_2020") { 185 | sf <- sf %>% 186 | dplyr::filter(is.na(SU20_DEN)==FALSE) %>% 187 | dplyr::filter(SU20_DEN == name) 188 | } else if (level == "UT_Collegi2020") { 189 | sf <- sf %>% 190 | dplyr::filter(is.na(DEN_REG) == FALSE) %>% 191 | dplyr::filter(DEN_REG == name) 192 | } 193 | 194 | saveRDS(object = sf, 195 | file = rds_file_location) 196 | } 197 | return(sf) 198 | } 199 | -------------------------------------------------------------------------------- /R/ll_get_lau_nuts_concordance.R: -------------------------------------------------------------------------------- 1 | #' Gets correspondence tables between local administrative units and nuts from Eurostat's website 2 | #' 3 | #' Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/lau 4 | #' 5 | #' Warning: due to issues in the original data, nuts may not always correspond to the given year for all countries, e.g. in files with nuts 2016 one may find nuts 2013 for single country, e.g. Italy. 6 | #' Do check the sources for details and ensure complete matching. 7 | #' 8 | #' @param lau_year Defaults to 2019. See `ll_lau_nuts_concordance_links` for details on available combinations. 9 | #' @param nuts_year Defaults to 2016. See `ll_lau_nuts_concordance_links` for details on available combinations. 10 | #' @param silent Defaults to FALSE. If TRUE, hides copyright notice. Useful e.g. when using this in reports or in loops. The copyright notice must still be shown where the final output is used. 11 | #' 12 | #' @return A tibble with a correspondence table. 13 | #' @export 14 | #' 15 | #' @examples 16 | #' 17 | #' ll_set_folder("~/R/") 18 | #' ll_get_lau_nuts_concordance() 19 | #' \dontrun{ 20 | #' lau_with_nuts_df <- ll_get_lau_eu(year = 2018) %>% 21 | #' sf::st_drop_geometry() %>% 22 | #' filter(is.na(LAU_NAME) == FALSE) %>% 23 | #' dplyr::rename(gisco_id = GISCO_ID) %>% 24 | #' dplyr::left_join( 25 | #' y = ll_get_lau_nuts_concordance( 26 | #' lau_year = 2018, 27 | #' nuts_year = 2016 28 | #' ), 29 | #' by = "gisco_id" 30 | #' ) 31 | #' } 32 | ll_get_lau_nuts_concordance <- function(lau_year = 2019, 33 | nuts_year = 2016, 34 | silent = FALSE) { 35 | if (silent == FALSE) { 36 | usethis::ui_info(x = "For details, see: https://ec.europa.eu/eurostat/web/nuts/local-administrative-units") 37 | } 38 | ll_create_folders( 39 | geo = "eu", 40 | level = "lau_nuts", 41 | resolution = "correspondence", 42 | year = lau_year, 43 | file_type = c("rds", "xlsx") 44 | ) 45 | 46 | rds_file <- ll_find_file( 47 | geo = "eu", 48 | level = "lau_nuts", 49 | resolution = "correspondence", 50 | year = lau_year, 51 | name = stringr::str_c("lau_year_", lau_year, "_nuts_year_", nuts_year), 52 | file_type = "rds" 53 | ) 54 | 55 | 56 | if (fs::file_exists(rds_file)) { 57 | return(readRDS(file = rds_file)) 58 | } 59 | 60 | xlsx_file <- ll_find_file( 61 | geo = "eu", 62 | level = "lau_nuts", 63 | resolution = "correspondence", 64 | year = lau_year, 65 | name = stringr::str_c("lau_year_", lau_year, "_nuts_year_", nuts_year), 66 | file_type = "xlsx" 67 | ) 68 | lau_year_filter <- lau_year 69 | nuts_year_filter <- nuts_year 70 | 71 | source_url <- ll_lau_nuts_concordance_links %>% 72 | dplyr::filter(lau_year == lau_year_filter, nuts_year == nuts_year_filter) %>% 73 | dplyr::pull(link) 74 | 75 | if (length(source_url) != 1) { 76 | usethis::ui_stop("See `ll_lau_nuts_concordance_links` for details on available combinations of lau_year and nuts_year or rely on defaults.") 77 | } 78 | 79 | if (fs::file_exists(xlsx_file) == FALSE) { 80 | download.file( 81 | url = source_url, 82 | destfile = xlsx_file 83 | ) 84 | } 85 | 86 | country_sheets <- tibble::tibble(sheet = readxl::excel_sheets(xlsx_file)) %>% 87 | dplyr::filter(nchar(.data$sheet) == 2) %>% 88 | dplyr::pull(sheet) 89 | 90 | pb <- progress::progress_bar$new(total = length(country_sheets)) 91 | corresondence_df <- purrr::map_dfr( 92 | .x = country_sheets, 93 | .f = function(current_sheet_name) { 94 | pb$tick() 95 | message(current_sheet_name) 96 | if (lau_year == 2020 & country_sheets=="IT") { 97 | if (nuts_year==2016) { 98 | current_sheet_name <- "IT NUTS 2016" 99 | } else if (nuts_year == 2021) { 100 | current_sheet_name <- "IT NUTS 2021" 101 | } 102 | current_sheet <- readxl::read_xlsx( 103 | path = xlsx_file, 104 | sheet = current_sheet_name, 105 | col_names = TRUE, 106 | col_types = "text", 107 | range = readxl::cell_cols("A:D") 108 | ) 109 | 110 | } else if (lau_year == 2020 & current_sheet_name %in% readxl::excel_sheets(xlsx_file)) { 111 | current_sheet <- readxl::read_xlsx( 112 | path = xlsx_file, 113 | sheet = current_sheet_name, 114 | col_names = TRUE, 115 | col_types = "text", 116 | range = readxl::cell_cols("A:D") 117 | ) 118 | } else if (lau_year == 2020 & nuts_year==2016) { 119 | current_sheet_name <- tibble::tibble(sheet = readxl::excel_sheets(xlsx_file)) %>% 120 | dplyr::filter(stringr::str_starts(string = sheet, pattern = current_sheet_name)) %>% 121 | dplyr::pull(sheet) 122 | 123 | current_sheet <- readxl::read_xlsx( 124 | path = xlsx_file, 125 | sheet = current_sheet_name, 126 | col_names = TRUE, 127 | col_types = "text", 128 | range = readxl::cell_cols("B:E") 129 | ) %>% 130 | dplyr::rename(`NUTS 3 CODE` = `NUTS 3 CODE 2016`) 131 | } else if (lau_year == 2020 & nuts_year==2021) { 132 | current_sheet_name <- tibble::tibble(sheet = readxl::excel_sheets(xlsx_file)) %>% 133 | dplyr::filter(stringr::str_starts(string = sheet, pattern = current_sheet_name)) %>% 134 | dplyr::pull(sheet) 135 | 136 | current_sheet <- readxl::read_xlsx( 137 | path = xlsx_file, 138 | sheet = current_sheet_name, 139 | col_names = TRUE, 140 | col_types = "text", 141 | range = readxl::cell_cols(c(1, 3:5)) 142 | ) %>% 143 | dplyr::rename(`NUTS 3 CODE` = `NUTS 3 CODE 2021`) 144 | 145 | } else { 146 | current_sheet <- readxl::read_xlsx( 147 | path = xlsx_file, 148 | sheet = current_sheet_name, 149 | col_names = TRUE, 150 | col_types = "text", 151 | range = readxl::cell_cols("A:D") 152 | ) 153 | } 154 | 155 | 156 | 157 | 158 | if (nrow(current_sheet) == 0) { 159 | return(NULL) 160 | } 161 | 162 | if (is.element("NUTS 3 CODE 2013", colnames(current_sheet))) { 163 | current_sheet <- current_sheet %>% 164 | dplyr::rename(`NUTS 3 CODE` = `NUTS 3 CODE 2013`) 165 | } 166 | 167 | if (is.element("LAU NAME alternative", colnames(current_sheet))) { 168 | current_sheet <- current_sheet %>% 169 | dplyr::rename(`LAU NAME LATIN` = `LAU NAME alternative`) 170 | } 171 | 172 | # manual fix 173 | if (current_sheet_name == "EE") { 174 | current_sheet$`LAU CODE` <- stringr::str_pad(string = current_sheet$`LAU CODE`, 175 | width = 4, side = "left", pad = "0") 176 | } 177 | if (current_sheet_name == "SI") { 178 | current_sheet$`LAU CODE` <- stringr::str_pad(string = current_sheet$`LAU CODE`, 179 | width = 3, side = "left", pad = "0") 180 | } 181 | 182 | 183 | current_sheet %>% 184 | dplyr::filter(is.na(.data$`LAU CODE`) == FALSE) %>% 185 | dplyr::transmute( 186 | country = current_sheet_name, 187 | nuts_2 = stringr::str_remove(string = `NUTS 3 CODE`, pattern = "[[:print:]]$"), 188 | nuts_3 = `NUTS 3 CODE`, 189 | lau_id = as.character(`LAU CODE`), 190 | gisco_id = stringr::str_c(current_sheet_name, "_", `LAU CODE`), 191 | lau_name_national = `LAU NAME NATIONAL`, 192 | lau_name_latin = `LAU NAME LATIN` 193 | ) 194 | } 195 | ) 196 | 197 | saveRDS( 198 | object = corresondence_df, 199 | file = rds_file 200 | ) 201 | 202 | corresondence_df 203 | } 204 | -------------------------------------------------------------------------------- /R/ll_get_lau_pt.R: -------------------------------------------------------------------------------- 1 | #' Regions and provinces in Italy (high detail, CC-BY Istat) 2 | #' 3 | #' Source: https://dados.gov.pt/pt/datasets/freguesias-de-portugal/ 4 | #' 5 | #' @param year Defaults to 2017 (latest and currently only available). 6 | #' @param level Defaults to "freguesia". Valid value include "freguesia", "concelho", "distrito", "des_simpli". 7 | #' @param id A character vector composed of six digits. Corresponds to "dicofre". 8 | #' 9 | #' @return 10 | #' @export 11 | #' 12 | #' @examples 13 | #' ll_set_folder(fs::path(fs::path_home_r(), "R")) 14 | #' ll_get_lau_pt() 15 | #' ll_get_lau_pt(name = "Porto") 16 | ll_get_lau_pt <- function(id = NULL, 17 | name = NULL, 18 | year = 2017, 19 | level = "concelho", 20 | silent = FALSE) { 21 | if (silent == FALSE) { 22 | usethis::ui_info(x = "Source: https://dados.gov.pt/pt/datasets/freguesias-de-portugal/") 23 | usethis::ui_info(x = "dados.gov.pt (CC-BY)") 24 | } 25 | 26 | if (is.null(name) == FALSE) { 27 | name <- stringr::str_to_upper(name) 28 | rds_file_location <- ll_find_file( 29 | geo = "pt", 30 | level = level, 31 | resolution = "standard", 32 | year = year, 33 | fs::path_sanitize(paste0(level, "-", stringr::str_replace_all(string = name, pattern = "[[:punct:]]", replacement = "_"))), 34 | file_type = "rds" 35 | ) 36 | 37 | if (fs::file_exists(rds_file_location)) { 38 | return(readRDS(file = rds_file_location)) 39 | } 40 | } 41 | 42 | if (is.null(id) == FALSE) { 43 | rds_file_location <- ll_find_file( 44 | geo = "pt", 45 | level = level, 46 | resolution = "standard", 47 | year = year, 48 | fs::path_sanitize(paste0(level, "-", stringr::str_replace_all(string = id, pattern = "[[:punct:]]", replacement = "_"))), 49 | file_type = "rds" 50 | ) 51 | 52 | if (fs::file_exists(rds_file_location)) { 53 | return(readRDS(file = rds_file_location)) 54 | } 55 | } 56 | 57 | 58 | rds_file <- ll_find_file( 59 | geo = "pt", 60 | level = level, 61 | resolution = "standard", 62 | year = year, 63 | name = "abl", 64 | file_type = "rds" 65 | ) 66 | 67 | if (fs::file_exists(rds_file)) { 68 | sf <- readRDS(file = rds_file) 69 | } else { 70 | ll_create_folders( 71 | geo = "pt", 72 | level = level, 73 | resolution = "standard", 74 | year = year 75 | ) 76 | ll_create_folders( 77 | geo = "pt", 78 | level = "all_levels", 79 | resolution = "standard", 80 | year = year 81 | ) 82 | 83 | shp_folder <- ll_find_file( 84 | geo = "pt", 85 | level = "all_levels", 86 | resolution = "standard", 87 | year = year, 88 | name = "abl", 89 | file_type = "shp" 90 | ) 91 | 92 | source_url <- paste0("https://dados.gov.pt/s/resources/freguesias-de-portugal/20181112-195834/cont-aad-caop2017.zip") 93 | 94 | zip_file <- ll_find_file( 95 | geo = "pt", 96 | level = "all_levels", 97 | resolution = "standard", 98 | year = year, 99 | name = "abl", 100 | file_type = "zip" 101 | ) 102 | 103 | 104 | if (fs::file_exists(zip_file) == FALSE) { 105 | download.file(url = source_url, destfile = zip_file) 106 | } 107 | 108 | unzip(zipfile = zip_file, exdir = shp_folder) 109 | 110 | 111 | sf <- sf::read_sf(shp_folder) 112 | 113 | sf <- sf %>% 114 | sf::st_transform(crs = 4326) 115 | 116 | saveRDS(object = sf, file = rds_file) 117 | } 118 | 119 | if (is.null(name) == FALSE) { 120 | if (level == "freguesia") { 121 | sf <- sf %>% 122 | dplyr::filter(Freguesia == name) 123 | } else if (level == "concelho") { 124 | sf <- sf %>% 125 | dplyr::filter(Concelho == name) 126 | } else if (level == "distrito") { 127 | sf <- sf %>% 128 | dplyr::filter(Distrito == name) 129 | } else if (level == "ses_simpli") { 130 | sf <- sf %>% 131 | dplyr::filter(Des_Simpli == name) 132 | } 133 | 134 | saveRDS( 135 | object = sf, 136 | file = rds_file_location 137 | ) 138 | } 139 | 140 | if (is.null(id) == FALSE) { 141 | if (level == "concelho") { 142 | current_id <- id 143 | current_concelho <- ll_lau_pt_id %>% 144 | dplyr::filter(id == current_id) %>% 145 | dplyr::pull(Concelho) 146 | sf <- sf %>% 147 | dplyr::filter(Concelho == current_concelho) %>% 148 | dplyr::group_by(Concelho) %>% 149 | dplyr::summarise() %>% 150 | dplyr::ungroup() 151 | } 152 | 153 | saveRDS( 154 | object = sf, 155 | file = rds_file_location 156 | ) 157 | } 158 | return(sf) 159 | } 160 | -------------------------------------------------------------------------------- /R/ll_get_nuts.R: -------------------------------------------------------------------------------- 1 | #' Get administrative boundaries 2 | #' 3 | #' Source: https://gadm.org/ 4 | #' 5 | #' @param geo Three letter country codes. If a two letter country code is given, it will tentatively be converted to a three-letter country code. Check consistency. 6 | #' @param level Defaults to 0. Available labels, depending on data availability for the specific country, between 0 and 3. 7 | #' @param version Defaults to "4.0". Untested with others. 8 | #' 9 | #' @return An `sf` object 10 | #' @export 11 | #' 12 | #' @examples 13 | #' ll_get_gadm(geo = "UKR", level = 2) 14 | ll_get_gadm <- function(geo, 15 | level = 0, 16 | version = "4.1") { 17 | usethis::ui_info("Source: https://gadm.org/") 18 | usethis::ui_info("The data are freely available for academic use and other non-commercial use. Redistribution, or commercial use, is not allowed without prior permission. Using the data to create maps for academic publishing is allowed.") 19 | 20 | if (nchar(geo)==2) { 21 | geo <- countrycode::countrycode(sourcevar = geo, 22 | origin = "iso2c", 23 | destination = "iso3c") 24 | } 25 | 26 | geo <- stringr::str_to_upper(geo) 27 | 28 | year <- stringr::str_replace(string = version, 29 | pattern = stringr::fixed("."), 30 | replacement = "_") # version 31 | resolution <- "NA" 32 | 33 | ll_create_folders( 34 | geo = geo, 35 | level = level, 36 | resolution = resolution, 37 | year = year, 38 | file_type = "rds" 39 | ) 40 | 41 | 42 | rds_file <- ll_find_file( 43 | geo = geo, 44 | level = level, 45 | resolution = resolution, 46 | year = year, 47 | name = "abl", 48 | file_type = "rds" 49 | ) 50 | 51 | 52 | if (fs::file_exists(rds_file)) { 53 | sf <- readRDS(file = rds_file) 54 | } else { 55 | shp_folder <- ll_find_file( 56 | geo = geo, 57 | level = level, 58 | resolution = resolution, 59 | year = year, 60 | name = "abl", 61 | file_type = "shp" 62 | ) 63 | 64 | source_url <- stringr::str_c("https://geodata.ucdavis.edu/gadm/gadm", 65 | version, 66 | "/shp/gadm", 67 | stringr::str_remove(version, stringr::fixed(".")), 68 | "_", 69 | geo, 70 | "_shp", 71 | ".zip") 72 | 73 | 74 | zip_file <- ll_find_file( 75 | geo = geo, 76 | level = level, 77 | resolution = resolution, 78 | year = year, 79 | name = "abl", 80 | file_type = "zip" 81 | ) 82 | 83 | 84 | ll_create_folders( 85 | geo = geo, 86 | level = level, 87 | resolution = resolution, 88 | year = year, 89 | file_type = "zip" 90 | ) 91 | 92 | if (fs::file_exists(zip_file) == FALSE) { 93 | download.file( 94 | url = source_url, 95 | destfile = zip_file 96 | ) 97 | } 98 | 99 | zip_folder <- ll_find_file( 100 | geo = geo, 101 | level = level, 102 | resolution = resolution, 103 | year = year, 104 | name = "abl", 105 | file_type = "zip" 106 | ) %>% 107 | fs::path_dir() 108 | 109 | unzip( 110 | zipfile = zip_file, 111 | exdir = shp_folder 112 | ) 113 | current_level_file <- fs::path(shp_folder, 114 | stringr::str_c("gadm", 115 | stringr::str_remove(version, stringr::fixed(".")), 116 | "_", 117 | geo, 118 | "_", 119 | level, 120 | ".shp")) 121 | 122 | sf <- sf::read_sf(current_level_file) %>% 123 | sf::st_transform(crs = 4326) 124 | 125 | 126 | saveRDS( 127 | object = sf, 128 | file = rds_file 129 | ) 130 | } 131 | 132 | return(sf) 133 | 134 | } 135 | -------------------------------------------------------------------------------- /R/ll_get_nuts_eu.R: -------------------------------------------------------------------------------- 1 | #' Gets NUTS as sf object from Eurostat's website 2 | #' 3 | #' Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/nuts#nuts16 4 | #' 5 | #' @param nuts_id NUTS id. Must correspond to the level given. e.g. "DE149" for the NUTS3 regionion of Sigmaringen in Germany. 6 | #' @param nuts_name Name of the NUTS region. Run `ll_get_nuts_eu()` to check valid values in `NUTS_NAME` column. 7 | #' @param level Defaults to 3, corresponding to nuts3. Available values are: 0, 1, 2, and 3. 8 | #' @param resolution Defaults to "60", for 1:60 Million. Available values: are 20, 10, 3, 1 (1 is highest quality available). 9 | #' @param year Defaults to 2021 Available values: 2021, 2016, 2013, 2010, 2006, 2003 10 | #' @return NUTS in sf format 11 | #' @export 12 | #' 13 | #' @examples 14 | #' ll_get_nuts_eu() 15 | ll_get_nuts_eu <- function(nuts_id = NULL, 16 | nuts_name = NULL, 17 | level = 3, 18 | resolution = 60, 19 | year = 2021, 20 | silent = FALSE) { 21 | resolution <- stringr::str_pad(string = resolution, 22 | width = 2, 23 | side = "left", 24 | pad = 0) 25 | 26 | if (silent == FALSE) { 27 | usethis::ui_info("© EuroGeographics for the administrative boundaries") 28 | usethis::ui_info("Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/countries") 29 | } 30 | 31 | ll_create_folders( 32 | geo = "eu", 33 | level = level, 34 | resolution = resolution, 35 | year = year 36 | ) 37 | 38 | ll_create_folders( 39 | geo = "eu", 40 | level = "all_levels", 41 | resolution = resolution, 42 | year = year 43 | ) 44 | 45 | rds_file <- ll_find_file( 46 | geo = "eu", 47 | level = level, 48 | resolution = resolution, 49 | year = year, 50 | name = "abl", 51 | file_type = "rds" 52 | ) 53 | 54 | if (is.null(nuts_id)==FALSE) { 55 | 56 | rds_file_location <- ll_find_file( 57 | geo = "eu", 58 | level = level, 59 | resolution = resolution, 60 | year = year, 61 | name = nuts_id, 62 | file_type = "rds" 63 | ) 64 | 65 | if (fs::file_exists(rds_file_location)) { 66 | return(readRDS(file = rds_file_location)) 67 | } 68 | } else if (is.null(nuts_name) == FALSE) { 69 | rds_file_location <- ll_find_file( 70 | geo = "eu", 71 | level = level, 72 | resolution = resolution, 73 | year = year, 74 | name = paste0(level, "-", stringr::str_replace_all(string = nuts_name, pattern = "[[:punct:]]", replacement = "_")), 75 | file_type = "rds" 76 | ) 77 | 78 | if (fs::file_exists(rds_file_location)) { 79 | return(readRDS(file = rds_file_location)) 80 | } 81 | } 82 | 83 | if (fs::file_exists(rds_file)) { 84 | sf <- readRDS(file = rds_file) 85 | } else { 86 | shp_folder <- ll_find_file( 87 | geo = "eu", 88 | level = "all_levels", 89 | resolution = resolution, 90 | year = year, 91 | name = "abl", 92 | file_type = "shp" 93 | ) 94 | 95 | shp_folder_level <- fs::path(shp_folder, paste0("NUTS_RG_", resolution, "M_", year, "_4326_LEVL_", level, ".shp")) 96 | 97 | if (fs::file_exists(shp_folder_level) == FALSE) { 98 | zip_file <- ll_find_file( 99 | geo = "eu", 100 | level = "all_levels", 101 | resolution = resolution, 102 | year = year, 103 | name = "abl", 104 | file_type = "zip" 105 | ) 106 | source_url <- paste0("https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/nuts/download/ref-nuts-", year, "-", resolution, "m.shp.zip") 107 | 108 | if (fs::file_exists(zip_file) == FALSE) { 109 | download.file( 110 | url = source_url, 111 | destfile = zip_file 112 | ) 113 | } 114 | unzip( 115 | zipfile = zip_file, 116 | exdir = shp_folder 117 | ) 118 | unzip( 119 | zipfile = paste0(shp_folder_level, ".zip"), 120 | exdir = fs::path(shp_folder, paste0("4326-nuts", level)) 121 | ) 122 | } 123 | sf <- sf::read_sf(fs::path(shp_folder, paste0("4326-nuts", level))) 124 | saveRDS( 125 | object = sf, 126 | file = rds_file 127 | ) 128 | } 129 | 130 | if (is.null(nuts_id)==FALSE) { 131 | sf <- sf %>% 132 | dplyr::filter(NUTS_ID == nuts_id) 133 | 134 | saveRDS(object = sf, 135 | file = rds_file_location) 136 | } else if (is.null(nuts_name) == FALSE) { 137 | sf <- sf %>% 138 | dplyr::filter(NUTS_NAME == nuts_name) 139 | 140 | saveRDS(object = sf, 141 | file = rds_file_location) 142 | } 143 | return(sf) 144 | } 145 | -------------------------------------------------------------------------------- /R/ll_get_nuts_it.R: -------------------------------------------------------------------------------- 1 | #' Regions and provinces in Italy (high detail, CC-BY Istat) 2 | #' 3 | #' 2019 / WGS84 UTM32N 4 | #' 5 | #' @param level Defaults to "2", i.e. regioni. Available: "3" (i.e. province), and "lau", local administrative units. 6 | #' @param year Defaults to 2023 (latest available). 7 | #' @param resolution Defaults to "low". Valid values are either "low" or "high". 8 | #' @param no_check_certificate Logical, defaults to FALSE. Enable only if certificate issues, and if you are aware of the security implications. 9 | #' 10 | #' @return 11 | #' @export 12 | #' 13 | #' @examples 14 | #' ll_set_folder(fs::path(fs::path_home_r(), "R")) 15 | #' ll_get_nuts_it() 16 | #' ll_get_nuts_it(name = "Rimini", level = 3) 17 | ll_get_nuts_it <- function(name = NULL, 18 | level = 2, 19 | year = 2023, 20 | resolution = "low", 21 | silent = FALSE, 22 | no_check_certificate = FALSE) { 23 | if (silent == FALSE) { 24 | usethis::ui_info(x = "Source: https://www.istat.it/it/archivio/222527") 25 | usethis::ui_info(x = "Istat (CC-BY)") 26 | } 27 | 28 | if (is.null(name) == FALSE) { 29 | rds_file_location <- ll_find_file( 30 | geo = "it", 31 | level = level, 32 | resolution = resolution, 33 | year = year, 34 | name = paste0(level, "-", stringr::str_replace_all(string = name, pattern = "[[:punct:]]", replacement = "_")), 35 | file_type = "rds" 36 | ) 37 | 38 | if (fs::file_exists(rds_file_location)) { 39 | return(readRDS(file = rds_file_location)) 40 | } 41 | } 42 | 43 | 44 | rds_file <- ll_find_file( 45 | geo = "it", 46 | level = level, 47 | resolution = resolution, 48 | year = year, 49 | name = "abl", 50 | file_type = "rds" 51 | ) 52 | 53 | if (fs::file_exists(rds_file)) { 54 | sf <- readRDS(file = rds_file) 55 | } else { 56 | ll_create_folders( 57 | geo = "it", 58 | level = level, 59 | resolution = resolution, 60 | year = year 61 | ) 62 | ll_create_folders( 63 | geo = "it", 64 | level = "all_levels", 65 | resolution = resolution, 66 | year = year 67 | ) 68 | 69 | shp_folder <- ll_find_file( 70 | geo = "it", 71 | level = "all_levels", 72 | resolution = resolution, 73 | year = year, 74 | name = "abl", 75 | file_type = "shp" 76 | ) 77 | 78 | type <- dplyr::if_else(condition = resolution == "high", 79 | true = "non_generalizzati", 80 | false = "generalizzati", 81 | missing = "non_generalizzati" 82 | ) 83 | 84 | g_name <- dplyr::if_else(condition = resolution == "high", 85 | true = "", 86 | false = "_g", 87 | missing = "" 88 | ) 89 | 90 | if (as.character(year)=="2023") { 91 | source_url <- paste0("https://www.istat.it/storage/cartografia/confini_amministrativi/", type, "/", year, "/Limiti0101", year, g_name, ".zip") 92 | } else { 93 | source_url <- paste0("https://www.istat.it/storage/cartografia/confini_amministrativi/", type, "/Limiti0101", year, g_name, ".zip") 94 | 95 | } 96 | 97 | zip_file <- ll_find_file( 98 | geo = "it", 99 | level = "all_levels", 100 | resolution = resolution, 101 | year = year, 102 | name = "abl", 103 | file_type = "zip" 104 | ) 105 | 106 | 107 | if (fs::file_exists(zip_file) == FALSE) { 108 | if (isTRUE(no_check_certificate)) { 109 | download.file(url = source_url, destfile = zip_file, method = "wget", extra = "--no-check-certificate") 110 | } else { 111 | download.file(url = source_url, destfile = zip_file) 112 | } 113 | } 114 | 115 | unzip(zipfile = zip_file, exdir = shp_folder) 116 | 117 | 118 | if (level == "lau") { 119 | sf <- sf::read_sf(fs::path( 120 | shp_folder, 121 | paste0("Limiti0101", year, g_name), 122 | paste0("Com0101", year, g_name) 123 | )) 124 | } else if (level == 1) { 125 | sf <- sf::read_sf(fs::path( 126 | shp_folder, 127 | paste0("Limiti0101", year, g_name), 128 | paste0("RipGeo0101", year, g_name) 129 | )) 130 | } else if (level == 2) { 131 | sf <- sf::read_sf(fs::path( 132 | shp_folder, 133 | paste0("Limiti0101", year, g_name), 134 | paste0("Reg0101", year, g_name) 135 | )) 136 | } else if (level == 3) { 137 | sf <- sf::read_sf(fs::path( 138 | shp_folder, 139 | paste0("Limiti0101", year, g_name), 140 | paste0("ProvCM0101", year, g_name) 141 | )) 142 | } 143 | sf <- sf %>% 144 | sf::st_transform(crs = 4326) 145 | 146 | saveRDS(object = sf, file = rds_file) 147 | } 148 | 149 | if (is.null(name) == FALSE) { 150 | if (level == "lau") { 151 | sf <- sf %>% 152 | dplyr::filter(COMUNE == name) 153 | } else if (level == 1) { 154 | sf <- sf %>% 155 | dplyr::filter(DEN_RIP == name) 156 | } else if (level == 2) { 157 | sf <- sf %>% 158 | dplyr::filter(DEN_REG == name) 159 | } else if (level == 3) { 160 | sf <- sf %>% 161 | dplyr::filter(DEN_PROV == name) 162 | } 163 | 164 | saveRDS( 165 | object = sf, 166 | file = rds_file_location 167 | ) 168 | } 169 | return(sf) 170 | } 171 | -------------------------------------------------------------------------------- /R/ll_get_population_grid.R: -------------------------------------------------------------------------------- 1 | #' Get EU 1km population grid 2 | #' 3 | #' Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/population-distribution-demography/geostat 4 | #' More details: https://ec.europa.eu/eurostat/statistics-explained/index.php/Population_grids 5 | #' 6 | #' @param year Defaults to 2018. Currently, the EU population grid is available only for the year 2006, 2011, and 2018. 7 | #' @param match_sf An sf object to be matched with the population grid. If not given, full grid is returned. 8 | #' @param match_name A name to be used for local caching. It is the responsibility of the user to keept it consistent. If not given, data are not cached locally. 9 | #' @param match_country Defaults to NULL. If given, used to speed up processing. 10 | #' @param population_grid_sf Defaults to NULL. If given, it uses this one as population grid of reference. Useful to bulk process items, as it removes the need for re-loading the grid from local storage at each iteration. 11 | #' @param join The function to use for filtering. Defaults to sf::st_intersects. Alternative includes the likes of sf::st_within, sf::st_touches, etc. 12 | #' 13 | #' @return An sf object with the population grid. 14 | #' @export 15 | #' 16 | #' @examples 17 | ll_get_population_grid <- function(year = 2018, 18 | match_sf = NULL, 19 | match_name = NULL, 20 | match_country = NULL, 21 | join = sf::st_intersects, 22 | silent = FALSE, 23 | population_grid_sf = NULL) { 24 | if (silent == FALSE) { 25 | usethis::ui_info(x = "Data source population grid information: Eurostat, EFGS") 26 | usethis::ui_info(x = "Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/population-distribution-demography/geostat") 27 | } 28 | 29 | if (is.null(match_country) == FALSE) { 30 | match_country <- stringr::str_to_upper(string = match_country) 31 | } 32 | 33 | if (is.null(match_name) == FALSE) { 34 | rds_file_location <- ll_find_file( 35 | geo = "eu", 36 | level = "eu", 37 | resolution = "1km", 38 | year = year, 39 | name = paste0(match_name, "-population_grid", "-", if (is.null(match_country)) "eu" else match_country), 40 | file_type = "rds" 41 | ) 42 | 43 | if (fs::file_exists(rds_file_location)) { 44 | return(readRDS(file = rds_file_location)) 45 | } 46 | } 47 | 48 | ll_create_folders( 49 | geo = "eu", 50 | level = "eu", 51 | resolution = "1km", 52 | year = year 53 | ) 54 | 55 | rds_file <- ll_find_file( 56 | geo = "eu", 57 | level = "eu", 58 | resolution = "1km", 59 | year = year, 60 | name = paste0("population_grid", "-", if (is.null(match_country)) "eu" else match_country), 61 | file_type = "rds" 62 | ) 63 | 64 | if (is.null(population_grid_sf) == FALSE) { 65 | sf <- population_grid_sf 66 | } else if (fs::file_exists(rds_file)) { 67 | sf <- readRDS(file = rds_file) 68 | } else { 69 | shp_folder <- ll_find_file( 70 | geo = "eu", 71 | level = "eu", 72 | resolution = "1km", 73 | year = year, 74 | name = "population_grid", 75 | file_type = "shp" 76 | ) 77 | 78 | zip_file <- ll_find_file( 79 | geo = "eu", 80 | level = "eu", 81 | resolution = "1km", 82 | year = year, 83 | name = "population_grid", 84 | file_type = "zip" 85 | ) 86 | 87 | if (year == 2018) { 88 | source_url <- "https://ec.europa.eu/eurostat/cache/GISCO/geodatafiles/JRC_GRID_2018.zip" 89 | } else if (year == 2011) { 90 | source_url <- "https://ec.europa.eu/eurostat/cache/GISCO/geodatafiles/GEOSTAT-grid-POP-1K-2011-V2-0-1.zip" 91 | } else if (year == 2006) { 92 | source_url <- "https://ec.europa.eu/eurostat/cache/GISCO/geodatafiles/GEOSTAT_Grid_POP_2006_1K.zip" 93 | } else { 94 | ( 95 | usethis::ui_stop("Please provide a valid year.") 96 | ) 97 | } 98 | 99 | 100 | 101 | if (fs::file_exists(zip_file) == FALSE) { 102 | download.file( 103 | url = source_url, 104 | destfile = zip_file 105 | ) 106 | } 107 | unzip( 108 | zipfile = zip_file, 109 | exdir = shp_folder 110 | ) 111 | 112 | if (year == 2018) { 113 | sf <- sf::read_sf(fs::path(shp_folder), layer = "JRC_POPULATION_2018") %>% 114 | sf::st_transform(crs = 4326) 115 | } else if (year == 2011) { 116 | sf <- sf::read_sf(fs::path(shp_folder, "Version 2_0_1", "GEOSTATReferenceGrid")) %>% 117 | dplyr::right_join(readr::read_csv(fs::path(shp_folder, "Version 2_0_1", "GEOSTAT_grid_POP_1K_2011_V2_0_1.csv")), 118 | by = "GRD_ID" 119 | ) %>% 120 | sf::st_transform(crs = 4326) 121 | } else if (year == 2006) { 122 | sf <- sf::read_sf(fs::path(shp_folder)) %>% 123 | dplyr::rename(GRD_ID = .data$GRD_INSPIR) %>% 124 | dplyr::right_join(readr::read_delim( 125 | file = fs::path(shp_folder, "GEOSTAT_grid_EU_POP_2006_1K_V1_1_1.csv"), 126 | delim = ";", 127 | col_names = c("GRD_ID", "POP_TOT", "YEAR", "METHD_CL", "CNTR_CODE", "DATA_SRC"), 128 | col_types = "c", 129 | ), 130 | by = "GRD_ID" 131 | ) %>% 132 | sf::st_transform(crs = 4326) 133 | } 134 | 135 | 136 | if (is.null(match_country) == FALSE) { 137 | if (year == 2018) { 138 | sf <- sf %>% 139 | dplyr::filter(stringr::str_detect( 140 | string = CNTR_ID, 141 | pattern = match_country 142 | )) 143 | } else { 144 | sf <- sf %>% 145 | dplyr::filter(stringr::str_detect( 146 | string = CNTR_CODE, 147 | pattern = match_country 148 | )) 149 | } 150 | } 151 | saveRDS( 152 | object = sf, 153 | file = rds_file 154 | ) 155 | } 156 | 157 | if (is.null(match_sf) == FALSE) { 158 | sf <- sf::st_filter( 159 | x = sf %>% sf::st_transform(crs = 4326), 160 | y = match_sf %>% sf::st_transform(crs = 4326), 161 | .predicate = join 162 | ) 163 | } 164 | 165 | if (is.null(match_name) == FALSE) { 166 | saveRDS( 167 | object = sf, 168 | file = rds_file_location 169 | ) 170 | } 171 | return(sf) 172 | } 173 | -------------------------------------------------------------------------------- /R/ll_get_population_grid_high_resolution.R: -------------------------------------------------------------------------------- 1 | #' Get High Resolution Population Density Maps + Demographic Estimates 2 | #' 3 | #' Source: https://data.humdata.org/organization/facebook 4 | #' Details on methodology: https://dataforgood.fb.com/docs/methodology-high-resolution-population-density-maps-demographic-estimates/ 5 | #' 6 | #' @param geo A twe letter country code, such as "IT" for Italy and "DE" for Germany 7 | #' @param match_sf An sf object to me matched with the population grid. If not given, full grid is returned. 8 | #' @param match_name A name to be used for local caching if a subset of the grid is used. It is the responsibility of the user to keept it consistent. If not given, data are not cached locally. 9 | #' @param source_url A direct link to the zipped version of the csv file in the original database, if automatic download with the country code does not work. For example, for Italy this would be "https://data.humdata.org/dataset/0eb77b21-06be-42c8-9245-2edaff79952f/resource/1e96f272-7d86-4108-b4ca-5a951a8b11a0/download/population_ita_2019-07-01.csv.zip" 10 | #' @param file_format Defaults to "CSV". Other available formats include "GeoTIFF", "JSON", "zip", "GDAL Virtual Format". Currently only CSV supported. 11 | #' @param dataset Defaults to "population". Beginning of the name of the dataset. For alternatives, see e.g. `population_grid_hr_metadata %>% dplyr::filter(country_code=="IT") %>% dplyr::distinct(name)`. Currently only tested with default value. 12 | #' @param join 13 | #' @param silent 14 | #' 15 | #' @return 16 | #' @export 17 | #' 18 | #' @examples 19 | ll_get_population_grid_hr <- function(geo, 20 | match_sf = NULL, 21 | match_name = NULL, 22 | population_grid_sf = NULL, 23 | join = sf::st_intersects, 24 | file_format = "CSV", 25 | dataset = "population|general", 26 | source_url = NULL, 27 | silent = FALSE) { 28 | if (silent == FALSE) { 29 | usethis::ui_info(x = paste("Facebook Connectivity Lab and Center for International Earth Science Information Network - CIESIN - Columbia University. 2016. High Resolution Settlement Layer (HRSL). Source imagery for HRSL © 2016 DigitalGlobe. Accessed", Sys.Date())) 30 | usethis::ui_info(x = "License: Creative Commons Attribution International") 31 | usethis::ui_info(x = "Source: https://data.humdata.org/organization/facebook") 32 | } 33 | 34 | if (is.null(geo) == FALSE) { 35 | geo <- stringr::str_to_upper(string = geo) 36 | } 37 | 38 | if (is.null(source_url)==TRUE) { 39 | source_url <- latlon2map::population_grid_hr_metadata %>% 40 | dplyr::filter(.data$format == file_format, country_code==geo) %>% 41 | dplyr::filter(stringr::str_detect(string = name, pattern = dataset)) %>% 42 | dplyr::distinct() %>% 43 | dplyr::pull(download_url) 44 | } 45 | 46 | if (is.null(match_name) == FALSE) { 47 | rds_file_location <- ll_find_file( 48 | geo = geo, 49 | level = 0, 50 | resolution = "hr", 51 | year = 2020, 52 | name = paste0(match_name, "-hr_population_grid", "-", geo), 53 | file_type = "rds" 54 | ) 55 | 56 | if (fs::file_exists(rds_file_location)) { 57 | return(readRDS(file = rds_file_location)) 58 | } 59 | } 60 | 61 | ll_create_folders( 62 | geo = geo, 63 | level = 0, 64 | resolution = "hr", 65 | year = 2020, 66 | file_type = c("zip", "csv", "rds") 67 | ) 68 | 69 | rds_file <- ll_find_file( 70 | geo = geo, 71 | level = 0, 72 | resolution = "hr", 73 | year = 2020, 74 | name = paste0("population_grid_hr", "-", geo), 75 | file_type = "rds" 76 | ) 77 | if (is.null(population_grid_sf) == FALSE) { 78 | sf <- population_grid_sf 79 | } else if (fs::file_exists(rds_file) & is.null(match_sf)) { 80 | sf <- readRDS(file = rds_file) 81 | } else { 82 | csv_folder <- ll_find_file( 83 | geo = geo, 84 | level = 0, 85 | resolution = "hr", 86 | year = 2020, 87 | name = paste0("population_grid", "-", geo), 88 | file_type = "csv" 89 | ) %>% fs::path_dir() 90 | 91 | zip_file <- ll_find_file( 92 | geo = geo, 93 | level = 0, 94 | resolution = "hr", 95 | year = 2020, 96 | name = paste0("population_grid", "-", geo), 97 | file_type = "zip" 98 | ) 99 | 100 | if (fs::file_exists(zip_file) == FALSE) { 101 | download.file( 102 | url = source_url, 103 | destfile = zip_file 104 | ) 105 | } 106 | 107 | file_name <- stringr::str_split(source_url, "/") %>% 108 | unlist() %>% 109 | dplyr::last() %>% 110 | stringr::str_replace("_csv\\.zip$|\\.csv\\.zip$", ".csv") %>% 111 | stringr::str_to_lower() 112 | 113 | if (fs::file_exists(fs::path(csv_folder, file_name)) == FALSE) { 114 | unzip( 115 | zipfile = zip_file, 116 | exdir = csv_folder 117 | ) 118 | fs::dir_walk( 119 | path = csv_folder, 120 | fun = function(x) { 121 | fs::file_move( 122 | path = x, 123 | new_path = fs::path( 124 | fs::path_dir(x), 125 | stringr::str_to_lower(fs::path_file(x)) 126 | ) 127 | ) 128 | } 129 | ) 130 | } 131 | df <- readr::read_csv( 132 | file = fs::path(csv_folder, file_name)) 133 | #dplyr::filter(.data$Population>0) 134 | 135 | if (colnames(df)[1]=="longitude") { 136 | colnames(df) <- c("Lon", "Lat", "Population") 137 | 138 | } else if (colnames(df)[1]=="latitude") { 139 | colnames(df) <- c("Lat", "Lon", "Population") 140 | } 141 | df <- df %>% 142 | dplyr::select("Lat", "Lon", "Population") %>% 143 | dplyr::filter(is.na(.data$Lat)==FALSE, is.na(.data$Population)==FALSE) 144 | if (is.null(match_sf) == FALSE) { 145 | bbox <- sf::st_bbox(match_sf) 146 | df <- df %>% 147 | dplyr::filter(Lat >= bbox$ymin, Lat <= bbox$ymax, Lon >= bbox$xmin, Lat <= bbox$ymax) 148 | 149 | sf <- df %>% 150 | sf::st_as_sf(coords = c("Lon", "Lat"), crs = 4326) 151 | 152 | sf <- sf::st_filter( 153 | x = sf %>% sf::st_transform(crs = 3857), 154 | y = match_sf %>% sf::st_transform(crs = 3857), 155 | join = join 156 | ) %>% 157 | sf::st_transform(crs = 4326) 158 | 159 | if (is.null(match_name) == FALSE) { 160 | saveRDS( 161 | object = sf, 162 | file = rds_file_location 163 | ) 164 | } 165 | 166 | return(sf) 167 | } 168 | sf <- df %>% 169 | sf::st_as_sf(coords = c("Lon", "Lat"), 170 | crs = 4326) 171 | 172 | saveRDS( 173 | object = sf, 174 | file = rds_file 175 | ) 176 | 177 | return(sf) 178 | } 179 | 180 | if (is.null(match_sf) == FALSE) { 181 | 182 | sf <- sf::st_filter( 183 | x = sf %>% sf::st_transform(crs = 4326), 184 | y = match_sf %>% sf::st_transform(crs = 4326), 185 | .predicate = join 186 | ) 187 | 188 | if (is.null(match_name) == FALSE) { 189 | saveRDS( 190 | object = sf, 191 | file = rds_file_location 192 | ) 193 | } 194 | } 195 | 196 | return(sf) 197 | } 198 | -------------------------------------------------------------------------------- /R/ll_get_us.R: -------------------------------------------------------------------------------- 1 | #' Get US counties 2 | #' 3 | #' Source: https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html 4 | #' 5 | #' @param level Defaults to "county". Available options are: "cd116" (for congressional districts of the 116th Congress) 6 | #' @param resolution Defaults to "500k", max available resolution. Available options are: "5m" and "20m" 7 | #' @param year Defaults to 2018 8 | #' 9 | #' @return 10 | #' @export 11 | #' 12 | #' @examples 13 | #' ll_get_nuts_us(level = "county", resolution = "500k", year = 2018) 14 | ll_get_nuts_us <- function(level = "county", 15 | resolution = "500k", 16 | year = 2018) { 17 | usethis::ui_info("Source: https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html") 18 | ll_create_folders( 19 | geo = "us", 20 | level = level, 21 | resolution = resolution, 22 | year = year 23 | ) 24 | 25 | rds_file <- ll_find_file( 26 | geo = "us", 27 | level = level, 28 | resolution = resolution, 29 | year = year, 30 | name = "abl", 31 | file_type = "rds" 32 | ) 33 | 34 | if (fs::file_exists(rds_file)) { 35 | return(readRDS(file = rds_file)) 36 | } 37 | 38 | shp_folder <- ll_find_file( 39 | geo = "us", 40 | level = level, 41 | resolution = resolution, 42 | year = year, 43 | name = "abl", 44 | file_type = "shp" 45 | ) 46 | 47 | zip_file <- ll_find_file( 48 | geo = "us", 49 | level = level, 50 | resolution = resolution, 51 | year = year, 52 | name = "abl", 53 | file_type = "zip" 54 | ) 55 | source_url <- paste0("https://www2.census.gov/geo/tiger/GENZ2018/shp/cb_", year, "_us_", level, "_", resolution, ".zip") 56 | 57 | if (fs::file_exists(zip_file) == FALSE) { 58 | download.file( 59 | url = source_url, 60 | destfile = zip_file 61 | ) 62 | } 63 | unzip( 64 | zipfile = zip_file, 65 | exdir = shp_folder 66 | ) 67 | sf <- sf::read_sf(shp_folder) 68 | saveRDS( 69 | object = sf, 70 | file = rds_file 71 | ) 72 | return(sf) 73 | } 74 | -------------------------------------------------------------------------------- /R/ll_get_world.R: -------------------------------------------------------------------------------- 1 | #' Get countries as an sf object 2 | #' 3 | #' @param resolution Defaults to "60", for 1:60 Million. Available values: are 20, 10, 3, 1 (1 is highest quality available)- 4 | #' @param year Defaults to 2020. Available values: 2020, 2016, 2013, 2010, 2006, 2001 5 | #' 6 | #' @return 7 | #' @export 8 | #' 9 | #' @examples 10 | ll_get_world <- function(resolution = "60", 11 | year = 2020, 12 | name = NULL) { 13 | resolution <- stringr::str_pad( 14 | string = resolution, 15 | width = 2, 16 | side = "left", 17 | pad = 0 18 | ) 19 | usethis::ui_info("Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/countries") 20 | usethis::ui_info("© EuroGeographics for the administrative boundaries") 21 | ll_create_folders( 22 | geo = "world", 23 | level = "country", 24 | resolution = resolution, 25 | year = year 26 | ) 27 | 28 | rds_file <- ll_find_file( 29 | geo = "world", 30 | level = "country", 31 | resolution = resolution, 32 | year = year, 33 | name = "abl", 34 | file_type = "rds" 35 | ) 36 | 37 | if (fs::file_exists(rds_file)) { 38 | return(readRDS(file = rds_file)) 39 | } 40 | 41 | shp_folder <- ll_find_file( 42 | geo = "world", 43 | level = "country", 44 | resolution = resolution, 45 | year = year, 46 | name = "abl", 47 | file_type = "shp" 48 | ) 49 | if (fs::file_exists(fs::path(shp_folder, paste0("CNTR_RG_", resolution, "M_", year, "_4326.shp"))) == FALSE) { 50 | zip_file <- ll_find_file( 51 | geo = "world", 52 | level = "country", 53 | resolution = resolution, 54 | year = year, 55 | name = "abl", 56 | file_type = "zip" 57 | ) 58 | source_url <- paste0("https://ec.europa.eu/eurostat/cache/GISCO/distribution/v2/countries/download/ref-countries-", year, "-", resolution, "m.shp.zip") 59 | 60 | if (fs::file_exists(zip_file) == FALSE) { 61 | download.file( 62 | url = source_url, 63 | destfile = zip_file 64 | ) 65 | } 66 | unzip( 67 | zipfile = zip_file, 68 | exdir = shp_folder 69 | ) 70 | unzip( 71 | zipfile = fs::path(shp_folder, paste0("CNTR_RG_", resolution, "M_", year, "_4326.shp.zip")), 72 | exdir = shp_folder 73 | ) 74 | } 75 | sf <- sf::read_sf(fs::path(shp_folder, paste0("CNTR_RG_", resolution, "M_", year, "_4326.shp"))) %>% 76 | sf::st_transform(crs = 4326) 77 | saveRDS( 78 | object = sf, 79 | file = rds_file 80 | ) 81 | return(sf) 82 | } 83 | -------------------------------------------------------------------------------- /R/ll_match_geo.R: -------------------------------------------------------------------------------- 1 | #' Matches a data frame with longitude and latitude to an sf object 2 | #' 3 | #' @param data A data frame or tibble with a column for longitude and one for latitude or an onject of the sf class. If an sf object is given, the longitude and latitude parameters are ignored. 4 | #' @param longitude The exact column name or the column index (e.g. 1 if first column) for longitude. Defaults to 1. 5 | #' @param latitude The exact column name or the column index (e.g. 1 if first column) for latitude. Defaults to 2. 6 | #' @param join A function of the sf class determining the type of join. Defaults to `sf::st_intersects`. Check `?sf::st_join` for alternatives. 7 | #' @param sample Defaults to NULL. If given, it runs the matching with only a subset of the original dataframe. Suggested for testing in particular when working with big datasets. 8 | #' @param match An sf object to be matched with the given dataframe, defaults to `longlat2map::ll_get_world()`. This package facilitate obtaining alternative reference maps with functions such as `longlat2map::ll_get_nuts_eu()` and `longlat2map::ll_get_nuts_us()` 9 | #' 10 | #' @return An sf object with CRS 4326. 11 | #' @export 12 | #' 13 | #' @examples 14 | ll_match <- function(data, 15 | longitude = 1, 16 | latitude = 2, 17 | join = sf::st_intersects, 18 | sample = NULL, 19 | match = longlat2map::ll_get_world()) { 20 | if (is.null(sample) == FALSE) { 21 | data <- data %>% dplyr::sample_n(size = sample) 22 | } 23 | 24 | if (is.element("sf", class(data)) == FALSE) { 25 | sf_data <- data %>% 26 | sf::st_as_sf(coords = c(longitude, latitude), crs = 4326) 27 | } else { 28 | sf_data <- data 29 | } 30 | 31 | sf::st_join(sf_data %>% sf::st_transform(crs = 4326), 32 | match %>% sf::st_transform(crs = 4326), 33 | join = join 34 | ) 35 | } 36 | -------------------------------------------------------------------------------- /R/ll_osm.R: -------------------------------------------------------------------------------- 1 | #' Extract from zip shape files of roads from previously downloaded 2 | #' 3 | #' @param countries The name of one or more geographic entities from files typically previously downloaded with `ll_osm_download()` 4 | #' @param download_if_missing Logical, defaults to TRUE. If TRUE, downloads country files with `ll_osm_download()` if they are not available locally. 5 | #' @param overwrite Logical, defaults to FALSE. If TRUE, extracts files from zip even if folder already existing. 6 | #' @return Nothing, used for its side effects (extracts shapefiles from country-level zip files) 7 | #' @examples 8 | #' \dontrun{ 9 | #' ll_extract_roads(countries = "Romania") 10 | #' } 11 | #' 12 | #' @export 13 | #' 14 | 15 | ll_osm_extract_roads <- function(countries, 16 | download_if_missing = TRUE, 17 | overwrite = FALSE) { 18 | base_folder <- fs::path( 19 | latlon2map::ll_set_folder(), 20 | "osm_roads_shp" 21 | ) 22 | 23 | fs::dir_create(path = base_folder, recurse = TRUE) 24 | 25 | fs::dir_create(path = fs::path( 26 | latlon2map::ll_set_folder(), 27 | "osm_roads_shp" 28 | )) 29 | 30 | purrr::walk( 31 | .x = tolower(countries), 32 | .f = function(current_country) { 33 | current_country_zip_folder <- fs::path( 34 | latlon2map::ll_set_folder(), 35 | "osm_countries_shp_zip", 36 | current_country 37 | ) 38 | if (fs::file_exists(current_country_zip_folder) == FALSE) { 39 | if (download_if_missing == TRUE) { 40 | cli::cli_inform("'{current_country}' is not available locally. It will now be downloaded.") 41 | ll_osm_download(countries = current_country) 42 | ll_osm_extract_roads( 43 | countries = current_country, 44 | download_if_missing = FALSE, 45 | overwrite = FALSE 46 | ) 47 | } else { 48 | cli::cli_inform("'{current_country}' is not available locally. You can download it with 'll_osm_download('{current_country}')'.") 49 | cli::cli_inform("{current_country} not available.") 50 | } 51 | } else { 52 | local_files <- fs::dir_ls( 53 | path = current_country_zip_folder, 54 | recurse = FALSE, 55 | type = "file", 56 | glob = "*.shp.zip" 57 | ) 58 | 59 | purrr::walk( 60 | .x = local_files, 61 | .f = function(current_zip_file) { 62 | files_to_extract <- unzip( 63 | zipfile = current_zip_file, 64 | list = TRUE 65 | ) %>% 66 | tibble::as_tibble() %>% 67 | dplyr::filter(stringr::str_detect(string = Name, 68 | pattern = "roads")) %>% 69 | dplyr::pull(Name) 70 | 71 | current_street_shp_folder <- 72 | fs::path( 73 | latlon2map::ll_set_folder(), 74 | "osm_roads_shp", 75 | current_country, 76 | current_zip_file %>% 77 | fs::path_file() %>% 78 | stringr::str_remove(pattern = "-latest-free.shp.zip") 79 | ) 80 | 81 | if (fs::file_exists(path = current_street_shp_folder) == FALSE | overwrite == TRUE) { 82 | unzip( 83 | zipfile = current_zip_file, 84 | files = files_to_extract, 85 | exdir = current_street_shp_folder 86 | ) 87 | date_extracted <- fs::file_info(path = current_zip_file) %>% 88 | dplyr::pull(birth_time) %>% 89 | as.Date() 90 | 91 | saveRDS(object = date_extracted, 92 | file = fs::path(current_street_shp_folder, "date_extracted.rds")) 93 | } 94 | cli::cli_inform(c("i" = "Files have been extracted to {.path {current_street_shp_folder}}")) 95 | } 96 | ) 97 | } 98 | } 99 | ) 100 | } 101 | 102 | #' Extract shape files of roads from previously downloaded 103 | #' 104 | #' @param country The name of one or more geographic entities from files typically previously downloaded with `ll_osm_download()` 105 | #' @param silent Defaults to FALSE. If TRUE, hides copyright notice. Useful e.g. when using this in reports or in loops. The copyright notice must still be shown where the final output is used. 106 | #' @return All roads in a country by OpenStreetMap. 107 | #' @examples 108 | #' \dontrun{ 109 | #' ll_osm_get_roads(country = "Romania") 110 | #' } 111 | #' 112 | #' @export 113 | #' 114 | 115 | ll_osm_get_roads <- function(country, 116 | silent = FALSE) { 117 | if (silent == FALSE) { 118 | usethis::ui_info(x = "© OpenStreetMap contributors") 119 | } 120 | country <- stringr::str_to_lower(country) 121 | 122 | country_street_shp_folder <- 123 | fs::path( 124 | latlon2map::ll_set_folder(), 125 | "osm_roads_shp", 126 | country 127 | ) 128 | 129 | if (fs::file_exists(country_street_shp_folder) == FALSE) { 130 | ll_osm_extract_roads(countries = country) 131 | } 132 | 133 | street_folders <- fs::dir_ls( 134 | path = country_street_shp_folder, 135 | type = "directory", 136 | recurse = FALSE 137 | ) 138 | 139 | if (length(street_folders)==1) { 140 | x <- street_folders[[1]] 141 | current_sf <- sf::st_read(dsn = x) 142 | 143 | if (fs::file_exists(path = fs::path(x, "date_extracted.rds"))) { 144 | date_extracted_v <- readRDS(file = fs::path(x, "date_extracted.rds")) 145 | attr(current_sf, "date_extracted") <- date_extracted_v 146 | } 147 | return(current_sf) 148 | 149 | } else { 150 | all_sf <- purrr::map_dfr( 151 | .x = street_folders, 152 | .f = function(x) { 153 | current_sf <- sf::st_read(dsn = x) 154 | 155 | if (fs::file_exists(path = fs::path(x, "date_extracted.rds"))) { 156 | date_extracted_v <- readRDS(file = fs::path(x, "date_extracted.rds")) 157 | attr(current_sf, "date_extracted") <- date_extracted_v 158 | } 159 | return(current_sf) 160 | } 161 | ) 162 | if (fs::file_exists(path = fs::path(street_folders[[1]], "date_extracted.rds"))) { 163 | date_extracted_v <- readRDS(file = fs::path(street_folders[[1]], "date_extracted.rds")) 164 | attr(all_sf, "date_extracted") <- date_extracted_v 165 | } 166 | } 167 | } 168 | -------------------------------------------------------------------------------- /R/ll_osm_download.R: -------------------------------------------------------------------------------- 1 | #' Download OSM data for whole countries from Geofabrik. 2 | #' 3 | #' N.B. Names do not always correspond to official name of countries and may include different geographic entities. 4 | #' For a full list of available "countries" as made available by Geofabrik, see the internal dataset `ll_osm_countries`. 5 | #' Be considered in downloading files. 6 | #' 7 | #' @param countries One or more country names. For details on available country names see the dataset included in this package: `ll_osm_countries` 8 | #' @param overwrite Logical, defaults to FALSE. If true, downloads new files even if already present. 9 | #' @param wget Logical, defaults to FALSE. If TRUE, it downloads files with wget (if available), otherwise uses default method. Setting wget to TRUE may contribute to prevent download timeouts; notice that apparent freeze of the download progress in the console are common, and mostly the download is just continuing in the background (for reference, check file size in folder.) 10 | #' @return Used only for its side effects (downloads osm data). 11 | #' @examples 12 | #' \dontrun{ 13 | #' ll_osm_download(countries = "Romania") 14 | #' ll_osm_download(countries = c("chile", "colombia")) 15 | #' } 16 | #' @export 17 | ll_osm_download <- function(countries, 18 | overwrite = FALSE, 19 | wget = FALSE) { 20 | countries_available_l <- is.element(stringr::str_to_lower(countries), ll_osm_countries$country) 21 | if (Reduce(x = countries_available_l, f = `&`) == FALSE) { 22 | missing_countries <- glue::glue_collapse(x = countries[!countries_available_l], sep = ", ", last = ", and ") 23 | usethis::ui_oops("The following countries are not available: {missing_countries}") 24 | usethis::ui_info("See the internal dataset `ll_osm_countries` for a list of available countries and geographic entities") 25 | usethis::ui_stop("Please input an accepted geographic entity name") 26 | } 27 | 28 | downloads_df <- tibble::tibble(country = tolower(countries)) %>% 29 | dplyr::left_join(y = ll_osm_countries, by = "country") %>% 30 | tidyr::unnest(link) 31 | 32 | base_folder <- fs::path(latlon2map::ll_set_folder(), "osm_countries_shp_zip") 33 | fs::dir_create(path = base_folder, recurse = TRUE) 34 | 35 | purrr::pwalk( 36 | .l = downloads_df, 37 | .f = function(country, continent, link) { 38 | country_folder <- fs::path( 39 | base_folder, 40 | country 41 | ) 42 | local_file <- fs::path(country_folder, fs::path_file(link)) 43 | if (fs::file_exists(local_file) == FALSE | overwrite == TRUE) { 44 | fs::dir_create(country_folder) 45 | usethis::ui_info(x = "If the download is not successful, please download manually - {usethis::ui_path(link)} - and store in this location: {usethis::ui_path(local_file)}") 46 | if (wget == TRUE) { 47 | download.file(url = link, destfile = local_file, method = "wget") 48 | } else { 49 | download.file(url = link, destfile = local_file) 50 | } 51 | } 52 | } 53 | ) 54 | } 55 | 56 | 57 | 58 | 59 | #' Download OSM data in geopackage format for regions, provinces, and municipalities in Italy. 60 | #' 61 | #' See `ll_osm_it_gpkg` for all available files. 62 | #' 63 | #' @param level One of "regioni", "provincie", "comuni". Defaults to "comuni". 64 | #' @param name Name of geographic entity. Check `ll_osm_it_gpkg` or `ll_get_nuts_it()` for valid names. 65 | #' @param code Used in alternative to name. Check `ll_osm_it_gpkg` or `ll_get_nuts_it()` for valid values. 66 | #' @param wget Logical, defaults to FALSE. If TRUE, it downloads files with wget (if available), otherwise uses default method. Setting wget to TRUE may contribute to prevent download timeouts; notice that apparent freeze of the download progress in the console are common, and mostly the download is just continuing in the background (for reference, check file size in folder.) 67 | #' @param quiet Logical, defaults to FALSE. If TRUE no messages about download advancement are printed. 68 | #' @return Used only for its side effects (downloads osm data). 69 | #' @examples 70 | #' \dontrun{ 71 | #' ll_osm_download_it(level = "comuni", name = "Trento") 72 | #' } 73 | #' @export 74 | ll_osm_download_it <- function(level = "comuni", 75 | name = NULL, 76 | code = NULL, 77 | overwrite = FALSE, 78 | wget = FALSE, 79 | quiet = FALSE) { 80 | if (is.null(name) == FALSE) { 81 | available_l <- is.element(stringr::str_to_lower(name), stringr::str_to_lower(ll_osm_it_gpkg[[level]]$name)) 82 | if (Reduce(x = available_l, f = `&`) == FALSE) { 83 | missing_names <- glue::glue_collapse( 84 | x = name[!available_l], 85 | sep = ", ", 86 | last = ", and " 87 | ) 88 | if (quiet == FALSE) { 89 | usethis::ui_oops("The following places are not available: {missing_names}") 90 | usethis::ui_info("See the internal dataset `ll_osm_it_gpkg` for a list of available places") 91 | usethis::ui_stop("Please input an accepted geographic entity name") 92 | } 93 | } 94 | 95 | downloads_df <- tibble::tibble( 96 | name = stringr::str_to_lower(name), 97 | level = stringr::str_to_lower(level) 98 | ) %>% 99 | dplyr::left_join( 100 | y = ll_osm_it_gpkg[[level]] %>% 101 | dplyr::mutate(name = stringr::str_to_lower(name)), 102 | by = "name" 103 | ) 104 | } else if (is.null(code) == FALSE) { 105 | if (is.null(code) == FALSE) { 106 | available_l <- is.element(as.numeric(code), as.numeric(ll_osm_it_gpkg[[level]]$code)) 107 | if (Reduce(x = available_l, f = `&`) == FALSE) { 108 | missing_codes <- glue::glue_collapse( 109 | x = code[!available_l], 110 | sep = ", ", 111 | last = ", and " 112 | ) 113 | if (quiet == FALSE) { 114 | usethis::ui_oops("The following places are not available: {missing_codes}") 115 | usethis::ui_info("See the internal dataset `ll_osm_it_gpkg` for a list of available places") 116 | usethis::ui_stop("Please input an accepted geographic entity name") 117 | } 118 | } 119 | downloads_df <- tibble::tibble( 120 | code = code, 121 | level = stringr::str_to_lower(level) 122 | ) %>% 123 | dplyr::left_join( 124 | y = ll_osm_it_gpkg[[level]], 125 | by = "code" 126 | ) 127 | } 128 | } 129 | 130 | 131 | 132 | base_folder <- fs::path( 133 | latlon2map::ll_set_folder(), 134 | "osm_it_gpkg", 135 | stringr::str_to_lower(level) 136 | ) 137 | fs::dir_create(path = base_folder, recurse = TRUE) 138 | 139 | purrr::pwalk( 140 | .l = downloads_df, 141 | .f = function(name, code, level, link) { 142 | local_file <- fs::path(base_folder, fs::path_file(link)) 143 | if (fs::file_exists(local_file) == FALSE | overwrite == TRUE) { 144 | fs::dir_create(base_folder) 145 | usethis::ui_info(x = "If the download is not successful, please download manually - {usethis::ui_path(link)} - and store in this location: {usethis::ui_path(local_file)}") 146 | if (wget == TRUE) { 147 | download.file( 148 | url = link, 149 | destfile = local_file, 150 | method = "wget", 151 | quiet = quiet 152 | ) 153 | } else { 154 | download.file( 155 | url = link, 156 | destfile = local_file, 157 | quiet = quiet 158 | ) 159 | } 160 | } 161 | } 162 | ) 163 | } 164 | 165 | 166 | #' Extract OSM data for regions, provinces, and municipalities in Italy. 167 | #' 168 | #' See `ll_osm_it_gpkg` for all available files. 169 | #' 170 | #' @param level One of "regioni", "provincie", "comuni". Defaults to "comuni". 171 | #' @param name Name of geographic entity. Check `ll_osm_it_gpkg` or `ll_get_nuts_it()` for valid names. 172 | #' @param code Used in alternative to name. Check `ll_osm_it_gpkg` or `ll_get_nuts_it()` for valid values. 173 | #' @param layer Defaults to "lines". Must be one of "points", "lines", "multilinestrings", "multipolygons", or "other_relations" 174 | #' @param quiet Logical, defaults to FALSE. If TRUE, supresses messages generated when reading the geopackage file. 175 | #' 176 | #' @return An sf object. 177 | #' @export 178 | #' 179 | #' @examples 180 | #' \dontrun{ 181 | #' ll_osm_extract_it(level = "comuni", name = "Trento") 182 | #' } 183 | #' 184 | ll_osm_extract_it <- function(level = "comuni", 185 | name = NULL, 186 | code = NULL, 187 | layer = "lines", 188 | quiet = FALSE) { 189 | ll_osm_download_it( 190 | level = level, 191 | name = name, 192 | code = code, 193 | quiet = quiet 194 | ) 195 | 196 | base_folder <- fs::path( 197 | latlon2map::ll_set_folder(), 198 | "osm_it_gpkg", 199 | stringr::str_to_lower(level) 200 | ) 201 | 202 | available_files <- fs::dir_ls( 203 | path = base_folder, 204 | recurse = FALSE, 205 | type = "file", 206 | glob = "*.gpkg" 207 | ) %>% 208 | tibble::enframe( 209 | name = NULL, 210 | value = "local_files" 211 | ) %>% 212 | dplyr::mutate(filename = fs::path_file(local_files)) %>% 213 | dplyr::mutate(code = stringr::str_extract( 214 | string = filename, 215 | pattern = "[[:digit:]]+" 216 | )) %>% 217 | dplyr::left_join( 218 | y = ll_osm_it_gpkg[[level]], 219 | by = "code" 220 | ) %>% 221 | dplyr::mutate( 222 | name = stringr::str_to_lower(name), 223 | code = as.numeric(code) 224 | ) 225 | 226 | 227 | if (is.null(name) == FALSE) { 228 | selected_files <- tibble::tibble(name = stringr::str_to_lower(name)) %>% 229 | dplyr::left_join(y = available_files, by = "name") 230 | } else if (is.null(code) == FALSE) { 231 | selected_files <- tibble::tibble(code = as.numeric(code)) %>% 232 | dplyr::left_join(y = available_files, by = "code") 233 | } 234 | 235 | extracted_sf <- sf::st_read( 236 | dsn = selected_files[["local_files"]], 237 | layer = layer, 238 | quiet = quiet 239 | ) 240 | 241 | extracted_sf 242 | } 243 | -------------------------------------------------------------------------------- /R/ll_set_folder.R: -------------------------------------------------------------------------------- 1 | #' Set folder for caching data 2 | #' 3 | #' @param path A path to a location. If the folder does not exist, it will be created. 4 | #' 5 | #' @return The path to the caching folder, if previously set. 6 | #' @export 7 | 8 | #' @examples 9 | ll_set_folder <- function(path = NULL) { 10 | if (is.null(path)) { 11 | path <- Sys.getenv("ll_base_folder") 12 | } else { 13 | Sys.setenv(ll_base_folder = path) 14 | } 15 | if (path == "") { 16 | path <- getwd() 17 | } 18 | path 19 | } 20 | -------------------------------------------------------------------------------- /R/mod_file_input.R: -------------------------------------------------------------------------------- 1 | #' file_input UI Function 2 | #' 3 | #' @description A shiny Module. 4 | #' 5 | #' @param id,input,output,session Internal parameters for {shiny}. 6 | #' 7 | #' @noRd 8 | #' 9 | #' @importFrom shiny NS tagList 10 | mod_file_input_ui <- function(id, label = "CSV file") { 11 | ns <- NS(id) 12 | tagList( 13 | fileInput( 14 | inputId = ns("file_input"), 15 | label = label 16 | ) 17 | ) 18 | } 19 | 20 | #' file_input Server Function 21 | #' 22 | #' @noRd 23 | mod_file_input_server <- function(id) { 24 | moduleServer(id, function(input, output, session) { 25 | ns <- session$ns 26 | user_file <- reactive({ 27 | # If no file is selected, don't do anything 28 | validate(need(input$file_input, message = FALSE)) 29 | input$file_input 30 | }) 31 | 32 | df <- reactive({ 33 | if (fs::path_ext(user_file()$name) == "csv") { 34 | readr::read_csv(file = user_file()$datapath) 35 | } else if (fs::path_ext(user_file()$name) == "tsv") { 36 | readr::read_tsv(file = user_file()$datapath) 37 | } else if (fs::path_ext(user_file()$name) == "xslx" | fs::path_ext(user_file()$name) == "xsl") { 38 | readxl::read_excel(path = user_file()$datapath) 39 | } else if (fs::path_ext(user_file()$name) == "ods") { 40 | readODS::read_ods(path = user_file()$datapath) 41 | } 42 | }) 43 | 44 | return(df) 45 | }) 46 | } 47 | 48 | ## To be copied in the UI 49 | # mod_file_input_ui("file_input_ui_1") 50 | 51 | ## To be copied in the server 52 | # callModule(mod_file_input_server, "file_input_ui_1") 53 | -------------------------------------------------------------------------------- /R/run_app.R: -------------------------------------------------------------------------------- 1 | #' Run the Shiny Application 2 | #' 3 | #' @param ... A series of options to be used inside the app. 4 | #' @param max_file_size Maximum file size to accept for upload expressed in MB, defaults to 100. 5 | #' @param ll_folder_path If given, sets the folder to use for caching, corresponds to `ll_set_folder()`. Useful e.g. for Docker deployments. Defaults to NULL. 6 | #' @export 7 | #' @importFrom shiny shinyApp 8 | #' @importFrom golem with_golem_options 9 | ll_app <- function(max_file_size = 100, 10 | ll_folder_path = NULL, 11 | ...) { 12 | with_golem_options( 13 | app = shinyApp( 14 | ui = app_ui, 15 | server = app_server 16 | ), 17 | golem_opts = list( 18 | shiny.maxRequestSize = max_file_size * 1024^2, 19 | ll_folder_path = ll_folder_path, 20 | ... 21 | ) 22 | ) 23 | } 24 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See `magrittr::[\%>\%][magrittr::pipe]` for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # latlon2map 17 | 18 | 19 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 20 | 21 | 22 | The goal of `latlon2map` is to make it simple to process spatial data, and to match tabular data distributed in spreadsheets with longitude/latitude columns with various geographical units based on shapefile distributed by statistical offices such as Eurostat. 23 | 24 | The package includes a number of convenience functions that download and cache locally pre-processed files to reduce boilerplate code commonly found in data projects, hopefully speeding up the data pipeline and favouring reproducibility. 25 | 26 | By dafault, `latlon2map` stores all downloaded files in the current working directory. However, it makes is easy to keep them on a single folder, preventing the common issue of having multiple copies of the same geographic files for each data project on a computer. The code remains transferrable and reproducible, as missing files are simply downloaded on the fly if unavaiable locally. 27 | 28 | ## Installation 29 | 30 | You can install `latlon2map` from GitHub with: 31 | 32 | ```{r eval = FALSE} 33 | remotes::install_github("giocomai/latlon2map") 34 | ``` 35 | 36 | ## Use 37 | 38 | All `latlon2map` function starts with `ll_` to facilitate auto-completion. By default, data are stored in a folder called `ll_data` inside the working directory. However, I suggest caching data in a separate folder for system-wide caching: you will not need to re-download again geographic files for different projects, and you will not unncessarily sync multiple copies of those files for each project that needs them. You need to call e.g. `ll_set_folder("~/R/")` once per session. Given that you may well download big files that take longer than the 60 seconds to download, you are advised to set a reasonably high timeout for downloads at the beginning of each session. 39 | 40 | ```{r} 41 | library("latlon2map") 42 | ll_set_folder(fs::path(fs::path_home_r(), "R")) 43 | options(timeout = 6000) 44 | ``` 45 | 46 | 47 | There are currently a number of functions facilitating downloads of geographic datasets, mostly from Eurostat's website. They all return `sf` objects, all of them transformed to crs 4326, all of them keeping all of the columns present in the original dataset. Future versions will likely add standard-named columns to facilitate matching data between different datasets. 48 | 49 | For reference all of the original data are kept in the `ll_data/shp/` folder, so it is possible to check metadata about each dataset. Information on copyright is printed to the console each time a given data source is used. 50 | 51 | Functions calls such as `ll_get_world(resolution = 60)` can safely be used where you would usually place your `sf` object/data frame. They will download items when they are not locally available, and will simply load pre-processed data on the following calls. 52 | 53 | Check the package vignette for more details, examples, and use cases. 54 | 55 | ## Shiny app 56 | 57 | The package includes a shiny app that facilitates matching latitude/longitude data frames wtih geographic units. 58 | 59 | ```{r eval=FALSE} 60 | ll_app() 61 | ``` 62 | 63 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # latlon2map 5 | 6 | 7 | 8 | [![Lifecycle: 9 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 10 | 11 | 12 | The goal of `latlon2map` is to make it simple to process spatial data, 13 | and to match tabular data distributed in spreadsheets with 14 | longitude/latitude columns with various geographical units based on 15 | shapefile distributed by statistical offices such as Eurostat. 16 | 17 | The package includes a number of convenience functions that download and 18 | cache locally pre-processed files to reduce boilerplate code commonly 19 | found in data projects, hopefully speeding up the data pipeline and 20 | favouring reproducibility. 21 | 22 | By dafault, `latlon2map` stores all downloaded files in the current 23 | working directory. However, it makes is easy to keep them on a single 24 | folder, preventing the common issue of having multiple copies of the 25 | same geographic files for each data project on a computer. The code 26 | remains transferrable and reproducible, as missing files are simply 27 | downloaded on the fly if unavaiable locally. 28 | 29 | ## Installation 30 | 31 | You can install `latlon2map` from GitHub with: 32 | 33 | ``` r 34 | remotes::install_github("giocomai/latlon2map") 35 | ``` 36 | 37 | ## Use 38 | 39 | All `latlon2map` function starts with `ll_` to facilitate 40 | auto-completion. By default, data are stored in a folder called 41 | `ll_data` inside the working directory. However, I suggest caching data 42 | in a separate folder for system-wide caching: you will not need to 43 | re-download again geographic files for different projects, and you will 44 | not unncessarily sync multiple copies of those files for each project 45 | that needs them. You need to call e.g. `ll_set_folder("~/R/")` once per 46 | session. Given that you may well download big files that take longer 47 | than the 60 seconds to download, you are advised to set a reasonably 48 | high timeout for downloads at the beginning of each session. 49 | 50 | ``` r 51 | library("latlon2map") 52 | ll_set_folder(fs::path(fs::path_home_r(), 53 | "R", 54 | "ll_data")) 55 | #> /home/g/R/ll_data 56 | options(timeout = 6000) 57 | ``` 58 | 59 | There are currently a number of functions facilitating downloads of 60 | geographic datasets, mostly from Eurostat’s website. They all return 61 | `sf` objects, all of them transformed to crs 4326, all of them keeping 62 | all of the columns present in the original dataset. Future versions will 63 | likely add standard-named columns to facilitate matching data between 64 | different datasets. 65 | 66 | For reference all of the original data are kept in the `ll_data/shp/` 67 | folder, so it is possible to check metadata about each dataset. 68 | Information on copyright is printed to the console each time a given 69 | data source is used. 70 | 71 | Functions calls such as `ll_get_world(resolution = 60)` can safely be 72 | used where you would usually place your `sf` object/data frame. They 73 | will download items when they are not locally available, and will simply 74 | load pre-processed data on the following calls. 75 | 76 | Check the package vignette for more details, examples, and use cases. 77 | 78 | ## Shiny app 79 | 80 | The package includes a shiny app that facilitates matching 81 | latitude/longitude data frames wtih geographic units. 82 | 83 | ``` r 84 | ll_app() 85 | ``` 86 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://giocomai.github.io/latlon2map/ 2 | template: 3 | bootstrap: 5 4 | 5 | -------------------------------------------------------------------------------- /data-raw/ll_codes.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `ll_codes` dataset goes here 2 | 3 | lau_df <- ll_get_lau_eu() %>% 4 | sf::st_drop_geometry() %>% 5 | dplyr::transmute(country_code = CNTR_CODE, 6 | id = GISCO_ID, 7 | name = LAU_NAME, 8 | source = "ll_get_lau_eu()") 9 | 10 | nuts3_df <- ll_get_nuts_eu(level = 3) %>% 11 | sf::st_drop_geometry() %>% 12 | dplyr::transmute(country_code = CNTR_CODE, 13 | id = NUTS_ID, 14 | name = NAME_LATN, 15 | source = "ll_get_nuts_eu(level = 3)") 16 | 17 | ua2_df <- ll_get_gadm(geo = "UKR", level = 2) %>% 18 | sf::st_drop_geometry() %>% 19 | dplyr::transmute(country_code = "UA", 20 | id = stringr::str_c("UA_", GID_2), 21 | name = NAME_2, 22 | source = "ll_get_gadm(geo = 'UKR', level = 2)") 23 | 24 | ua1_df <- ll_get_gadm(geo = "UKR", level = 1) %>% 25 | sf::st_drop_geometry() %>% 26 | dplyr::transmute(country_code = "UA", 27 | id = stringr::str_c("UA_", GID_1), 28 | name = NAME_1, 29 | source = "ll_get_gadm(geo = 'UKR', level = 1)") 30 | 31 | # ua_df <- ll_get_adm_ocha(geo = "UA", level = 3) %>% 32 | # sf::st_drop_geometry() 33 | 34 | md1_df <- ll_get_adm_ocha(geo = "MD", level = 1) %>% 35 | sf::st_drop_geometry() %>% 36 | dplyr::transmute(country_code = "MD", 37 | id = ADM1_PCODE, 38 | name = ADM1_EN, 39 | source = "ll_get_adm_ocha(geo = 'MD', level = 1)") 40 | 41 | rs1_df <- ll_get_gadm(geo = "RS", level = 1) %>% 42 | sf::st_drop_geometry() %>% 43 | dplyr::transmute(country_code = "RS", 44 | id = stringr::str_c("RS_", GID_1), 45 | name = NAME_1, 46 | source = "ll_get_gadm(geo = 'RS', level = 1)") 47 | 48 | ba3_df <- ll_get_gadm(geo = "BIH", level = 3) %>% 49 | sf::st_drop_geometry() %>% 50 | dplyr::transmute(country_code = "BA", 51 | id = stringr::str_c("BA_", GID_3), 52 | name = NAME_3, 53 | source = "ll_get_gadm(geo = 'BIH', level = 3)") 54 | 55 | ba2_df <- ll_get_gadm(geo = "BIH", level = 2) %>% 56 | sf::st_drop_geometry() %>% 57 | dplyr::transmute(country_code = "BA", 58 | id = stringr::str_c("BA_", GID_2), 59 | name = NAME_2, 60 | source = "ll_get_gadm(geo = 'BIH', level = 2)") 61 | 62 | xk2_df <- ll_get_gadm(geo = "XKO", level = 2) %>% 63 | sf::st_drop_geometry() %>% 64 | dplyr::transmute(country_code = "XK", 65 | id = stringr::str_c("XK_", GID_2), 66 | name = NAME_2, 67 | source = "ll_get_gadm(geo = 'XKO', level = 2)") 68 | 69 | 70 | xk1_df <- ll_get_gadm(geo = "XKO", level = 1) %>% 71 | sf::st_drop_geometry() %>% 72 | dplyr::transmute(country_code = "XK", 73 | id = stringr::str_c("XK_", GID_1), 74 | name = NAME_1, 75 | source = "ll_get_gadm(geo = 'XKO', level = 1)") 76 | 77 | me1_df <- ll_get_gadm(geo = "MNE", level = 1) %>% 78 | sf::st_drop_geometry() %>% 79 | dplyr::transmute(country_code = "ME", 80 | id = stringr::str_c("ME_", GID_1), 81 | name = NAME_1, 82 | source = "ll_get_gadm(geo = 'ME', level = 1)") 83 | 84 | #tidywikidatar::tw_get_label(id = ll_lau_pt_id$qid, language = "pt") 85 | 86 | pt_df <- ll_lau_pt_id %>% 87 | dplyr::transmute(country_code = "PT", 88 | id, 89 | name = Concelho, 90 | source = "ll_get_lau_pt(level = 'concelho')") 91 | 92 | # Custom fix for Bratislava 93 | 94 | sk_df <- tibble::tibble(country_code = "SK", 95 | id = "SK_Bratislava", 96 | name = "Bratislava", 97 | source = "Bratislava") 98 | 99 | 100 | 101 | # ll_get_lau_eu() %>% 102 | # dplyr::filter(stringr::str_starts(string = LAU_NAME, 103 | # pattern = "Bratislava - ")) %>% 104 | # sf::st_union() %>% 105 | # ggplot2::ggplot() + 106 | # ggplot2::geom_sf() 107 | 108 | 109 | ll_codes <- dplyr::bind_rows(lau_df, 110 | nuts3_df, 111 | ua1_df, 112 | ua2_df, 113 | md1_df, 114 | rs1_df, 115 | ba2_df, 116 | ba3_df, 117 | xk2_df, 118 | xk1_df, 119 | pt_df, 120 | sk_df) %>% 121 | dplyr::arrange(country_code, id, name) 122 | 123 | 124 | usethis::use_data(ll_codes, overwrite = TRUE) 125 | -------------------------------------------------------------------------------- /data-raw/ll_lau_nuts_concordance_links.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `ll_lau_nuts_concordance_links` dataset goes here 2 | 3 | # see: 4 | # https://ec.europa.eu/eurostat/web/nuts/local-administrative-units 5 | 6 | ll_lau_nuts_concordance_links <- tibble::tribble( 7 | ~lau_year, ~nuts_year, ~status, ~link, 8 | 2020, 2021, "provisional", "https://ec.europa.eu/eurostat/documents/345175/501971/EU-27-LAU-2020-NUTS-2021-NUTS-2016.xlsx", 9 | 2020, 2016, "provisional", "https://ec.europa.eu/eurostat/documents/345175/501971/EU-27-LAU-2020-NUTS-2021-NUTS-2016.xlsx", 10 | 2019, 2016, "validated", "https://ec.europa.eu/eurostat/documents/345175/501971/EU-28-LAU-2019-NUTS-2016.xlsx", 11 | 2018, 2016, "validated", "https://ec.europa.eu/eurostat/documents/345175/501971/EU-28-LAU-2018-NUTS-2016.xlsx", 12 | 2017, 2016, "validated", "https://ec.europa.eu/eurostat/documents/345175/501971/EU-28_LAU_2017_NUTS_2016.xlsx", 13 | 2017, 2013, "validated", "https://ec.europa.eu/eurostat/documents/345175/501971/EU-28_LAU_2017_NUTS_2013.xlsx" 14 | ) 15 | 16 | 17 | usethis::use_data(ll_lau_nuts_concordance_links, overwrite = TRUE) 18 | -------------------------------------------------------------------------------- /data-raw/ll_lau_pt_id.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `ll_lau_pt_id` dataset goes here 2 | 3 | library("latlon2map") 4 | library("tidywikidatar") 5 | 6 | freg_sf <- ll_get_lau_pt() 7 | 8 | conc_df <- tw_query(query = list( 9 | c(p = "P31", q = "Q13217644") 10 | ), language = "pt") 11 | 12 | ## Lagoa municipality in Acores apparently not included 13 | conc_df <- conc_df %>% 14 | dplyr::filter(id != "Q564759") 15 | 16 | # freg_sf %>% 17 | # dplyr::filter(Concelho=="LAGOA") 18 | 19 | # freg_sf %>% 20 | # sf::st_drop_geometry() %>% View() 21 | 22 | ll_lau_pt_id_pre <- freg_sf %>% 23 | sf::st_drop_geometry() %>% 24 | dplyr::distinct(Concelho,Distrito) %>% 25 | dplyr::left_join(y = conc_df %>% 26 | dplyr::mutate(Concelho = stringr::str_to_upper(label)) %>% 27 | dplyr::select(id, Concelho), 28 | by = "Concelho") 29 | 30 | #ll_lau_pt_id_pre$id[ll_lau_pt_id_pre$Concelho=="LISBOA"] <- "Q597" 31 | ll_lau_pt_id_pre$id[ll_lau_pt_id_pre$Concelho=="CASTANHEIRA DE PÊRA"] <- "Q1013140" 32 | 33 | ll_lau_pt_id_pre %>% 34 | dplyr::filter(is.na(id)) 35 | 36 | ll_lau_pt_id <- ll_lau_pt_id_pre %>% 37 | dplyr::rename(qid = id) %>% 38 | dplyr::mutate(id = stringr::str_c("PT_", qid)) %>% 39 | dplyr::mutate(population = tw_get_p1(id = qid, p = "P1082", language = "pt")) %>% 40 | dplyr::mutate(population = stringr::str_remove(string = population, pattern = stringr::fixed("+")) %>% as.numeric()) %>% 41 | dplyr::mutate(name = tw_get_label(id = qid, language = "pt")) %>% 42 | dplyr::arrange(dplyr::desc(population)) 43 | 44 | ll_lau_pt_id 45 | 46 | # freg_sf %>% 47 | # dplyr::filter(Concelho == "ALBUFEIRA") %>% 48 | # dplyr::summarise() 49 | 50 | usethis::use_data(ll_lau_pt_id, overwrite = TRUE) 51 | -------------------------------------------------------------------------------- /data-raw/ll_osm_bboxes.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `ll_osm_bboxes` dataset goes here 2 | 3 | library("latlon2map") 4 | options(timeout = 60000) 5 | ll_set_folder(path = fs::path( 6 | fs::path_home_r(), 7 | "R", 8 | "ll_data" 9 | )) 10 | 11 | # ll_get_lau_eu() %>% 12 | # dplyr::pull(GISCO_ID) %>% 13 | # stringr::str_extract(pattern = "[A-Z][A-Z]") %>% 14 | # unique() 15 | 16 | countries_with_more <- ll_osm_countries %>% 17 | tidyr::unnest(link) %>% 18 | dplyr::group_by(continent, country) %>% 19 | dplyr::add_count(name = "n") %>% 20 | dplyr::ungroup() %>% 21 | dplyr::filter(n > 1) %>% 22 | dplyr::distinct(country) %>% 23 | dplyr::pull(country) 24 | 25 | 26 | 27 | temp_bbox_folder <- fs::path(latlon2map::ll_set_folder(), "temp_bbox") 28 | fs::dir_create(path = temp_bbox_folder) 29 | ll_osm_bboxes <- ll_osm_bboxes %>% 30 | filter(country!="spain") 31 | 32 | ll_osm_bboxes_pre <- purrr::map_dfr( 33 | .x = countries_with_more, 34 | .f = function(current_country) { 35 | # current_country <- "spain" 36 | 37 | if (exists("ll_osm_bboxes")) { 38 | previous_df <- ll_osm_bboxes %>% 39 | dplyr::filter(country==current_country) 40 | 41 | if (nrow(previous_df)>0) { 42 | return( 43 | previous_df %>% 44 | dplyr::select(-country_code) 45 | ) 46 | } 47 | } 48 | 49 | ll_osm_download(countries = current_country) 50 | ll_osm_extract_roads(countries = current_country) 51 | 52 | 53 | current_country_regions <- ll_osm_countries %>% 54 | dplyr::filter(country == current_country) %>% 55 | tidyr::unnest(link) %>% 56 | dplyr::pull(link) %>% 57 | fs::path_file() %>% 58 | fs::path_ext_remove() %>% 59 | stringr::str_remove(pattern = stringr::fixed("-latest-free.shp")) 60 | 61 | # all_regions <- fs::dir_ls(fs::path(latlon2map::ll_set_folder(), 62 | # "osm_roads_shp", 63 | # current_country)) 64 | 65 | all_regions <- fs::path( 66 | latlon2map::ll_set_folder(), 67 | "osm_roads_shp", 68 | current_country, 69 | current_country_regions 70 | ) 71 | 72 | purrr::map_dfr( 73 | .x = all_regions, 74 | .f = function(current_region) { 75 | current_region_name <- current_region %>% fs::path_file() 76 | current_region_file <- fs::path( 77 | temp_bbox_folder, 78 | paste0( 79 | current_country, 80 | "-", 81 | current_region_name, 82 | ".rds" 83 | ) 84 | ) 85 | 86 | if (fs::file_exists(current_region_file)) { 87 | readRDS(file = current_region_file) 88 | } else { 89 | current_region_sf <- sf::st_read(current_region) 90 | 91 | current_bbox <- tibble::tibble( 92 | country = current_country, 93 | region = current_region_name, 94 | bbox = list(sf::st_bbox(current_region_sf)) 95 | ) 96 | saveRDS(object = current_bbox, file = current_region_file) 97 | current_bbox 98 | } 99 | } 100 | ) 101 | } 102 | ) 103 | 104 | # countrycode::codelist %>% dplyr::select(country.name.en, iso2) %>% View() 105 | # ll_osm_bboxes %>% 106 | # dplyr::distinct(country) %>% 107 | # dplyr::pull(country) %>% dput() 108 | 109 | 110 | cc <- tibble::tribble( 111 | ~country, ~country_code, 112 | "japan", "JP", 113 | "france", "FR", 114 | "germany", "DE", 115 | "great-britain", "UK", 116 | "italy", "IT", 117 | "netherlands", "NL", 118 | "poland", "PL", 119 | "spain", "ES", 120 | "russia", "RU", 121 | "canada", "CA", 122 | "us", "US", 123 | "brazil", "BR", 124 | "guatemala", "GT", 125 | "india", "IN" 126 | ) 127 | 128 | ## Add canary islands 129 | # https://download.geofabrik.de/africa.html 130 | 131 | 132 | 133 | 134 | 135 | ll_osm_bboxes <- ll_osm_bboxes_pre %>% 136 | dplyr::mutate(country_code = countrycode::countrycode(sourcevar = country, 137 | origin = "country.name.en", 138 | destination = "eurostat")) %>% 139 | dplyr::select(country_code, country, region, bbox) %>% 140 | dplyr::arrange(country_code) 141 | 142 | usethis::use_data(ll_osm_bboxes, overwrite = TRUE) 143 | 144 | 145 | ### this useful only to update as new countries appear here 146 | # 147 | # before_update_df <- ll_osm_bboxes 148 | # 149 | # cc_new <- cc %>% 150 | # dplyr::anti_join(y = ll_osm_bboxes, by = "country") 151 | # 152 | # 153 | # 154 | # ll_osm_bboxes_new <- cc %>% 155 | # dplyr::anti_join(y = before_update_df, by = "country") 156 | # 157 | # ll_osm_bboxes <- dplyr::bind_rows(x = before_update_df, 158 | # y = ll_osm_bboxes_new) %>% 159 | # dplyr::arrange(country) 160 | # 161 | # usethis::use_data(ll_osm_bboxes, overwrite = TRUE) 162 | -------------------------------------------------------------------------------- /data-raw/ll_osm_countries.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `ll_osm_countries` dataset goes here 2 | 3 | library("dplyr") 4 | 5 | continents <- c( 6 | "africa", 7 | "asia", 8 | "australia-oceania", 9 | "central-america", 10 | "europe", 11 | "north-america", 12 | "south-america", 13 | "russia" 14 | ) 15 | 16 | ll_osm_countries <- 17 | purrr::map_dfr( 18 | .x = continents, 19 | .f = function(current_continent) { 20 | print(current_continent) 21 | current_continent_page <- xml2::read_html(x = glue::glue("http://download.geofabrik.de/{current_continent}/")) 22 | 23 | current_links <- current_continent_page %>% 24 | rvest::html_nodes(xpath = paste0("//a")) %>% 25 | xml2::xml_attr("href") %>% 26 | tibble::enframe(name = NULL, value = "links") 27 | 28 | current_countries_df <- current_links %>% 29 | dplyr::filter(stringr::str_detect( 30 | string = links, 31 | pattern = stringr::fixed(".html") 32 | )) %>% 33 | dplyr::transmute(country = fs::path_ext_remove(links)) 34 | 35 | small_countries_df <- 36 | current_links %>% 37 | dplyr::filter(stringr::str_ends( 38 | string = links, 39 | pattern = "-latest-free.shp.zip" 40 | )) %>% 41 | dplyr::transmute( 42 | continent = current_continent, 43 | country = stringr::str_remove(links, "-latest-free.shp.zip"), 44 | link = glue::glue("http://download.geofabrik.de/{current_continent}/{links}") 45 | ) %>% 46 | tidyr::nest(link = c(link)) 47 | 48 | 49 | big_countries_c <- dplyr::anti_join( 50 | x = current_countries_df, 51 | y = small_countries_df, 52 | by = "country" 53 | ) 54 | 55 | 56 | big_countries_df <- purrr::map_dfr( 57 | .x = big_countries_c$country, 58 | .f = function(current_big_country) { 59 | current_big_country_links_pre <- xml2::read_html(x = paste0( 60 | "http://download.geofabrik.de/", 61 | current_continent, 62 | "/", 63 | current_big_country, 64 | ".html" 65 | )) %>% 66 | rvest::html_nodes(xpath = paste0("//a")) %>% 67 | xml2::xml_attr("href") 68 | 69 | current_big_country_links <- current_big_country_links_pre %>% 70 | stringr::str_subset(pattern = "-latest-free.shp.zip$") 71 | 72 | all_regions_html_links <- current_big_country_links_pre[stringr::str_starts(string = current_big_country_links_pre, current_big_country)&stringr::str_ends(string = current_big_country_links_pre, "html")] 73 | 74 | available_shp_regions_v <- stringr::str_remove(string = current_big_country_links, pattern = stringr::str_c(current_big_country, "/")) %>% 75 | stringr::str_remove(pattern = "-latest-free.shp.zip") 76 | 77 | all_regions_v <- stringr::str_remove(string = all_regions_html_links, pattern = stringr::str_c(current_big_country, "/")) %>% 78 | stringr::str_remove(pattern = ".html") 79 | 80 | big_regions_v <- all_regions_v[!(is.element(all_regions_v, available_shp_regions_v))] 81 | 82 | if (length(big_regions_v)>0) { 83 | 84 | big_regions_links <- purrr::map_dfr(.x = big_regions_v, 85 | .f = function(current_region) { 86 | xml2::read_html(x = paste0( 87 | "http://download.geofabrik.de/", 88 | current_continent, 89 | "/", 90 | current_big_country, 91 | "/", 92 | current_region, 93 | ".html" 94 | )) %>% 95 | rvest::html_nodes(xpath = paste0("//a")) %>% 96 | xml2::xml_attr("href") %>% 97 | tibble::enframe(name = NULL, value = "links") %>% 98 | dplyr::filter(stringr::str_ends( 99 | string = links, 100 | pattern = "-latest-free.shp.zip" 101 | )) 102 | }) 103 | 104 | current_big_country_links <- c(current_big_country_links, 105 | stringr::str_c(current_big_country, "/", big_regions_links$links)) 106 | 107 | } 108 | 109 | 110 | if (length(current_big_country_links) == 0) { 111 | return(NULL) 112 | } else { 113 | tibble::tibble( 114 | continent = current_continent, 115 | country = current_big_country, 116 | link = glue::glue("http://download.geofabrik.de/{current_continent}/{current_big_country_links}") 117 | ) %>% 118 | dplyr::group_by(continent, country) %>% 119 | tidyr::nest(link = link) 120 | } 121 | } 122 | ) 123 | 124 | if (current_continent == "russia") { 125 | tibble::tibble(continent = "russia", 126 | country = "russia", 127 | link = list(small_countries_df %>% 128 | tidyr::unnest(link) %>% 129 | dplyr::select(link))) 130 | } else { 131 | dplyr::bind_rows( 132 | small_countries_df, 133 | big_countries_df 134 | ) 135 | } 136 | } 137 | ) %>% 138 | arrange(continent, country) 139 | 140 | # fix Canary Islands 141 | ll_osm_countries[ll_osm_countries$country=="spain", "link"][[1]] <- list(dplyr::bind_rows(ll_osm_countries[ll_osm_countries$country=="spain", "link"][[1]], 142 | ll_osm_countries[ll_osm_countries$country=="canary-islands", "link"][[1]]) %>% 143 | dplyr::distinct(.data$link)) 144 | 145 | 146 | usethis::use_data(ll_osm_countries , overwrite = TRUE) 147 | 148 | 149 | temp <- sf::st_read("/home/g/Downloads/east-timor-latest.osm.pbf", layer = "lines") 150 | temp %>% 151 | filter(is.na(highway)==FALSE) 152 | 153 | temp2 <- sf::st_read("/home/g/Downloads/east-timor-latest-free.shp/gis_osm_roads_free_1.shp") 154 | -------------------------------------------------------------------------------- /data-raw/ll_osm_it_gpkg.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `ll_osm_it_gpkg` dataset goes here 2 | 3 | # https://osmit-estratti.wmcloud.org/ 4 | 5 | ll_osm_it_gpkg <- list() 6 | 7 | link_comuni_pre <- "https://osmit-estratti.wmcloud.org/dati/poly/comuni/geopackage/" %>% 8 | xml2::read_html() %>% 9 | rvest::html_nodes(xpath = paste0("//a")) %>% 10 | xml2::xml_attr("href") %>% 11 | tibble::enframe(name = NULL, value = "link") %>% 12 | dplyr::slice(-1) 13 | 14 | 15 | library("latlon2map") 16 | 17 | ll_set_folder(path = fs::path(fs::path_home_r(), "R", "ll_data")) 18 | 19 | ll_osm_it_gpkg[["comuni"]] <- ll_get_nuts_it(level = "lau") %>% 20 | sf::st_drop_geometry() %>% 21 | dplyr::select(PRO_COM_T, COMUNE) %>% 22 | dplyr::left_join( 23 | y = link_comuni_pre %>% 24 | dplyr::mutate(PRO_COM_T = stringr::str_extract( 25 | string = link, 26 | pattern = "[[:digit:]]+" 27 | )), 28 | by = "PRO_COM_T" 29 | ) %>% 30 | dplyr::transmute( 31 | name = COMUNE, 32 | code = PRO_COM_T, 33 | link = paste0("https://osmit-estratti.wmcloud.org/dati/poly/comuni/geopackage/", link) 34 | ) %>% 35 | dplyr::filter(is.na(link) == FALSE) 36 | 37 | 38 | ## province 39 | 40 | link_province_pre <- "https://osmit-estratti.wmcloud.org/dati/poly/province/geopackage/" %>% 41 | xml2::read_html() %>% 42 | rvest::html_nodes(xpath = paste0("//a")) %>% 43 | xml2::xml_attr("href") %>% 44 | tibble::enframe(name = NULL, value = "link") %>% 45 | dplyr::slice(-1) 46 | 47 | 48 | 49 | ll_osm_it_gpkg[["province"]] <- ll_get_nuts_it(level = 3) %>% 50 | sf::st_drop_geometry() %>% 51 | dplyr::select(COD_PROV, DEN_UTS) %>% 52 | dplyr::mutate(COD_PROV = stringr::str_pad(string = COD_PROV, width = 3, side = "left", pad = 0)) %>% 53 | dplyr::left_join( 54 | y = link_province_pre %>% 55 | dplyr::mutate(COD_PROV = stringr::str_extract( 56 | string = link, 57 | pattern = "[[:digit:]]+" 58 | )), 59 | by = "COD_PROV" 60 | ) %>% 61 | dplyr::transmute( 62 | name = DEN_UTS, 63 | code = COD_PROV, 64 | link = paste0("https://osmit-estratti.wmcloud.org/dati/poly/province/geopackage/", link) 65 | ) 66 | 67 | 68 | ## regioni 69 | 70 | 71 | link_regioni_pre <- "https://osmit-estratti.wmcloud.org/dati/poly/regioni/geopackage/" %>% 72 | xml2::read_html() %>% 73 | rvest::html_nodes(xpath = paste0("//a")) %>% 74 | xml2::xml_attr("href") %>% 75 | tibble::enframe(name = NULL, value = "link") %>% 76 | dplyr::slice(-1) 77 | 78 | 79 | 80 | ll_osm_it_gpkg[["regioni"]] <- ll_get_nuts_it(level = 2) %>% 81 | sf::st_drop_geometry() %>% 82 | dplyr::select(COD_REG, DEN_REG) %>% 83 | dplyr::mutate(COD_REG = stringr::str_pad(string = COD_REG, width = 2, side = "left", pad = 0)) %>% 84 | dplyr::left_join( 85 | y = link_regioni_pre %>% 86 | dplyr::mutate(COD_REG = stringr::str_extract( 87 | string = link, 88 | pattern = "[[:digit:]]+" 89 | )), 90 | by = "COD_REG" 91 | ) %>% 92 | dplyr::transmute( 93 | name = DEN_REG, 94 | code = COD_REG, 95 | link = paste0("https://osmit-estratti.wmcloud.org/dati/poly/regioni/geopackage/", link) 96 | ) 97 | 98 | 99 | 100 | usethis::use_data(ll_osm_it_gpkg, overwrite = TRUE) 101 | -------------------------------------------------------------------------------- /data-raw/ocha_administrative_boundaries_links.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `population_grid_hr_links` dataset goes here 2 | 3 | # remotes::install_gitlab("dickoa/rhdx") 4 | # https://gitlab.com/dickoa/rhdx 5 | library("rhdx") 6 | set_rhdx_config(hdx_site = "prod") 7 | get_rhdx_config() 8 | 9 | library("tidyverse") 10 | hr1 <- search_datasets( 11 | query = "Subnational Administrative Boundaries", 12 | rows = 1000 13 | ) 14 | 15 | hr2 <- search_datasets( 16 | query = "Subnational Administrative Boundaries", 17 | rows = 1000, 18 | start = 1000 19 | ) 20 | 21 | hr <- c(hr1,hr2) 22 | 23 | pb <- progress::progress_bar$new(total = length(hr)) 24 | 25 | all_available_df <- purrr::map_dfr( 26 | .x = hr, 27 | .f = function(x) { 28 | pb$tick() 29 | current_resources <- x %>% get_resources() 30 | 31 | # pb <- progress::progress_bar$new(total = length(current_resources)) 32 | purrr::map_dfr( 33 | .x = current_resources, 34 | .f = function(current_resource) { 35 | # pb$tick() 36 | resource_list <- current_resource$as_list() 37 | 38 | resource_list[names(resource_list) == ""] <- NULL 39 | 40 | resource_df <- resource_list %>% 41 | tibble::enframe() %>% 42 | tidyr::pivot_wider() %>% 43 | tidyr::unnest(cols = dplyr::everything()) %>% 44 | mutate(across(everything(), as.character)) 45 | 46 | # if (is.element("originalHash", names(resource_df))) { 47 | # resource_df$originalHash <- as.character(resource_df$originalHash) 48 | # } 49 | # if (is.element("pii", names(resource_df))) { 50 | # resource_df$pii <- as.character(resource_df$pii) 51 | # } 52 | resource_df 53 | } 54 | ) %>% 55 | dplyr::mutate( 56 | title = x$as_list()$title, 57 | country = list(x$as_list()$solr_additions %>% jsonlite::parse_json() %>% unlist()), 58 | dataset_source = x$as_list()$dataset_source, 59 | dataset_name = x$as_list()[["name"]] 60 | ) 61 | } 62 | ) 63 | 64 | adm_boundaries_df <- all_available_df %>% 65 | filter(format == "SHP", 66 | stringr::str_detect(title, "Subnational Administrative Boundaries"), 67 | url_type == "upload") %>% 68 | dplyr::distinct(package_id, .keep_all = TRUE) %>% 69 | dplyr::select( 70 | package_id, 71 | id, 72 | size, 73 | metadata_modified, 74 | download_url, 75 | format, 76 | position, 77 | name, 78 | created, 79 | last_modified, 80 | title, 81 | country, 82 | dataset_name 83 | ) %>% 84 | tidyr::unnest(country) %>% 85 | dplyr::mutate(country_code = countrycode::countrycode( 86 | sourcevar = country, 87 | origin = "country.name.en", 88 | destination = "eurostat" 89 | )) %>% 90 | dplyr::mutate(url = stringr::str_c("https://data.humdata.org/dataset/", dataset_name)) %>% 91 | dplyr::select( 92 | country_code, 93 | country, 94 | format, 95 | download_url, 96 | name, title, 97 | dplyr::everything() 98 | ) %>% 99 | dplyr::group_by(country, name) %>% 100 | dplyr::slice_max(last_modified) %>% 101 | dplyr::ungroup() %>% 102 | dplyr::arrange(country_code, country, format, name) 103 | 104 | adm_boundaries_df$country_code[adm_boundaries_df$country=="Türkiye"] <- "TR" 105 | 106 | ll_administrative_boundaries_ocha_metadata <- adm_boundaries_df 107 | usethis::use_data(ll_administrative_boundaries_ocha_metadata, 108 | overwrite = TRUE 109 | ) 110 | -------------------------------------------------------------------------------- /data-raw/population_grid_hr_links.R: -------------------------------------------------------------------------------- 1 | ## code to prepare `population_grid_hr_links` dataset goes here 2 | 3 | # remotes::install_gitlab("dickoa/rhdx") 4 | # https://gitlab.com/dickoa/rhdx 5 | library("rhdx") 6 | set_rhdx_config(hdx_site = "prod") 7 | get_rhdx_config() 8 | 9 | library("tidyverse") 10 | hr1 <- search_datasets( 11 | query = "High Resolution Population Density Maps", 12 | rows = 1000 13 | ) 14 | 15 | hr2 <- search_datasets( 16 | query = "High Resolution Population Density Maps", 17 | rows = 1000, 18 | start = 1000 19 | ) 20 | 21 | hr <- c(hr1,hr2) 22 | 23 | pb <- progress::progress_bar$new(total = length(hr)) 24 | 25 | all_available_df <- purrr::map_dfr( 26 | .x = hr, 27 | .f = function(x) { 28 | pb$tick() 29 | current_resources <- x %>% get_resources() 30 | 31 | # pb <- progress::progress_bar$new(total = length(current_resources)) 32 | purrr::map_dfr( 33 | .x = current_resources, 34 | .f = function(current_resource) { 35 | # pb$tick() 36 | resource_list <- current_resource$as_list() 37 | 38 | resource_list[names(resource_list) == ""] <- NULL 39 | 40 | resource_df <- resource_list %>% 41 | tibble::enframe() %>% 42 | tidyr::pivot_wider() %>% 43 | tidyr::unnest(cols = dplyr::everything()) %>% 44 | mutate(across(everything(), as.character)) 45 | 46 | # if (is.element("originalHash", names(resource_df))) { 47 | # resource_df$originalHash <- as.character(resource_df$originalHash) 48 | # } 49 | # if (is.element("pii", names(resource_df))) { 50 | # resource_df$pii <- as.character(resource_df$pii) 51 | # } 52 | resource_df 53 | } 54 | ) %>% 55 | dplyr::mutate( 56 | title = x$as_list()$title, 57 | country = list(x$as_list()$solr_additions %>% jsonlite::parse_json() %>% unlist()), 58 | dataset_source = x$as_list()$dataset_source, 59 | dataset_name = x$as_list()[["name"]] 60 | ) 61 | } 62 | ) 63 | 64 | 65 | population_grid_hr_metadata <- all_available_df %>% 66 | dplyr::filter(dataset_source == "Facebook") %>% 67 | dplyr::filter(url_type == "upload") %>% 68 | dplyr::select( 69 | package_id, 70 | id, 71 | size, 72 | metadata_modified, 73 | download_url, 74 | format, 75 | position, 76 | name, 77 | created, 78 | last_modified, 79 | title, 80 | country, 81 | dataset_name 82 | ) %>% 83 | tidyr::unnest(country) %>% 84 | dplyr::mutate(country_code = countrycode::countrycode( 85 | sourcevar = country, 86 | origin = "country.name.en", 87 | destination = "eurostat" 88 | )) %>% 89 | dplyr::mutate(url = stringr::str_c("https://data.humdata.org/dataset/", dataset_name)) %>% 90 | dplyr::select( 91 | country_code, 92 | country, 93 | format, 94 | download_url, 95 | name, title, 96 | dplyr::everything() 97 | ) %>% 98 | dplyr::group_by(country, name) %>% 99 | dplyr::slice_max(last_modified) %>% 100 | dplyr::ungroup() %>% 101 | dplyr::arrange(country_code, country, format, name) 102 | 103 | 104 | usethis::use_data(population_grid_hr_metadata, 105 | overwrite = TRUE 106 | ) 107 | -------------------------------------------------------------------------------- /data/ll_administrative_boundaries_ocha_metadata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_administrative_boundaries_ocha_metadata.rda -------------------------------------------------------------------------------- /data/ll_codes.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_codes.rda -------------------------------------------------------------------------------- /data/ll_lau_nuts_concordance_links.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_lau_nuts_concordance_links.rda -------------------------------------------------------------------------------- /data/ll_lau_pt_id.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_lau_pt_id.rda -------------------------------------------------------------------------------- /data/ll_osm_bboxes.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_osm_bboxes.rda -------------------------------------------------------------------------------- /data/ll_osm_countries.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_osm_countries.rda -------------------------------------------------------------------------------- /data/ll_osm_it_gpkg.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/ll_osm_it_gpkg.rda -------------------------------------------------------------------------------- /data/population_grid_hr_metadata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/data/population_grid_hr_metadata.rda -------------------------------------------------------------------------------- /inst/golem-config.yml: -------------------------------------------------------------------------------- 1 | default: 2 | golem_name: latlon2map 3 | golem_version: 0.0.0.9000 4 | app_prod: no 5 | production: 6 | app_prod: yes 7 | dev: 8 | golem_wd: !expr here::here() 9 | -------------------------------------------------------------------------------- /latlon2map.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageRoxygenize: rd,collate,namespace 19 | -------------------------------------------------------------------------------- /man/ll_app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/run_app.R 3 | \name{ll_app} 4 | \alias{ll_app} 5 | \title{Run the Shiny Application} 6 | \usage{ 7 | ll_app(max_file_size = 100, ll_folder_path = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{max_file_size}{Maximum file size to accept for upload expressed in MB, defaults to 100.} 11 | 12 | \item{ll_folder_path}{If given, sets the folder to use for caching, corresponds to \code{ll_set_folder()}. Useful e.g. for Docker deployments. Defaults to NULL.} 13 | 14 | \item{...}{A series of options to be used inside the app.} 15 | } 16 | \description{ 17 | Run the Shiny Application 18 | } 19 | -------------------------------------------------------------------------------- /man/ll_bbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_bbox.R 3 | \name{ll_bbox} 4 | \alias{ll_bbox} 5 | \title{Provide a bounding box with a consistent, user given ratio} 6 | \usage{ 7 | ll_bbox(sf, ratio = "4:3") 8 | } 9 | \arguments{ 10 | \item{sf}{An sf object.} 11 | 12 | \item{ratio}{Defaults to "4:3". A chacters string, in the form of e.g. "4:3" or "16:9" or "1:1" (other values possible)} 13 | } 14 | \value{ 15 | A bounding box vector, same as with \code{sf::st_bbox()}, but with the given ratio set and compatible with crs 4326. 16 | } 17 | \description{ 18 | This is useful in particular to make geom_sf()-based ggplots with consistent aspect ratio. 19 | } 20 | \examples{ 21 | \dontrun{ 22 | # The following two graphs will have same 4:3 aspect ratio 23 | ll_set_folder("~/R/") 24 | library("ggspatial") 25 | 26 | sf_location <- ll_get_nuts_it(name = "Palmanova", level = "lau", resolution = "low") 27 | 28 | ggplot() + 29 | annotation_map_tile(type = "osm", zoomin = -1, cachedir = fs::path(ll_set_folder(), "ll_data")) + 30 | geom_sf(data = sf::st_as_sfc(ll_bbox(sf_location)), fill = NA, color = NA) + 31 | geom_sf( 32 | data = sf_location, 33 | colour = "darkred", 34 | size = 2, 35 | fill = NA, 36 | alpha = 0.8 37 | ) 38 | 39 | 40 | sf_location <- ll_get_nuts_it(name = "Pinzolo", level = "lau", resolution = "low") 41 | 42 | ggplot() + 43 | annotation_map_tile(type = "osm", zoomin = -1, cachedir = fs::path(ll_set_folder(), "ll_data")) + 44 | geom_sf(data = sf::st_as_sfc(ll_bbox(sf_location)), fill = NA, color = NA) + 45 | geom_sf( 46 | data = sf_location, 47 | colour = "darkred", 48 | size = 2, 49 | fill = NA, 50 | alpha = 0.8 51 | ) 52 | } 53 | 54 | } 55 | -------------------------------------------------------------------------------- /man/ll_create_folders.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_create_folders.R 3 | \name{ll_create_folders} 4 | \alias{ll_create_folders} 5 | \title{Create folders to store geographic data} 6 | \usage{ 7 | ll_create_folders( 8 | geo, 9 | level, 10 | resolution, 11 | year, 12 | file_type = c("shp", "zip", "rds") 13 | ) 14 | } 15 | \arguments{ 16 | \item{geo}{The geographic unit of reference as a two-letter code} 17 | 18 | \item{level}{E.g. NUTS0, NUTS1, or county, state, ecc.} 19 | 20 | \item{resolution}{Either resolution level as given by the data distributor, or generic such as "high", "low", or "default} 21 | 22 | \item{file_type}{By defaults, it creates folder for zip, shp, and rds files.} 23 | } 24 | \description{ 25 | Create folders to store geographic data 26 | } 27 | -------------------------------------------------------------------------------- /man/ll_export_sf_to_kml.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_export_sf_to_kml.R 3 | \name{ll_export_sf_to_kml} 4 | \alias{ll_export_sf_to_kml} 5 | \title{Export sf objects into kml file that can be used with Google Earth, Google Maps, etc.} 6 | \usage{ 7 | ll_export_sf_to_kml( 8 | sf, 9 | path, 10 | name = NULL, 11 | keep_other_columns = TRUE, 12 | description = NULL, 13 | label_text = NULL, 14 | label_font = "Roboto Sans, Noto Sans, Helvetica", 15 | label_size = "24pt", 16 | label_placement = "m", 17 | label_scale = NULL, 18 | line_colour = "#ffffffff", 19 | line_width = "3px", 20 | icon_url = "", 21 | icon_colour = "#000000ff", 22 | icon_scale = NULL, 23 | fill_colour = NULL 24 | ) 25 | } 26 | \arguments{ 27 | \item{sf}{An object of class \code{sf}} 28 | 29 | \item{path}{Path where to save the .kml output.} 30 | 31 | \item{name}{Column to be used for names.} 32 | 33 | \item{keep_other_columns}{Logical, defaults to TRUE. If you don't want to keep in the output data columns present in the original \code{sf} object, set this to FALSE.} 34 | 35 | \item{description}{Column to be used for description.} 36 | 37 | \item{label_text}{Column to be used as label text. Defaults to NULL. Corresponds to "LABEL" element in OGR.} 38 | 39 | \item{label_font}{Font family to be used for the font. Defaults to "Roboto Sans, Noto Sans, Helvetica"} 40 | 41 | \item{label_size}{Size of the label. Defaults to "24pt"} 42 | 43 | \item{label_placement}{Defaults to "m" (centre and middle-aligned). For more options, check: https://gdal.org/user/ogr_feature_style.html} 44 | 45 | \item{label_scale}{Scale of label. Defaults to NULL. If given, changes label size (e.g. 1 = default, 2 = twice as big, 0.5, half as big, etc.)} 46 | 47 | \item{line_colour}{Defaults to "#ffffffff" (i.e. white, with 100\% opacity). Line corresponds to "PEN" in OGR. Accepts 8-digit hex codes to include transparency.} 48 | 49 | \item{line_width}{Defaults to "3pt". Line corresponds to "PEN" in OGR. Besides pt (points), other acceptable units are \code{g}: Map Ground Units (whatever the map coordinate units are), \code{px} Pixels, \code{pt} Points (1/72 inch), \code{mm} Millimeters, \code{cm} Centimeters, \verb{in} Inches.} 50 | 51 | \item{icon_url}{Defaults to "" for no URL. Corresponds to "SYMBOL" in OGR. In case of wrong inputs, Google Earth may show you an ugly yellow pushpin instead (i.e. default to http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png). Available icons offered by Google available at this link: http://kml4earth.appspot.com/icons.html} 52 | 53 | \item{icon_colour}{Defaults to "#000000ff" (i.e. black, with 100\% opacity).} 54 | 55 | \item{icon_scale}{Defaults to NULL. If given, changes icon size (e.g. 1 = default, 2 = twice as big, 0.5, half as big, etc.)} 56 | 57 | \item{fill_colour}{Defaults to NULL. Fill corresponds to "BRUSH" in OGR. If given, colour to be used for filling polygons.} 58 | } 59 | \description{ 60 | Attention: this function requires libkml. 61 | } 62 | \details{ 63 | Attention: label styling is not currently functional, likely due to issues in passing arguments to libkml. In order to change label size, use label_scale, which directly edits the xml file. 64 | 65 | For further details on the exact meaning of each of the parameters, please consult the documentation of OGR (used by GDAL to pass parameters to .kml): https://gdal.org/user/ogr_feature_style.html 66 | } 67 | -------------------------------------------------------------------------------- /man/ll_find_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_find_file.R 3 | \name{ll_find_file} 4 | \alias{ll_find_file} 5 | \title{Find file names. Mostly used internally} 6 | \usage{ 7 | ll_find_file(geo, level, resolution, year, name = "abl", file_type = "rds") 8 | } 9 | \arguments{ 10 | \item{name}{Name of specific dataset being downloaded. Defaults to abl, i.e. administrative boundary line} 11 | 12 | \item{file_type}{} 13 | } 14 | \description{ 15 | Find file names. Mostly used internally 16 | } 17 | -------------------------------------------------------------------------------- /man/ll_find_pop_centre.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_find_pop_centre.R 3 | \name{ll_find_pop_centre} 4 | \alias{ll_find_pop_centre} 5 | \title{Find the population-weighted centre of a municipality} 6 | \usage{ 7 | ll_find_pop_centre( 8 | sf_location, 9 | sf_population_grid, 10 | power = 2, 11 | join = sf::st_intersects, 12 | adjusted = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{power}{Defaults to 2. To give more weight to cells with higher population density, raise the number of residents by the power of.} 17 | 18 | \item{join}{Defaults to sf::st_intersects.} 19 | 20 | \item{adjusted}{If adjusted is set to TRUE, join is ignored. The population of cells along the boundary line are weighted by the share of the cell included within the border.} 21 | } 22 | \description{ 23 | Find the population-weighted centre of a municipality 24 | } 25 | \examples{ 26 | 27 | ll_set_folder("~/R/") 28 | name <- "Pinzolo" 29 | sf_location <- ll_get_nuts_it(name = name, level = "lau", resolution = "high") 30 | 31 | lau_grid_name_temp <- stringr::str_c(name, "_lau_high-st_intersects") 32 | 33 | sf_location_grid <- ll_get_population_grid( 34 | match_sf = sf_location, 35 | match_name = lau_grid_name_temp, 36 | match_country = "IT", 37 | join = sf::st_intersects 38 | ) 39 | 40 | 41 | pop_centre <- ll_find_pop_centre( 42 | sf_location = sf_location, 43 | sf_population_grid = sf_location_grid, 44 | power = 2 45 | ) 46 | } 47 | -------------------------------------------------------------------------------- /man/ll_get_adm_ocha.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_adm_ocha.R 3 | \name{ll_get_adm_ocha} 4 | \alias{ll_get_adm_ocha} 5 | \title{Get administrative boundary lines from OCHA database} 6 | \usage{ 7 | ll_get_adm_ocha( 8 | geo, 9 | level = 0, 10 | match_name = NULL, 11 | source_url = NULL, 12 | silent = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{geo}{A twe letter country code, such as "IT" for Italy and "DE" for Germany} 17 | 18 | \item{match_name}{A name to be used for local caching if a subset of the grid is used. It is the responsibility of the user to keept it consistent. If not given, data are not cached locally.} 19 | 20 | \item{source_url}{A direct link to the zipped version of the csv file in the original database, if automatic download with the country code does not work. For example, for Italy this would be "https://data.humdata.org/dataset/0eb77b21-06be-42c8-9245-2edaff79952f/resource/1e96f272-7d86-4108-b4ca-5a951a8b11a0/download/population_ita_2019-07-01.csv.zip"} 21 | 22 | \item{silent}{} 23 | } 24 | \description{ 25 | Source: https://data.humdata.org/ 26 | } 27 | \examples{ 28 | 29 | if (interactive) { 30 | ll_get_adm_ocha(geo = "UA", level = 3) 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/ll_get_electoral_districts_it.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_electoral_districts_it.R 3 | \name{ll_get_electoral_districts_it} 4 | \alias{ll_get_electoral_districts_it} 5 | \title{Get Italian electoral districts (CC-BY Istat)} 6 | \usage{ 7 | ll_get_electoral_districts_it( 8 | name = NULL, 9 | level = "Circoscrizioni_Camera", 10 | year = 2022, 11 | silent = FALSE, 12 | no_check_certificate = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{level}{Defaults to "Circoscrizioni_Camera". Valid values: 17 | \itemize{ 18 | \item{"Circoscrizioni_Camera"}: Basi geografiche delle circoscrizioni elettorali - Camera dei deputati 19 | \item{"Regioni_Senato"}: Basi geografiche delle circoscrizioni elettorali - Senato della Repubblica 20 | \item{"CAMERA_CollegiPLURINOMINALI_2020"}: Basi geografiche dei collegi elettorali plurinominali - Camera dei deputati 21 | \item{"CAMERA_CollegiUNINOMINALI_2020"}: Basi geografiche dei collegi elettorali uninominali - Camera dei deputati 22 | \item{"SENATO_CollegiPLURINOMINALI_2020"}: Basi geografiche dei collegi elettorali plurinominali - Senato della Repubblica 23 | \item{"SENATO_CollegiUNINOMINALI_2020"}: Basi geografiche dei collegi elettorali uninominali - Senato della Repubblica 24 | \item{"UT_Collegi2020"}: Basi geografiche delle unità territoriali che formano i collegi elettorali (comuni e aree sub-comunali, limitatamente ai comuni di Torino, Genova, Milano, Roma, Napoli e Palermo con territorio ripsrtito su più di un collegio). Geografia comunale vigente alla data della pubblicazione 25 | }} 26 | 27 | \item{year}{Defaults to 2022 (latest available). Currently no other year accepted.} 28 | 29 | \item{no_check_certificate}{Logical, defaults to TRUE. Enable only if certificate issues, and if you are aware of the security implications.} 30 | } 31 | \description{ 32 | 2022 / WGS 84 / UTM zone 32N 33 | } 34 | \details{ 35 | Column names metadata: 36 | 37 | \itemize{ 38 | \item{COD_REG Codice della regione/circoscrizione elettorale del Senato della Repubblica} 39 | \item{DEN_REG Denominazione della regione amministrativa/circoscrizione elettorale Senato della Repubblica} 40 | \item{COD_PRO Codice della provincia} 41 | \item{DEN_P_CM Denominazione della provincia o città metropolitana} 42 | \item{COD_CM Codice della città metropolitana} 43 | \item{PRO_COM Codice del comune} 44 | \item{DEN_COM Denominazione del comune} 45 | \item{CAP_DEN Denominazione del capoluogo di provincia o città metropolitana} 46 | \item{POP_2011 Popolazione - Censimento 2011 } 47 | \item{ASC_COD Codice concatenato comune e area sub-comunale} 48 | \item{ASC_COD1 Codice progressivo area sub-comunale} 49 | \item{ASC_COD2 Codice alfanumerico dell'area sub-comunale attribuito dal comune} 50 | \item{ASC_NOME Denominazione dell'area sub-comunale} 51 | \item{ASC_TIPO Tipologia di area-sub-comunale} 52 | \item{CIRC_COD Codice della circoscrizione elettorale della Camera dei deputati} 53 | \item{CIRC_DEN Denominazione della circoscrizione elettorale della Camera dei deputati} 54 | \item{CU20_COD Codice del collegio elettorale uninominale della Camera dei deputati} 55 | \item{CP20_COD Codice del collegio elettoraleplurinominale della Camera dei deputati} 56 | \item{SU20_COD Codice del collegio elettorale uninominale del Senato della Repubblica} 57 | \item{SP20_COD Codice del collegio elettorale plurinominale del Senato della Repubblica} 58 | \item{CU20_DEN Denominazione del collegio elettorale uninominale della Camera dei deputati} 59 | \item{CP20_DEN Denominazione del collegio elettorale plurinominale della Camera dei deputati} 60 | \item{SU20_DEN Denominazione del collegio elettorale uninominale del Senato della Repubblica} 61 | \item{SP20_DEN Denominazione del collegio elettorale plurinominale del Senato della Repubblica} 62 | \item{CU20_C1 Sigla del collegio elettorale uninominale della Camera dei deputati} 63 | \item{CP20_C1 Sigla del collegio elettorale plurinominale della Camera dei deputati} 64 | \item{SU20_C1 Sigla del collegio elettorale uninominale del Senato della Repubblica} 65 | \item{SP20_C1 Sigla del collegio elettorale plurinominale del Senato della Repubblica} 66 | } 67 | } 68 | \examples{ 69 | ll_set_folder(fs::path(fs::path_home_r(), "R")) 70 | ll_get_electoral_districts_it() 71 | ll_get_electoral_districts_it(name = "Lombardia 2") 72 | ll_get_electoral_districts_it() \%>\% ggplot2::ggplot() + ggplot2::geom_sf() + ggplot2::labs(title = "Circoscrizioni Camera") 73 | ll_get_electoral_districts_it(level = "SENATO_CollegiUNINOMINALI_2020") \%>\% ggplot2::ggplot() + ggplot2::geom_sf() + ggplot2::labs(title = "Collegi uninominali - Senato") 74 | } 75 | -------------------------------------------------------------------------------- /man/ll_get_gadm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_nuts.R 3 | \name{ll_get_gadm} 4 | \alias{ll_get_gadm} 5 | \title{Get administrative boundaries} 6 | \usage{ 7 | ll_get_gadm(geo, level = 0, version = "4.1") 8 | } 9 | \arguments{ 10 | \item{geo}{Three letter country codes. If a two letter country code is given, it will tentatively be converted to a three-letter country code. Check consistency.} 11 | 12 | \item{level}{Defaults to 0. Available labels, depending on data availability for the specific country, between 0 and 3.} 13 | 14 | \item{version}{Defaults to "4.0". Untested with others.} 15 | } 16 | \value{ 17 | An \code{sf} object 18 | } 19 | \description{ 20 | Source: https://gadm.org/ 21 | } 22 | \examples{ 23 | ll_get_gadm(geo = "UKR", level = 2) 24 | } 25 | -------------------------------------------------------------------------------- /man/ll_get_lau_eu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_lau_eu.R 3 | \name{ll_get_lau_eu} 4 | \alias{ll_get_lau_eu} 5 | \title{Gets local administrative units from Eurostat's website} 6 | \usage{ 7 | ll_get_lau_eu( 8 | gisco_id = NULL, 9 | name = NULL, 10 | year = 2021, 11 | silent = FALSE, 12 | lau_sf = NULL, 13 | fallback = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{gisco_id}{Gisco identifier of the relevant administrative unit. If given, takes precedence over name.} 18 | 19 | \item{name}{Name of the local administrative unit in the local language. Use gisco_id whenever possible, as names of local administrative units are not unique, e.g. there are 11 "Neuenkirchen" in the dataset. If both \code{name} and \code{gisco_id} are NULL, then it returns all municipalities.} 20 | 21 | \item{year}{Year of mapping, defaults to most recent (2021). Available starting with 2011.} 22 | 23 | \item{silent}{Defaults to FALSE. If TRUE, hides copyright notice. Useful e.g. when using this in reports or in loops. The copyright notice must still be shown where the final output is used.} 24 | 25 | \item{lau_sf}{sf object, exactly such as the one that would be returned by \code{ll_get_lau_eu()}. Used to speed-up computation when bulk processing.} 26 | } 27 | \value{ 28 | European LAU in sf format 29 | } 30 | \description{ 31 | Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/lau#lau18 32 | } 33 | \examples{ 34 | 35 | ll_set_folder("~/R/") 36 | ll_get_lau_eu() 37 | } 38 | -------------------------------------------------------------------------------- /man/ll_get_lau_nuts_concordance.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_lau_nuts_concordance.R 3 | \name{ll_get_lau_nuts_concordance} 4 | \alias{ll_get_lau_nuts_concordance} 5 | \title{Gets correspondence tables between local administrative units and nuts from Eurostat's website} 6 | \usage{ 7 | ll_get_lau_nuts_concordance(lau_year = 2019, nuts_year = 2016, silent = FALSE) 8 | } 9 | \arguments{ 10 | \item{lau_year}{Defaults to 2019. See \code{ll_lau_nuts_concordance_links} for details on available combinations.} 11 | 12 | \item{nuts_year}{Defaults to 2016. See \code{ll_lau_nuts_concordance_links} for details on available combinations.} 13 | 14 | \item{silent}{Defaults to FALSE. If TRUE, hides copyright notice. Useful e.g. when using this in reports or in loops. The copyright notice must still be shown where the final output is used.} 15 | } 16 | \value{ 17 | A tibble with a correspondence table. 18 | } 19 | \description{ 20 | Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/lau 21 | } 22 | \details{ 23 | Warning: due to issues in the original data, nuts may not always correspond to the given year for all countries, e.g. in files with nuts 2016 one may find nuts 2013 for single country, e.g. Italy. 24 | Do check the sources for details and ensure complete matching. 25 | } 26 | \examples{ 27 | 28 | ll_set_folder("~/R/") 29 | ll_get_lau_nuts_concordance() 30 | \dontrun{ 31 | lau_with_nuts_df <- ll_get_lau_eu(year = 2018) \%>\% 32 | sf::st_drop_geometry() \%>\% 33 | filter(is.na(LAU_NAME) == FALSE) \%>\% 34 | dplyr::rename(gisco_id = GISCO_ID) \%>\% 35 | dplyr::left_join( 36 | y = ll_get_lau_nuts_concordance( 37 | lau_year = 2018, 38 | nuts_year = 2016 39 | ), 40 | by = "gisco_id" 41 | ) 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /man/ll_get_lau_pt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_lau_pt.R 3 | \name{ll_get_lau_pt} 4 | \alias{ll_get_lau_pt} 5 | \title{Regions and provinces in Italy (high detail, CC-BY Istat)} 6 | \usage{ 7 | ll_get_lau_pt( 8 | id = NULL, 9 | name = NULL, 10 | year = 2017, 11 | level = "concelho", 12 | silent = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{id}{A character vector composed of six digits. Corresponds to "dicofre".} 17 | 18 | \item{year}{Defaults to 2017 (latest and currently only available).} 19 | 20 | \item{level}{Defaults to "freguesia". Valid value include "freguesia", "concelho", "distrito", "des_simpli".} 21 | } 22 | \description{ 23 | Source: https://dados.gov.pt/pt/datasets/freguesias-de-portugal/ 24 | } 25 | \examples{ 26 | ll_set_folder(fs::path(fs::path_home_r(), "R")) 27 | ll_get_lau_pt() 28 | ll_get_lau_pt(name = "Porto") 29 | } 30 | -------------------------------------------------------------------------------- /man/ll_get_nuts_eu.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_nuts_eu.R 3 | \name{ll_get_nuts_eu} 4 | \alias{ll_get_nuts_eu} 5 | \title{Gets NUTS as sf object from Eurostat's website} 6 | \usage{ 7 | ll_get_nuts_eu( 8 | nuts_id = NULL, 9 | nuts_name = NULL, 10 | level = 3, 11 | resolution = 60, 12 | year = 2021, 13 | silent = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{nuts_id}{NUTS id. Must correspond to the level given. e.g. "DE149" for the NUTS3 regionion of Sigmaringen in Germany.} 18 | 19 | \item{nuts_name}{Name of the NUTS region. Run \code{ll_get_nuts_eu()} to check valid values in \code{NUTS_NAME} column.} 20 | 21 | \item{level}{Defaults to 3, corresponding to nuts3. Available values are: 0, 1, 2, and 3.} 22 | 23 | \item{resolution}{Defaults to "60", for 1:60 Million. Available values: are 20, 10, 3, 1 (1 is highest quality available).} 24 | 25 | \item{year}{Defaults to 2021 Available values: 2021, 2016, 2013, 2010, 2006, 2003} 26 | } 27 | \value{ 28 | NUTS in sf format 29 | } 30 | \description{ 31 | Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units/nuts#nuts16 32 | } 33 | \examples{ 34 | ll_get_nuts_eu() 35 | } 36 | -------------------------------------------------------------------------------- /man/ll_get_nuts_it.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_nuts_it.R 3 | \name{ll_get_nuts_it} 4 | \alias{ll_get_nuts_it} 5 | \title{Regions and provinces in Italy (high detail, CC-BY Istat)} 6 | \usage{ 7 | ll_get_nuts_it( 8 | name = NULL, 9 | level = 2, 10 | year = 2023, 11 | resolution = "low", 12 | silent = FALSE, 13 | no_check_certificate = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{level}{Defaults to "2", i.e. regioni. Available: "3" (i.e. province), and "lau", local administrative units.} 18 | 19 | \item{year}{Defaults to 2023 (latest available).} 20 | 21 | \item{resolution}{Defaults to "low". Valid values are either "low" or "high".} 22 | 23 | \item{no_check_certificate}{Logical, defaults to FALSE. Enable only if certificate issues, and if you are aware of the security implications.} 24 | } 25 | \description{ 26 | 2019 / WGS84 UTM32N 27 | } 28 | \examples{ 29 | ll_set_folder(fs::path(fs::path_home_r(), "R")) 30 | ll_get_nuts_it() 31 | ll_get_nuts_it(name = "Rimini", level = 3) 32 | } 33 | -------------------------------------------------------------------------------- /man/ll_get_nuts_us.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_us.R 3 | \name{ll_get_nuts_us} 4 | \alias{ll_get_nuts_us} 5 | \title{Get US counties} 6 | \usage{ 7 | ll_get_nuts_us(level = "county", resolution = "500k", year = 2018) 8 | } 9 | \arguments{ 10 | \item{level}{Defaults to "county". Available options are: "cd116" (for congressional districts of the 116th Congress)} 11 | 12 | \item{resolution}{Defaults to "500k", max available resolution. Available options are: "5m" and "20m"} 13 | 14 | \item{year}{Defaults to 2018} 15 | } 16 | \description{ 17 | Source: https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html 18 | } 19 | \examples{ 20 | ll_get_nuts_us(level = "county", resolution = "500k", year = 2018) 21 | } 22 | -------------------------------------------------------------------------------- /man/ll_get_population_grid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_population_grid.R 3 | \name{ll_get_population_grid} 4 | \alias{ll_get_population_grid} 5 | \title{Get EU 1km population grid} 6 | \usage{ 7 | ll_get_population_grid( 8 | year = 2018, 9 | match_sf = NULL, 10 | match_name = NULL, 11 | match_country = NULL, 12 | join = sf::st_intersects, 13 | silent = FALSE, 14 | population_grid_sf = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{year}{Defaults to 2018. Currently, the EU population grid is available only for the year 2006, 2011, and 2018.} 19 | 20 | \item{match_sf}{An sf object to be matched with the population grid. If not given, full grid is returned.} 21 | 22 | \item{match_name}{A name to be used for local caching. It is the responsibility of the user to keept it consistent. If not given, data are not cached locally.} 23 | 24 | \item{match_country}{Defaults to NULL. If given, used to speed up processing.} 25 | 26 | \item{join}{The function to use for filtering. Defaults to sf::st_intersects. Alternative includes the likes of sf::st_within, sf::st_touches, etc.} 27 | 28 | \item{population_grid_sf}{Defaults to NULL. If given, it uses this one as population grid of reference. Useful to bulk process items, as it removes the need for re-loading the grid from local storage at each iteration.} 29 | } 30 | \value{ 31 | An sf object with the population grid. 32 | } 33 | \description{ 34 | Source: https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/population-distribution-demography/geostat 35 | More details: https://ec.europa.eu/eurostat/statistics-explained/index.php/Population_grids 36 | } 37 | -------------------------------------------------------------------------------- /man/ll_get_population_grid_hr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_population_grid_high_resolution.R 3 | \name{ll_get_population_grid_hr} 4 | \alias{ll_get_population_grid_hr} 5 | \title{Get High Resolution Population Density Maps + Demographic Estimates} 6 | \usage{ 7 | ll_get_population_grid_hr( 8 | geo, 9 | match_sf = NULL, 10 | match_name = NULL, 11 | population_grid_sf = NULL, 12 | join = sf::st_intersects, 13 | file_format = "CSV", 14 | dataset = "population|general", 15 | source_url = NULL, 16 | silent = FALSE 17 | ) 18 | } 19 | \arguments{ 20 | \item{geo}{A twe letter country code, such as "IT" for Italy and "DE" for Germany} 21 | 22 | \item{match_sf}{An sf object to me matched with the population grid. If not given, full grid is returned.} 23 | 24 | \item{match_name}{A name to be used for local caching if a subset of the grid is used. It is the responsibility of the user to keept it consistent. If not given, data are not cached locally.} 25 | 26 | \item{file_format}{Defaults to "CSV". Other available formats include "GeoTIFF", "JSON", "zip", "GDAL Virtual Format". Currently only CSV supported.} 27 | 28 | \item{dataset}{Defaults to "population". Beginning of the name of the dataset. For alternatives, see e.g. \code{population_grid_hr_metadata \%>\% dplyr::filter(country_code=="IT") \%>\% dplyr::distinct(name)}. Currently only tested with default value.} 29 | 30 | \item{source_url}{A direct link to the zipped version of the csv file in the original database, if automatic download with the country code does not work. For example, for Italy this would be "https://data.humdata.org/dataset/0eb77b21-06be-42c8-9245-2edaff79952f/resource/1e96f272-7d86-4108-b4ca-5a951a8b11a0/download/population_ita_2019-07-01.csv.zip"} 31 | 32 | \item{silent}{} 33 | } 34 | \description{ 35 | Source: https://data.humdata.org/organization/facebook 36 | Details on methodology: https://dataforgood.fb.com/docs/methodology-high-resolution-population-density-maps-demographic-estimates/ 37 | } 38 | -------------------------------------------------------------------------------- /man/ll_get_world.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_world.R 3 | \name{ll_get_world} 4 | \alias{ll_get_world} 5 | \title{Get countries as an sf object} 6 | \usage{ 7 | ll_get_world(resolution = "60", year = 2020, name = NULL) 8 | } 9 | \arguments{ 10 | \item{resolution}{Defaults to "60", for 1:60 Million. Available values: are 20, 10, 3, 1 (1 is highest quality available)-} 11 | 12 | \item{year}{Defaults to 2020. Available values: 2020, 2016, 2013, 2010, 2006, 2001} 13 | } 14 | \description{ 15 | Get countries as an sf object 16 | } 17 | -------------------------------------------------------------------------------- /man/ll_match.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_match_geo.R 3 | \name{ll_match} 4 | \alias{ll_match} 5 | \title{Matches a data frame with longitude and latitude to an sf object} 6 | \usage{ 7 | ll_match( 8 | data, 9 | longitude = 1, 10 | latitude = 2, 11 | join = sf::st_intersects, 12 | sample = NULL, 13 | match = longlat2map::ll_get_world() 14 | ) 15 | } 16 | \arguments{ 17 | \item{data}{A data frame or tibble with a column for longitude and one for latitude or an onject of the sf class. If an sf object is given, the longitude and latitude parameters are ignored.} 18 | 19 | \item{longitude}{The exact column name or the column index (e.g. 1 if first column) for longitude. Defaults to 1.} 20 | 21 | \item{latitude}{The exact column name or the column index (e.g. 1 if first column) for latitude. Defaults to 2.} 22 | 23 | \item{join}{A function of the sf class determining the type of join. Defaults to \code{sf::st_intersects}. Check \code{?sf::st_join} for alternatives.} 24 | 25 | \item{sample}{Defaults to NULL. If given, it runs the matching with only a subset of the original dataframe. Suggested for testing in particular when working with big datasets.} 26 | 27 | \item{match}{An sf object to be matched with the given dataframe, defaults to \code{longlat2map::ll_get_world()}. This package facilitate obtaining alternative reference maps with functions such as \code{longlat2map::ll_get_nuts_eu()} and \code{longlat2map::ll_get_nuts_us()}} 28 | } 29 | \value{ 30 | An sf object with CRS 4326. 31 | } 32 | \description{ 33 | Matches a data frame with longitude and latitude to an sf object 34 | } 35 | -------------------------------------------------------------------------------- /man/ll_osm_countries.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{ll_osm_countries} 5 | \alias{ll_osm_countries} 6 | \title{Countries and geographic entities for which shapefiles are made availabile by Geofabrik} 7 | \format{ 8 | A tibble 9 | \describe{ 10 | \item{continent}{Name of the continent} 11 | \item{country}{Name of the country} 12 | \item{link}{Link to shapefiles in a tibble} 13 | } 14 | } 15 | \source{ 16 | \url{http://download.geofabrik.de/} 17 | } 18 | \usage{ 19 | ll_osm_countries 20 | } 21 | \description{ 22 | A dataset with all names of countries, continents, as included in the Geofabrik database. 23 | They are used to download files with \code{ll_osm_download()} 24 | } 25 | \details{ 26 | Links to shapefiles are stored as tibbles. Unnest to see them, e.g. 27 | \code{ll_osm_countries \%>\% tidyr::unnest(link)} 28 | or for a single country: 29 | \code{ll_osm_countries \%>\% dplyr::filter(country == "italy") \%>\% tidyr::unnest(link)} 30 | } 31 | \keyword{datasets} 32 | -------------------------------------------------------------------------------- /man/ll_osm_download.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_osm_download.R 3 | \name{ll_osm_download} 4 | \alias{ll_osm_download} 5 | \title{Download OSM data for whole countries from Geofabrik.} 6 | \usage{ 7 | ll_osm_download(countries, overwrite = FALSE, wget = FALSE) 8 | } 9 | \arguments{ 10 | \item{countries}{One or more country names. For details on available country names see the dataset included in this package: \code{ll_osm_countries}} 11 | 12 | \item{overwrite}{Logical, defaults to FALSE. If true, downloads new files even if already present.} 13 | 14 | \item{wget}{Logical, defaults to FALSE. If TRUE, it downloads files with wget (if available), otherwise uses default method. Setting wget to TRUE may contribute to prevent download timeouts; notice that apparent freeze of the download progress in the console are common, and mostly the download is just continuing in the background (for reference, check file size in folder.)} 15 | } 16 | \value{ 17 | Used only for its side effects (downloads osm data). 18 | } 19 | \description{ 20 | N.B. Names do not always correspond to official name of countries and may include different geographic entities. 21 | For a full list of available "countries" as made available by Geofabrik, see the internal dataset \code{ll_osm_countries}. 22 | Be considered in downloading files. 23 | } 24 | \examples{ 25 | \dontrun{ 26 | ll_osm_download(countries = "Romania") 27 | ll_osm_download(countries = c("chile", "colombia")) 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /man/ll_osm_download_it.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_osm_download.R 3 | \name{ll_osm_download_it} 4 | \alias{ll_osm_download_it} 5 | \title{Download OSM data in geopackage format for regions, provinces, and municipalities in Italy.} 6 | \usage{ 7 | ll_osm_download_it( 8 | level = "comuni", 9 | name = NULL, 10 | code = NULL, 11 | overwrite = FALSE, 12 | wget = FALSE, 13 | quiet = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{level}{One of "regioni", "provincie", "comuni". Defaults to "comuni".} 18 | 19 | \item{name}{Name of geographic entity. Check \code{ll_osm_it_gpkg} or \code{ll_get_nuts_it()} for valid names.} 20 | 21 | \item{code}{Used in alternative to name. Check \code{ll_osm_it_gpkg} or \code{ll_get_nuts_it()} for valid values.} 22 | 23 | \item{wget}{Logical, defaults to FALSE. If TRUE, it downloads files with wget (if available), otherwise uses default method. Setting wget to TRUE may contribute to prevent download timeouts; notice that apparent freeze of the download progress in the console are common, and mostly the download is just continuing in the background (for reference, check file size in folder.)} 24 | 25 | \item{quiet}{Logical, defaults to FALSE. If TRUE no messages about download advancement are printed.} 26 | } 27 | \value{ 28 | Used only for its side effects (downloads osm data). 29 | } 30 | \description{ 31 | See \code{ll_osm_it_gpkg} for all available files. 32 | } 33 | \examples{ 34 | \dontrun{ 35 | ll_osm_download_it(level = "comuni", name = "Trento") 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /man/ll_osm_extract_it.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_osm_download.R 3 | \name{ll_osm_extract_it} 4 | \alias{ll_osm_extract_it} 5 | \title{Extract OSM data for regions, provinces, and municipalities in Italy.} 6 | \usage{ 7 | ll_osm_extract_it( 8 | level = "comuni", 9 | name = NULL, 10 | code = NULL, 11 | layer = "lines", 12 | quiet = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{level}{One of "regioni", "provincie", "comuni". Defaults to "comuni".} 17 | 18 | \item{name}{Name of geographic entity. Check \code{ll_osm_it_gpkg} or \code{ll_get_nuts_it()} for valid names.} 19 | 20 | \item{code}{Used in alternative to name. Check \code{ll_osm_it_gpkg} or \code{ll_get_nuts_it()} for valid values.} 21 | 22 | \item{layer}{Defaults to "lines". Must be one of "points", "lines", "multilinestrings", "multipolygons", or "other_relations"} 23 | 24 | \item{quiet}{Logical, defaults to FALSE. If TRUE, supresses messages generated when reading the geopackage file.} 25 | } 26 | \value{ 27 | An sf object. 28 | } 29 | \description{ 30 | See \code{ll_osm_it_gpkg} for all available files. 31 | } 32 | \examples{ 33 | \dontrun{ 34 | ll_osm_extract_it(level = "comuni", name = "Trento") 35 | } 36 | 37 | } 38 | -------------------------------------------------------------------------------- /man/ll_osm_extract_roads.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_osm.R 3 | \name{ll_osm_extract_roads} 4 | \alias{ll_osm_extract_roads} 5 | \title{Extract from zip shape files of roads from previously downloaded} 6 | \usage{ 7 | ll_osm_extract_roads(countries, download_if_missing = TRUE, overwrite = FALSE) 8 | } 9 | \arguments{ 10 | \item{countries}{The name of one or more geographic entities from files typically previously downloaded with \code{ll_osm_download()}} 11 | 12 | \item{download_if_missing}{Logical, defaults to TRUE. If TRUE, downloads country files with \code{ll_osm_download()} if they are not available locally.} 13 | 14 | \item{overwrite}{Logical, defaults to FALSE. If TRUE, extracts files from zip even if folder already existing.} 15 | } 16 | \value{ 17 | Nothing, used for its side effects (extracts shapefiles from country-level zip files) 18 | } 19 | \description{ 20 | Extract from zip shape files of roads from previously downloaded 21 | } 22 | \examples{ 23 | \dontrun{ 24 | ll_extract_roads(countries = "Romania") 25 | } 26 | 27 | } 28 | -------------------------------------------------------------------------------- /man/ll_osm_get_lau_streets.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_lau_eu.R 3 | \name{ll_osm_get_lau_streets} 4 | \alias{ll_osm_get_lau_streets} 5 | \title{Get all streets available in OpenStreetMap located in given local 6 | administrative unit.} 7 | \usage{ 8 | ll_osm_get_lau_streets( 9 | gisco_id, 10 | country = NULL, 11 | unnamed_streets = TRUE, 12 | lau_boundary_sf = NULL, 13 | streets_sf = NULL, 14 | country_code_type = "eurostat", 15 | year = 2021, 16 | fallback = TRUE 17 | ) 18 | } 19 | \arguments{ 20 | \item{gisco_id}{Gisco identifier.} 21 | 22 | \item{country}{Name of country as included in Geofabrik's datasets, does not 23 | always match common country names or geography. For details on available 24 | country names see the dataset included in this package: \code{ll_osm_countries}} 25 | 26 | \item{unnamed_streets}{Defaults to TRUE. If FALSE, it drops all streets with 27 | missing "name" or missing "fclass".} 28 | 29 | \item{lau_boundary_sf}{Defaults to NULL. If given, used to speed up 30 | processing. Must be an \code{sf} object such as the ones output by by \code{ll_get_lau_eu()}.} 31 | 32 | \item{streets_sf}{Defaults to NULL. If given, used to speed up processing. 33 | Must be an \code{sf} object such as the ones output by \code{ll_osm_get_roads()}.} 34 | 35 | \item{country_code_type}{Defaults to "eurostat". An alternative common value 36 | is "iso2c". See \code{countrycode::codelist} for a list of available codes.} 37 | 38 | \item{year}{Year of LAU boundaries, defaults to most recent (2021), passed to 39 | \code{ll_get_lau_eu()}. Available starting with 2011.} 40 | 41 | \item{fallback}{Logical, defaults to TRUE. If a \code{gisco_id} does not match an 42 | entity in \code{ll_get_lau_eu()}, try alternatives for the boundaries based on 43 | the country code, including \code{ll_get_nuts_eu()}, \code{ll_get_gadm()}, and 44 | \code{ll_get_adm_ocha()}.} 45 | } 46 | \value{ 47 | An \code{sf} objects with all streets of a given LAU based on 48 | OpenStreetMap 49 | } 50 | \description{ 51 | Relies on the output of \code{ll_get_lau_eu()} for the boundaries of local 52 | administrative units. 53 | } 54 | \examples{ 55 | \dontrun{ 56 | ll_osm_get_lau_streets(gisco_id = "IT_022205", unnamed_streets = FALSE) 57 | 58 | # or if country name does not match 59 | 60 | ll_osm_get_lau_streets(gisco_id = "EL_01020204", country = "greece") 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /man/ll_osm_get_nuts_streets.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_get_lau_eu.R 3 | \name{ll_osm_get_nuts_streets} 4 | \alias{ll_osm_get_nuts_streets} 5 | \title{Get all streets available in OpenStreetMap located in given NUTS.} 6 | \usage{ 7 | ll_osm_get_nuts_streets( 8 | nuts_id, 9 | level = 3, 10 | resolution = 1, 11 | country = NULL, 12 | unnamed_streets = TRUE, 13 | nuts_boundary_sf = NULL, 14 | streets_sf = NULL, 15 | country_code_type = "eurostat", 16 | year = 2021 17 | ) 18 | } 19 | \arguments{ 20 | \item{nuts_id}{NUTS region identifier.} 21 | 22 | \item{country}{Name of country as included in Geofabrik's datasets, does not 23 | always match common country names or geography. For details on available 24 | country names see the dataset included in this package: \code{ll_osm_countries}} 25 | 26 | \item{unnamed_streets}{Defaults to TRUE. If FALSE, it drops all streets with 27 | missing "name" or missing "fclass".} 28 | 29 | \item{streets_sf}{Defaults to NULL. If given, used to speed up processing. 30 | Must be an \code{sf} object such as the ones output by \code{ll_osm_get_roads()}.} 31 | 32 | \item{country_code_type}{Defaults to "eurostat". An alternative common value 33 | is "iso2c". See \code{countrycode::codelist} for a list of available codes.} 34 | 35 | \item{year}{Year of LAU boundaries, defaults to most recent (2021), passed to 36 | \code{ll_get_lau_eu()}. Available starting with 2011.} 37 | } 38 | \value{ 39 | An \code{sf} objects with all streets of a given NUTS regions based on 40 | OpenStreetMap 41 | } 42 | \description{ 43 | Relies on the output of \code{ll_get_nuts_eu()} for the boundaries of NUTS. 44 | } 45 | \examples{ 46 | \dontrun{ 47 | ll_osm_get_nuts_streets(nuts_id = "PT16D", country = "portugal") 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /man/ll_osm_get_roads.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_osm.R 3 | \name{ll_osm_get_roads} 4 | \alias{ll_osm_get_roads} 5 | \title{Extract shape files of roads from previously downloaded} 6 | \usage{ 7 | ll_osm_get_roads(country, silent = FALSE) 8 | } 9 | \arguments{ 10 | \item{country}{The name of one or more geographic entities from files typically previously downloaded with \code{ll_osm_download()}} 11 | 12 | \item{silent}{Defaults to FALSE. If TRUE, hides copyright notice. Useful e.g. when using this in reports or in loops. The copyright notice must still be shown where the final output is used.} 13 | } 14 | \value{ 15 | All roads in a country by OpenStreetMap. 16 | } 17 | \description{ 18 | Extract shape files of roads from previously downloaded 19 | } 20 | \examples{ 21 | \dontrun{ 22 | ll_osm_get_roads(country = "Romania") 23 | } 24 | 25 | } 26 | -------------------------------------------------------------------------------- /man/ll_osm_it_gpkg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{ll_osm_it_gpkg} 5 | \alias{ll_osm_it_gpkg} 6 | \title{Geographic entities in Italy for which geopackage files are availabile} 7 | \format{ 8 | A list of tibbles 9 | } 10 | \source{ 11 | \url{https://osmit-estratti.wmcloud.org/} 12 | } 13 | \usage{ 14 | ll_osm_it_gpkg 15 | } 16 | \description{ 17 | A dataset with all names of geographic entities available for direct download as geopackage files 18 | They are used to download files with \code{ll_osm_download_it()} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /man/ll_set_folder.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ll_set_folder.R 3 | \name{ll_set_folder} 4 | \alias{ll_set_folder} 5 | \title{Set folder for caching data} 6 | \usage{ 7 | ll_set_folder(path = NULL) 8 | } 9 | \arguments{ 10 | \item{path}{A path to a location. If the folder does not exist, it will be created.} 11 | } 12 | \value{ 13 | The path to the caching folder, if previously set. 14 | } 15 | \description{ 16 | Set folder for caching data 17 | } 18 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \verb{magrittr::[\\\%>\\\%][magrittr::pipe]} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/population_grid_hr_metadata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{population_grid_hr_metadata} 5 | \alias{population_grid_hr_metadata} 6 | \title{A data frame with links to High Resolution Population Density Maps distributed by Facebook on HDX} 7 | \format{ 8 | A tibble 9 | \describe{ 10 | \item{country}{Name of the country in English} 11 | \item{country_code}{Two letter code as used by eurostat, see also \code{countrycode::codelist$eurostat}} 12 | \item{download_ulr}{Link to zipped dataset} 13 | \item{url}{Link to page describing the dataset} 14 | } 15 | } 16 | \source{ 17 | \url{https://data.humdata.org/} 18 | } 19 | \usage{ 20 | population_grid_hr_metadata 21 | } 22 | \description{ 23 | It is used to download files with \code{ll_get_population_grid_hr()} 24 | } 25 | \keyword{datasets} 26 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /vignettes/figure/bologna_lau_hr-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/bologna_lau_hr-1.png -------------------------------------------------------------------------------- /vignettes/figure/it_nuts2_hr-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/it_nuts2_hr-1.png -------------------------------------------------------------------------------- /vignettes/figure/it_nuts2_lr-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/it_nuts2_lr-1.png -------------------------------------------------------------------------------- /vignettes/figure/pop_weighted_centre_palmanova-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/pop_weighted_centre_palmanova-1.png -------------------------------------------------------------------------------- /vignettes/figure/pop_weighted_centre_palmanova_hr-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/pop_weighted_centre_palmanova_hr-1.png -------------------------------------------------------------------------------- /vignettes/figure/sweden_be_4_3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/sweden_be_4_3-1.png -------------------------------------------------------------------------------- /vignettes/figure/sweden_bw_thin-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/sweden_bw_thin-1.png -------------------------------------------------------------------------------- /vignettes/figure/uk_lau-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/uk_lau-1.png -------------------------------------------------------------------------------- /vignettes/figure/viewnna_pop_grid-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/giocomai/latlon2map/03c101112ce7cf9af35e1ce0ec2e3575de6e7e7c/vignettes/figure/viewnna_pop_grid-1.png -------------------------------------------------------------------------------- /vignettes/removing_the_boring.Rmd.orig: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Removing the boring parts from geocomputation with European data" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{removing_the_boring} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.width = 6, 15 | fig.height = 4.5 16 | ) 17 | 18 | library("ggplot2") 19 | theme_set(theme_void(base_family = "Roboto Condensed") + 20 | theme(title = element_text(size = 14, face = "bold"), 21 | plot.subtitle = element_text(face = "plain"), 22 | plot.caption = element_text(face = "plain"))) 23 | ``` 24 | 25 | There are a number of small things that unneccesarily complicate using geographic data in Europe. The fact that even mapping data released by Eurostat [are not distributed with a license that allows for their re-distribution](https://ec.europa.eu/eurostat/web/gisco/geodata/reference-data/administrative-units-statistical-units), makes it more difficult to liberally pre-process and distribute such data as is common for example in the United States where they are usually released in the public domain.^[The licensing is particularly problematic since it does not allow to use the data "for commercial purposes": does this mean that data journalists can or cannot use these data? If somebody in relevant EU institutions reads this, I beg you, please, please, release geographic data in the public domain.] But beyond the licensing, there are still a number of small operations to do - find the data, download, uncompress, import in a useful format - and they all take time, and are boring, and demotivating. 26 | 27 | So instead of spending time trying to make a map that is nice and useful, users (I have in mind data journalists, but this may relate to other users as well) waste a lot of time getting the data into R. They also end up having multiple copies of similar datasets, and end up sharing code that is not reproducible. How does it happen? 28 | 29 | Let's say I make a visualisation of electoral data. I use a geographic dataset on municipalities, and store it somewhere in my working folder. If I share the code, I often do not share also the geographic dataset due to size or licensing issues... I can then make a textual reference, or include a lot of boilerplate code that downloads the data if they are not locally available, uncompress, import, process them, etc. Even if I do all of the above, when the following week I will make another map for an article on climate change, I will end up redownloading the dataset, etc., ending up with multiple copies of the same geographic dataset. If I keep my folders synced, this also implies a lot of unnecessary files stored in the cloud, slowing the sync of the few lines of code that I'd actually like to be synced. 30 | 31 | The package `latlon2map` deals with all of the above, easing the pain of the R user doing geocomputation. The package addresses the needs of data journalists and data enthusiasts, will be of particular use to non-experienced R programmers, but will likely be useful to users with all levels of experience. Please bear in mind that the package is functional, but is at an early stage of development, and is targeted mainly at Europe-based users. 32 | 33 | ## Getting the data 34 | 35 | The core idea of `latlon2map` is to make the process of caching geographic datasets as frictionless but also as transparent as possible. 36 | 37 | The first thing to do is to set a folder where all data will be cached. This should normally by a folder that you do not sync, e.g. 38 | 39 | 40 | ```{r setup} 41 | library("ggplot2", quietly = TRUE) 42 | library("dplyr", quietly = TRUE) 43 | library("sf", quietly = TRUE) 44 | 45 | library("latlon2map") 46 | ll_set_folder(path = "~/R") 47 | ``` 48 | 49 | All functions to get maps start with `ll_get_` to facilitate auto-completion, and all of them output `sf` objects with crs 4326. As such, they can be directly used in graphs, without even the need to store them as separate objects. 50 | 51 | If I want a map with local administrative units in the UK, for example, I can run the following code. 52 | 53 | ```{r uk_lau, eval = TRUE} 54 | ggplot()+ 55 | geom_sf(data = ll_get_lau_eu() %>% 56 | filter(CNTR_CODE == "UK")) 57 | 58 | ``` 59 | 60 | 61 | The first time that this is run it will download data from Eurostat's website, unzip it, import as an `sf` object, and store it locally for quick retrieval. This means that if you run the same piece of code a second time, it will print the map almost instantly. 62 | 63 | Here is for example the code for having NUTS2 regions in Italy. 64 | 65 | ```{r it_nuts2_lr} 66 | ggplot()+ 67 | geom_sf(data = ll_get_nuts_eu(level = 2) %>% 68 | filter(CNTR_CODE == "IT")) 69 | 70 | ``` 71 | 72 | Or with higher resolution: 73 | 74 | ```{r it_nuts2_hr} 75 | ggplot()+ 76 | geom_sf(data = ll_get_nuts_eu(level = 2, resolution = 1) %>% 77 | filter(CNTR_CODE == "IT")) 78 | ``` 79 | 80 | 81 | Check all the available options looking at the help files, e.g. `?ll_get_nuts_eu`. 82 | 83 | The package may include data from other statistical services; currently, it integrates geographic data published by Istat in Italy to have higher detail. 84 | 85 | This for example shows the boundary of the city of Bologna, in Italy. The data for the specific geographic unit are also cached separately, so a second run of this code will give the result almost immediately (to clarify: if will not open the full dataset and filter for Bologna, but will open a pre-cached file with only the data for Bologna to increase speed and reduce memory requirements). 86 | ```{r bologna_lau_hr, eval=TRUE} 87 | ggplot()+ 88 | geom_sf(data = ll_get_nuts_it(name = "Bologna", 89 | level = "lau", 90 | resolution = "high")) 91 | ``` 92 | 93 | 94 | What is important is that this code can easily be shared and will work even if the geographics datasets are not previously present on the computer where the same code will be run. Even if you have many different projects using this data, only one copy will need to be stored on a given workstation. 95 | 96 | Information on copyright is displayed on the console at each call of the function unless `silent = TRUE` is enabled. 97 | 98 | The original shapefiles and the accompanying documentation remains stored under the folder `ll_data`. 99 | 100 | ## Getting the right proportions 101 | 102 | Another small nuisance is related to including in the same post maps or areas with different proportions. 103 | 104 | For example, Portugal and the Netherlands have different shapes, but I'd like to have all maps in my my post with the same height/width ratio. This is slightly complicated by the fact that scales are in degrees, so it take some effort to get get them right. The function `ll_bbox` takes care of this, so that instead of some maps that are very wide, and some that are very tall, e.g. 105 | 106 | ```{r sweden_bw_thin, eval = TRUE, message = FALSE, warning=FALSE} 107 | remotes::install_github("paleolimbot/ggspatial", upgrade = "never", quiet = TRUE) 108 | library("ggspatial") 109 | 110 | sf_reference <- ll_get_nuts_eu(level = 2, resolution = 1) %>% filter(CNTR_CODE == "SE") 111 | 112 | ggplot() + 113 | annotation_map_tile(type = "stamenbw", 114 | zoomin = 0, 115 | cachedir = fs::path(ll_set_folder(), "ll_data")) + 116 | geom_sf(data = sf_reference, colour = "darkred", fill = NA) 117 | ``` 118 | 119 | ...we can have this all of them with the same proportion. 120 | 121 | ```{r sweden_be_4_3, eval = TRUE} 122 | ggplot() + 123 | annotation_map_tile(type = "stamenbw", zoomin = 0, cachedir = fs::path(ll_set_folder(), "ll_data")) + 124 | geom_sf(data = sf::st_as_sfc(ll_bbox(sf = sf_reference,ratio = "4:3")), fill = NA, color = NA) + 125 | geom_sf(data = sf_reference, colour = "darkred", fill = NA) 126 | ``` 127 | 128 | 129 | ## Get the population grid 130 | 131 | There are more complex geographic data than simple boundary lines. Eurostat for example published a population grid, pointing at how many people lives in each square km of the continent. Such data can be useful for a number of analyses, but they tend to come in big files. Again, `lonlat2map` caches the result, including pre-processed data if a consistent name is provided. 132 | 133 | [the following code chunks are not evaluated for facilitating auto-deploy of the website with vignette] 134 | 135 | ```{r viewnna_pop_grid, eval = TRUE, message=FALSE, warning=FALSE} 136 | name <- "Wien" 137 | 138 | sf_location <- ll_get_lau_eu(name = name) 139 | 140 | desired_bbox <- st_as_sfc(ll_bbox(sf = sf_location, ratio = "16:9")) 141 | 142 | lau_grid_name <- stringr::str_c(name, "_lau_high-st_intersects") 143 | 144 | sf_location_grid <- ll_get_population_grid(match_sf = sf_location, 145 | match_name = lau_grid_name, 146 | match_country = "AT", 147 | join = sf::st_intersects, 148 | silent = TRUE) %>% 149 | dplyr::rename(`Nr. of residents` = TOT_P) 150 | 151 | ggplot() + 152 | annotation_map_tile(type = "stamenbw", zoomin = 0, cachedir = fs::path(ll_set_folder(), "ll_data")) + 153 | geom_sf(data = desired_bbox, fill = NA, color = NA) + 154 | geom_sf(data = sf_location_grid, 155 | mapping = aes(fill = `Nr. of residents`), alpha = 0.5) + 156 | scale_fill_viridis_c() + 157 | geom_sf(data = sf_location, 158 | colour = "darkred", 159 | size = 2, 160 | fill = NA, 161 | alpha = 0.8) + 162 | labs(title = paste(sf_location$LAU_LABEL), 163 | subtitle = "Administrative boundaries and population grid", 164 | caption = "Source: © EuroGeographics for the administrative boundaries 165 | Data source population grid information: Eurostat, EFGS 166 | Map tiles by Stamen Design, under CC BY 3.0 167 | Base map data by OpenStreetMap, under ODbL.") 168 | ``` 169 | 170 | ## Population-weighted centre 171 | 172 | `lonlat2map` includes some convenience functions to deal with normally tedious processes, e.g. finding the population-weighted center of an area. 173 | 174 | ```{r pop_weighted_centre_palmanova, eval = TRUE} 175 | name = "Palmanova" 176 | sf_location <- ll_get_nuts_it(name = name, level = "lau", resolution = "high", silent = TRUE) 177 | 178 | centroid <- sf::st_centroid(sf_location %>% 179 | sf::st_transform(crs = 3857)) %>% 180 | sf::st_transform(crs = 4326) 181 | 182 | desired_bbox <- st_as_sfc(ll_bbox(sf = sf_location, ratio = "4:3")) 183 | 184 | lau_grid_name_temp <- stringr::str_c(name, "_lau_high-st_intersects") 185 | 186 | sf_location_grid <- ll_get_population_grid(match_sf = sf_location, 187 | match_name = lau_grid_name_temp, 188 | match_country = "IT", 189 | join = sf::st_intersects, 190 | silent = TRUE) 191 | 192 | pop_centroid <- ll_find_pop_centre(sf_location = sf_location, 193 | sf_population_grid = sf_location_grid, 194 | power = 2) 195 | 196 | ggplot() + 197 | annotation_map_tile(type = "stamenbw", zoomin = 0, cachedir = fs::path(ll_set_folder(), "ll_data")) + 198 | geom_sf(data = desired_bbox, fill = NA, color = NA) + 199 | geom_sf(data = sf_location_grid %>% rename(`Nr. of residents` = TOT_P), 200 | mapping = aes(fill = `Nr. of residents`), alpha = 0.5) + 201 | scale_fill_viridis_c() + 202 | geom_sf(data = sf_location, 203 | colour = "darkred", 204 | size = 2, 205 | fill = NA, 206 | alpha = 0.8) + 207 | geom_sf(data = centroid, 208 | colour = "darkred", 209 | fill = "coral", 210 | size = 5, 211 | shape = 21, 212 | alpha = 0.8) + 213 | geom_sf(data = pop_centroid, 214 | colour = "blue4", 215 | fill = "cornflowerblue", 216 | size = 5, 217 | shape = 21, 218 | alpha = 0.8) + 219 | labs(title = paste(sf_location$COMUNE), 220 | subtitle = "Administrative boundaries and population grid 221 | Centroid in red, population-weighted centre in blue", 222 | caption = "Source: © EuroGeographics for the administrative boundaries 223 | Data source population grid information: Eurostat, EFGS 224 | Map tiles by Stamen Design, under CC BY 3.0 225 | Base map data by OpenStreetMap, under ODbL.") 226 | 227 | ``` 228 | 229 | The function is flexible, and can be used with more granular population data such as those [distributed by Facebook](https://dataforgood.fb.com/docs/methodology-high-resolution-population-density-maps-demographic-estimates/), which can be loaded with the function `ll_get_population_grid_hr()`. 230 | 231 | ```{r pop_weighted_centre_palmanova_hr, eval=TRUE, message=FALSE,warning=FALSE} 232 | lau_grid_name_temp <- stringr::str_c(name, "_lau_hr-st_intersects") 233 | 234 | sf_location_grid_hr <- ll_get_population_grid_hr(geo = "IT", 235 | match_sf = sf_location, 236 | match_name = lau_grid_name_temp, 237 | join = sf::st_intersects, 238 | silent = TRUE) 239 | 240 | pop_centroid_hr <- ll_find_pop_centre(sf_location = sf_location, 241 | sf_population_grid = sf_location_grid_hr, 242 | power = 5) 243 | 244 | ggplot() + 245 | annotation_map_tile(type = "stamenbw", zoomin = 0, cachedir = fs::path(ll_set_folder(), "ll_data")) + 246 | geom_sf(data = desired_bbox, fill = NA, color = NA) + 247 | geom_sf(data = sf_location_grid_hr %>% rename(`Nr. of residents` = Population), 248 | mapping = aes(colour = `Nr. of residents`), alpha = 0.5) + 249 | scale_colour_viridis_c() + 250 | geom_sf(data = sf_location, 251 | colour = "darkred", 252 | size = 2, 253 | fill = NA, 254 | alpha = 0.8) + 255 | geom_sf(data = centroid, 256 | colour = "darkred", 257 | fill = "coral", 258 | size = 5, 259 | shape = 21, 260 | alpha = 0.8) + 261 | geom_sf(data = pop_centroid_hr, 262 | colour = "blue4", 263 | fill = "cornflowerblue", 264 | size = 5, 265 | shape = 21, 266 | alpha = 0.8) + 267 | labs(title = paste(sf_location$COMUNE), 268 | subtitle = "Administrative boundaries and population grid 269 | Centroid in red, population-weighted centre in blue", 270 | caption = "Source: © EuroGeographics for the administrative boundaries 271 | Facebook High Resolution Population Density Maps (CC-BY) 272 | Map tiles by Stamen Design, under CC BY 3.0 273 | Base map data by OpenStreetMap, under ODbL.") 274 | ``` 275 | 276 | 277 | ## More to come 278 | 279 | This package was started while writing [a blog post](https://codebase.giorgiocomai.eu/2020/03/25/population-weighted-centre/), and not everything may work smoothly at this stage. Feel free to get in touch with the author or [file an issue on GitHub](https://github.com/giocomai/latlon2map). 280 | 281 | Future versions of `lonlat2map` will have integrated support for more data sources, as well as additional functions to facilitate common use cases. 282 | 283 | --------------------------------------------------------------------------------