Início / coding / Perguntas / 79275140
Accepted
Grasshopper_NZ
Asked: 2024-12-12 20:38:39 +0800 CST

É possível colorir o espaço sideral de preto quando a visualização da projeção contém a Terra e o espaço sideral no ggplot com dados sf?

  • 772

Estou fazendo alguns mapas dos EUA e alguns deles contêm tanto a Terra quanto o espaço sideral devido à projeção, como mostrado abaixo:

insira a descrição da imagem aqui

Ele é gerado pelo código abaixo:

library(ggplot2)
library(sf)


# Import Data:
df <- read_sf("https://raw.githubusercontent.com/rfortherestofus/book/refs/heads/main/data/states.geojson")

# Create the map:
ggplot() +
  geom_sf(data = df, fill = "grey90") +
  
  coord_sf(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5") +
  
  theme_minimal() +
  
  theme(
    panel.background = element_rect(fill = "lightblue")   # <- Set the colour for ocean
  )

Gostaria de saber se é possível colorir o espaço sideral (destacado) de preto para refletir a realidade e também tornar a Terra, e portanto os EUA, mais visíveis no mapa?

insira a descrição da imagem aqui

2 respostas

  1. Best Answer

    Uma opção seria criar um novo objeto sf que é uma grade cobrindo o planeta inteiro. Você precisaria transformar isso para sua projeção escolhida e eliminar os painéis ilegais. Depois disso, você pode simplesmente plotá-lo como um sfobjeto normal:

    library(ggplot2)
library(sf)

seas <- st_polygon(list(cbind(c(seq(-180, 180, len = 100),
                                rep(0, 100),
                                seq(180, -180, len = 100),
                                rep(-180, len = 100)), 
                              c(rep(-90, 100),
                                seq(-90, 90, len = 100),
                                rep(90, 100),
                                seq(90, -90, len = 100))))) |>
  st_sfc(crs = "WGS84") |>
  st_sf() |>
  st_make_grid(n = c(200, 200)) |>
  st_transform(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5")

val_st <- st_is_valid(seas)
seas <- seas[!is.na(val_st) & val_st]

ggplot() +
  geom_sf(data = seas, fill = "lightblue", col = "lightblue",
          linewidth = 1) +
  geom_sf(data = df, fill = "grey90") +
  coord_sf(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5",
           xlim = c(-513107, 6513107),
           ylim = c(-400000, 5000000)) +
  theme_minimal() +
  theme(panel.background = element_rect(fill = "black"),
        panel.grid = element_blank())

    insira a descrição da imagem aqui

    Observe que isso cobre as linhas de latitude/longitude, mas você pode adicioná-las explicitamente de volta (sem os artefatos irritantes) especificando uma multilinestring:

    latlon <- st_multilinestring(x = list(cbind(rep(-120, 100), 
                                            seq(0, 90, len = 100)),
                                      cbind(rep(-60, 100), 
                                            seq(0, 90, len = 100)),
                                      cbind(rep(-180, 100), 
                                            seq(0, 90, len = 100)),
                                      cbind(seq(-180, 0, len = 100),
                                            rep(10, 100)),
                                      cbind(seq(-180, 0, len = 100),
                                            rep(20, 100)),
                                      cbind(seq(-180, 0, len = 100),
                                            rep(30, 100)),
                                      cbind(seq(-180, 0, len = 100),
                                            rep(40, 100)),
                                      cbind(seq(-180, 0, len = 100),
                                            rep(50, 100)),
                                      cbind(seq(-180, 0, len = 100),
                                            rep(60, 100)),
                                      cbind(seq(-180, 180, len = 100),
                                            rep(70, 100)))) |>
  st_sfc(crs = "WGS84") |>
  st_sf() |>
  st_transform(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5")

    o que resulta em

    ggplot() +
  geom_sf(data = seas, fill = "lightblue", col = "lightblue",
          linewidth = 1) +
  geom_sf(data = df, fill = "grey90") +
  geom_sf(data = latlon, linewidth = 0.2, col = "gray50") +
  coord_sf(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5",
           xlim = c(-500000, 6000000),
           ylim = c(-400000, 5000000)) +
  theme_minimal() +
  theme(panel.background = element_rect(fill = "black"),
        panel.grid = element_blank(),
        panel.border = element_rect(fill = NA, colour = "black", linewidth = 1))

    insira a descrição da imagem aqui

    Se você não quiser especificar manualmente os limites das coordenadas, você pode obtê-los do seu objeto sf da seguinte maneira:

    crds <- df |> st_transform(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5") |> 
  st_coordinates() |> 
  apply(2, range) 

ggplot() +
  geom_sf(data = seas, fill = "lightblue", col = "lightblue",
          linewidth = 1) +
  geom_sf(data = df, fill = "grey90") +
  geom_sf(data = latlon, linewidth = 0.2, col = "gray50") +
  coord_sf(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5",
           xlim = crds[,1],
           ylim = crds[,2]) +
  theme_minimal() +
  theme(panel.background = element_rect(fill = "black"),
        panel.grid = element_blank(),
        panel.border = element_rect(fill = NA, colour = "black", linewidth = 1),
        axis.text.y = element_blank())

    insira a descrição da imagem aqui

    Se você quiser uma aparência mais 3D, a grade permite que você tenha um preenchimento de gradiente fácil, e suponho que você poderia adicionar um campo de estrela gratuito:

    ggplot() +
  annotate("point", x = I(runif(300)), y = I(runif(300)), color = "white",
           alpha = runif(300), size = 0.3) +
  geom_sf(data = seas, aes(color = after_scale(fill),
            fill = sapply(seas[[1]], function(x) {
              sqrt(sum(colMeans(st_coordinates(x)[,1:2])^2))})),
          linewidth = 1) +
  geom_sf(data = latlon, linewidth = 0.2, col = "gray25") +
  geom_sf(data = df, fill = "#809060") +
  coord_sf(crs = "+proj=ortho +lat_0=22.0 +lon_0=-162.5",
           xlim = crds[,1],
           ylim = crds[,2]) +
  theme_minimal() +
  theme(panel.background = element_rect(fill = "black"),
        panel.grid = element_blank(),
        panel.border = element_rect(fill = NA, colour = "black", linewidth = 1),
        axis.text.y = element_blank(),
        axis.title = element_blank()) +
  scale_fill_gradient(low = "lightblue", high = "deepskyblue4", guide = "none")

    insira a descrição da imagem aqui

    • 4

  2. Você pode falsificar a esfera da Terra, o que é um pouco mais rápido ;) e então combiná-la com seu geom_sf(data = df, fill = "grey90"). Fazer isso, no entanto, não aumentará o zoom automaticamente na América. Então, certifique-se de ajustar xlim = c(-500000, 5600000), ylim = c(-700000, 5000000)para focar na seção correta do planeta.

    library(ggplot2)
library(sf)
library(rnaturalearth)
library(dplyr)
# Load the US states data

# Read the states GeoJSON
df <- read_sf("https://raw.githubusercontent.com/rfortherestofus/book/refs/heads/main/data/states.geojson")


# Define the CRS for orthographic projection
crs <- "+proj=ortho +lat_0=22.0 +lon_0=-162.5 "

# Create a spherical polygon using a large radius

# Create a large buffer to simulate a sphere
sphere <- st_buffer(st_sfc(st_point(c(-162.5, 22)), crs = 4326), dist = 10000000) %>%  # Adjust dist for larger/smaller spheres
  st_transform(crs = crs)

# Generate graticule lines (longitude and latitude lines)
graticule <- st_graticule(nlat = 15, nlong = 15) %>%  # Adjust nlat and nlong for density of lines
  st_transform(crs = crs)

# Plot the map
ggplot() +
  geom_sf(data = sphere, fill = "lightblue", alpha = 1) +  # Sphere
  geom_sf(data = graticule, color = "white", size = 0.5, alpha = 0.8) +  # Graticule (outside sphere)
  geom_sf(data = df, fill = "grey90") +  # States or regions
  coord_sf(xlim = c(-500000, 5600000), ylim = c(-700000, 5000000)) +  # Zoom to desired region
  theme_minimal() +
  theme(panel.background = element_rect(fill = "black"),
        panel.grid = element_blank())

    fora

    • 4

relate perguntas