基于位置和日期创建星图可视化

Question

基于位置和日期创建星图可视化

rd3.jsr-sfastronomy

11

背景

我正在尝试在 R 中基于给定的位置和日期创建天体图。

理想情况下，可视化效果应该像这样：

(来源)

我看到了这个博客，它使用了D3 Celestial Maps，对我创建下面这个可视化图表非常有帮助。

library(sf)
library(tidyverse)


theme_nightsky <- function(base_size = 11, base_family = "") {
  
  theme_light(base_size = base_size, base_family = base_family) %+replace% 
    theme(
      # Specify axis options, remove both axis titles and ticks but leave the text in white
      axis.title = element_blank(),
      axis.ticks = element_blank(),
      axis.text = element_text(colour = "white",size=6),
      # Specify legend options, here no legend is needed
      legend.position = "none",
      # Specify background of plotting area
      panel.grid.major = element_line(color = "grey35"),  
      panel.grid.minor = element_line(color = "grey20"),  
      panel.spacing = unit(0.5, "lines"),
      panel.background = element_rect(fill = "black", color  =  NA),  
      panel.border = element_blank(),  
      # Specify plot options
      plot.background = element_rect( fill = "black",color = "black"),  
      plot.title = element_text(size = base_size*1.2, color = "white"),
      plot.margin = unit(rep(1, 4), "lines")
    )
  
}



# Constellations Data
url1 <- "https://raw.githubusercontent.com/ofrohn/d3-celestial/master/data/constellations.lines.json"
# Read in the constellation lines data using the st_read function
constellation_lines_sf <- st_read(url1,stringsAsFactors = FALSE) %>%
                          st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) %>% 
                          st_transform(crs = "+proj=moll")

# Stars Data
url2 <- "https://raw.githubusercontent.com/ofrohn/d3-celestial/master/data/stars.6.json"
# Read in the stars way data using the st_read function
stars_sf <- st_read(url2,stringsAsFactors = FALSE) %>% 
            st_transform(crs = "+proj=moll")

ggplot()+
  geom_sf(data=stars_sf, alpha=0.5,color="white")+
  geom_sf(data=constellation_lines_sf, size= 1, color="white")+
  theme_nightsky()

我的问题

我在 R 中创建的视觉效果（据我所知）是整个天体图。如何才能获得关于我相对位置的天体图子集呢？

- Bensstats

1

我希望其他人在尝试访问D3 Celestial Maps链接的内容时不会遇到相同的安全阻止。 - IRTFM

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Allan Cameron · Accepted Answer

这似乎是一个（裁剪过的）兰伯特等面积方位投影，而且该地图似乎只考虑到了纬度（因为星图上的中心线看起来像是0度经度）。以下的坐标参考系统看起来大致正确：

library(sf)
library(tidyverse)

toronto <- "+proj=laea +x_0=0 +y_0=0 +lon_0=0 +lat_0=43.6532"

我们需要一种方法来翻转经度坐标，使其看起来像是在天球上向上观察，而不是向下观察。通过使用矩阵执行仿射变换，这个问题相对容易解决。我们在这里定义如下：

flip <- matrix(c(-1, 0, 0, 1), 2, 2)

现在我们还需要一种方法来获取中心点任何方向上90度内的星星（即裁剪结果）。为此，我们可以使用一个大缓冲区，其大小等于地球周长的1/4。只有与该半球相交的星星才应该可见。

hemisphere <- st_sfc(st_point(c(0, 43.6532)), crs = 4326) |>
              st_buffer(dist = 1e7) |>
              st_transform(crs = toronto)

我们现在可以这样获取我们的星座：

constellation_lines_sf <- st_read(url1, stringsAsFactors = FALSE) %>%
  st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) %>% 
  st_transform(crs = toronto) %>%
  st_intersection(hemisphere) %>%
  filter(!is.na(st_is_valid(.))) %>%
  mutate(geometry = geometry * flip) 

st_crs(constellation_lines_sf) <- toronto

我们的星星就像这样：

stars_sf <- st_read(url2,stringsAsFactors = FALSE) %>% 
  st_transform(crs = toronto) %>%
  st_intersection(hemisphere) %>%
  mutate(geometry = geometry * flip) 

st_crs(stars_sf) <- toronto

我们还需要一个圆形掩模来绘制在我们的最终图像周围，以使得结果网格线不会延伸到圆外面：

library(grid)

mask <- polygonGrob(x = c(1, 1, 0, 0, 1, 1, 
                          0.5 + 0.46 * cos(seq(0, 2 *pi, len = 100))),
                    y =  c(0.5, 0, 0, 1, 1, 0.5, 
                           0.5 + 0.46 * sin(seq(0, 2*pi, len = 100))),
                    gp = gpar(fill = '#191d29', col = '#191d29'))

对于绘图本身，我定义了一个看起来更像期望的星图的主题。我将星等的指数映射到大小和透明度上，使其更加逼真。

p <- ggplot() +
  geom_sf(data = stars_sf, aes(size = -exp(mag), alpha = -exp(mag)),
          color = "white")+
  geom_sf(data = constellation_lines_sf, linwidth = 1, color = "white",
          size = 2) +
  annotation_custom(circleGrob(r = 0.46, 
                               gp = gpar(col = "white", lwd = 10, fill = NA))) +
  scale_y_continuous(breaks = seq(0, 90, 15)) +
  scale_size_continuous(range = c(0, 2)) +
  annotation_custom(mask) +
  labs(caption = 'STAR MAP\nTORONTO, ON, CANADA\n9th January 2023') +
  theme_void() +
  theme(legend.position = "none",
        panel.grid.major = element_line(color = "grey35", linewidth = 1),  
        panel.grid.minor = element_line(color = "grey20", linewidth = 1),  
        panel.border = element_blank(),  
        plot.background = element_rect(fill = "#191d29", color = "#191d29"),
        plot.margin = margin(20, 20, 20, 20),
        plot.caption = element_text(color = 'white', hjust = 0.5, 
                                    face = 2, size = 25, 
                                    margin = margin(150, 20, 20, 20)))

现在，如果我们保存这个结果，可以使用：

ggsave('toronto.png', plot = p, width = unit(10, 'in'), 
       height = unit(15, 'in'))

我们得到