## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(crstools) ## ----image_path--------------------------------------------------------------- file.copy( from = system.file("extdata/europe_map.jpeg", package = "crstools"), to = tempdir(), overwrite = TRUE ) img_path <- file.path(tempdir(), "europe_map.jpeg") ## ----choose_gcp, eval = FALSE------------------------------------------------- # gcp_europe <- choose_gcp(img_path) ## ----save_gcp1, echo = FALSE, eval= FALSE------------------------------------- # # Run me to save the object if you are recreating the vignette # saveRDS(gcp_europe, "./vignettes/img/europe_gcp1.RDS") ## ----load_gcp1, echo = FALSE, results = "hide"-------------------------------- gcp_europe <- readRDS("./img/europe_gcp1.RDS") ## ----gcp_europe--------------------------------------------------------------- gcp_europe ## ----get_coords--------------------------------------------------------------- library(sf) library(rnaturalearth) # Load the world map world <- ne_countries(scale = "medium", returnclass = "sf") # Transform it to a suitable projection world <- st_transform(world, crs = 4326) # WGS 84 # Crop it to the extent of the image to Europe europe <- st_crop(world, c(xmin = -25, ymin = 25, xmax = 45, ymax = 70)) ## ----plot_europe, eval = FALSE------------------------------------------------ # library(ggplot2) # ggplot() + # geom_sf(data = europe, fill = "lightblue", color = "black") + # coord_sf(expand = FALSE) + # ggtitle("Map of Europe") ## ----find_gcp_coords, eval = FALSE-------------------------------------------- # gcp_europe_coords <- find_gcp_coords(gcp_europe, europe) ## ----save_gcp2, echo = FALSE, eval= FALSE------------------------------------- # # Run me to save the object if you are recreating the vignette # saveRDS(gcp_europe_coords, "./vignettes/img/europe_gcp_georef.RDS") ## ----load_gcp2, echo = FALSE, results = "hide"-------------------------------- gcp_europe_coords <- readRDS("./img/europe_gcp_georef.RDS") ## ----gcp_europe_coords-------------------------------------------------------- gcp_europe_coords ## ----georeference_image------------------------------------------------------- georeferenced_image <- georeference_img(img_path, gcp_europe_coords) ## ----load_georeferenced_image------------------------------------------------- map_warp <- terra::rast(georeferenced_image) ## ----plot_warped_image, eval=FALSE-------------------------------------------- # library(ggplot2) # library(tidyterra) # ggplot() + # geom_spatraster_rgb(data = map_warp) + # geom_sf( # data = europe, # color = "orange", # fill = "transparent" # ) + # coord_sf(expand = FALSE) ## ----choose_gcp_version2, eval = FALSE---------------------------------------- # gcp_europe <- choose_gcp(img_path, gcp = gcp_europe) ## ----save_gcp2_update, echo = FALSE, eval= FALSE------------------------------ # # Run me to save the object if you are recreating the vignette # saveRDS(gcp_europe, "./img/europe_gcp2.RDS") ## ----load_gcp2_update, echo = FALSE, results = "hide"------------------------- # Reload if needed gcp_europe <- readRDS("./img/europe_gcp2.RDS") ## ----gcp_europe2-------------------------------------------------------------- gcp_europe ## ----find_gcp_coords_version2, eval = FALSE----------------------------------- # gcp_europe_coords_v2 <- find_gcp_coords(gcp_europe, europe) # # gcp_europe_coords_v2 ## ----save_gcp2_v2, echo = FALSE, eval= FALSE---------------------------------- # saveRDS(gcp_europe_coords_v2, "./img/europe_gcp_georef_v2.RDS") ## ----load_gcp2_v2, echo = FALSE, results = "hide"----------------------------- gcp_europe_coords_v2 <- readRDS("./img/europe_gcp_georef_v2.RDS") ## ----georeference_image_v2, eval=FALSE---------------------------------------- # georeferenced_image_v2 <- georeference_img(img_path, gcp_europe_coords_v2) # # map_warp_v2 <- terra::rast(georeferenced_image_v2) # # # check the new image # ggplot() + # geom_spatraster_rgb(data = map_warp_v2) + # geom_sf( # data = europe, # color = "orange", # fill = "transparent" # ) + # coord_sf(expand = FALSE) ## ----get_coords_2, eval = FALSE----------------------------------------------- # # get the coordinates of the blues points # blue_coords_df <- extract_coords(map_warp_v2) ## ----save_blue_coords, echo = FALSE, eval= FALSE------------------------------ # saveRDS(blue_coords_df, "./img/blue_coords.RDS") ## ----load_blue_coords, echo = FALSE, results = "hide"------------------------- blue_coords_df <- readRDS("./img/blue_coords.RDS") ## ----show_blue_coords--------------------------------------------------------- blue_coords_df ## ----get_coords_3, eval = FALSE----------------------------------------------- # blue_coords_df <- extract_coords(map_warp_v2, blue_coords_df) ## ----save_blue_coords_2, echo = FALSE, eval= FALSE---------------------------- # saveRDS(blue_coords_df, "./img/blue_coords_2.RDS") ## ----load_blue_coords_2, echo = FALSE, results = "hide"----------------------- blue_coords_df <- readRDS("./img/blue_coords_2.RDS") ## ----show_blue_coords2-------------------------------------------------------- blue_coords_df