georeference_image.R
In crstools: Tools to Work with Projections

## ----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