Accomidate Creation of Star Maps.

Question

Accomidate Creation of Star Maps.

benyamindsmith opened this issue 2 years ago · comments

Some Links

Benjamin Smith · Answer 1 · Sat Jan 07 2023 01:51:08 GMT+0800 (China Standard Time)

First Attempt

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")
    )
  
}

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"))

url3 <- "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(url3,stringsAsFactors = FALSE)

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

Benjamin Smith · Answer 2 · Sun Jan 08 2023 11:19:22 GMT+0800 (China Standard Time)

Second Attempt

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()

Benjamin Smith · Answer 3 · Wed Jan 11 2023 05:23:49 GMT+0800 (China Standard Time)

Third Attempt

library(tidyverse)
library(sf)
library(grid)

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

# Constellations Data
url1 <- "https://raw.githubusercontent.com/ofrohn/d3-celestial/master/data/constellations.lines.json"

# Stars Data
url2 <- "https://raw.githubusercontent.com/ofrohn/d3-celestial/master/data/stars.6.json"

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

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

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, linewidth = 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'))

Benjamin Smith · Answer 4 · Wed Jan 11 2023 09:23:40 GMT+0800 (China Standard Time)

Fourth Attempt

library(tidyverse)
library(sf)
library(grid)

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

# Constellations Data
url1 <- "https://raw.githubusercontent.com/ofrohn/d3-celestial/master/data/constellations.lines.json"

# Stars Data
url2 <- "https://raw.githubusercontent.com/ofrohn/d3-celestial/master/data/stars.6.json"

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

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

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, color = "white",
          size = 0.5) +
  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 = 'TORONTO, ON, CANADA\n9th January 2023\n 43.6532° N, 79.3832° W') +
  theme_void() +
  theme(legend.position = "none",
        panel.grid.major = element_line(color = "grey35", size = 1),  
        panel.grid.minor = element_line(color = "grey20", size = 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 = 20, 
                                    margin = margin(150, 20, 20, 20),
                                    ))

Benjamin Smith · Answer 5 · Fri Jan 13 2023 12:55:40 GMT+0800 (China Standard Time)

Will be working on this in a separate package called starBliss

Benjamin Smith · Answer 6 · Sat Jan 14 2023 03:57:30 GMT+0800 (China Standard Time)

Code idea so far - THIS WORKS! Now to make it a function

library(tidyverse)
library(lubridate)
library(sf)
library(grid)
library(tidygeocoder)



plot_starmap <- function(location,
                         date = today(),
                         style="black",
                         line1_text="",
                         line2_text="",
                         line3_text=""){
  
  # Suppress warnings within the function
  
  defaultW <- getOption("warn")
  options(warn = -1)
  
  # Constellations Data
  url1 <- "https://raw.githubusercontent.com/benyamindsmith/starBliss/main/data/constellations.lines.json"
  
  # Stars Data
  url2 <- "https://raw.githubusercontent.com/benyamindsmith/starBliss/main/data/stars.6.json"
  
  # Formatted date
  dt<- lubridate::ymd(date)
  
  
  # Extract relevant latitude and logitude.
  
  # Latitude is dependent on location
  suppressMessages(
    capture.output(
  lat <- tibble(singlelineaddress = location) %>%
    geocode(address=singlelineaddress,method = 'arcgis') %>% .[["lat"]] %>% round(4)
  )
  )
  # Logitude is dependent on date
  # If the date is less than October 18th of that year...
  if(dt < ydm(paste(year(dt),"18-10",sep="-"))){
    # Work with October 18th of Previous Year
    ref_date <- ydm(paste(year(dt)-1,"18-10",sep="-"))
  } else{
    # Work with October 18 of this year
    ref_date<- ydm(paste(year(dt),"18-10",sep="-"))
    
  }
  
  # Resulting longitude
  lon <- (-as.numeric(difftime(ref_date,dt, units="days"))/365)*360 %>% round(4)
  
  # The CRS
  
  projString <- paste0("+proj=laea +x_0=0 +y_0=0 +lon_0=",lon, " +lat_0=", lat)
  
  
  # Data Transformation
  flip <- matrix(c(-1, 0, 0, 1), 2, 2)
  
  hemisphere <- st_sfc(st_point(c(lon, lat)), crs = 4326) %>% 
    st_buffer(dist = 1e7) %>% 
    st_transform(crs = projString)
  
  # Reading Data
  invisible(
    capture.output(
      constellation_lines_sf <- invisible(st_read(url1, stringsAsFactors = FALSE)) %>%
        st_wrap_dateline(options = c("WRAPDATELINE=YES", "DATELINEOFFSET=180")) %>% 
        st_transform(crs = projString) %>%
        st_intersection(hemisphere) %>% 
        filter(!is.na(st_is_valid(.))) %>%
        mutate(geometry = geometry * flip) 
    )
  )
 
  
  st_crs(constellation_lines_sf) <- projString
  
  # Reading Data
  invisible(
    capture.output(
    stars_sf <- st_read(url2,stringsAsFactors = FALSE) %>% 
      st_transform(crs = projString) %>%
      st_intersection(hemisphere) %>%
      mutate(geometry = geometry * flip) 
    )
  )
  
  st_crs(stars_sf) <- projString
  
  
  # Setting parameters to update map
  if(style=="black"){
    fillVal <-  '#191d29'
    colVal <- '#191d29'
    colorVal <- "white"
    majorGridCol <-"grey35"
    minorGridCol <- "grey20"
  }
  if(style == "green"){
    fillVal <-  '#164B58'
    colVal <- '#164B58'
    colorVal <- "white"
    majorGridCol <-"#FEFEFE"
    minorGridCol <- "#FEFEFE"
  }
  # Creating the frame
  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 = fillVal, col = colVal))
  
  p <- ggplot() +
    geom_sf(data = stars_sf, aes(size = -exp(mag), alpha = -exp(mag)),
            color = colorVal)+
    geom_sf(data = constellation_lines_sf, color = colorVal,
            size = 0.5) +
    annotation_custom(circleGrob(r = 0.46, 
                                 gp = gpar(col = colorVal, lwd = 10, fill = NA))) +
    scale_y_continuous(breaks = seq(0, 90, 15)) +
    scale_size_continuous(range = c(0, 2)) +
    annotation_custom(mask) +
    labs(caption = paste0(line1_text,'\n',line2_text,'\n',line3_text)) +
    theme_void() +
    theme(legend.position = "none",
          panel.grid.major = element_line(color = majorGridCol, linewidth = 1),  
          panel.grid.minor = element_line(color = minorGridCol, linewidth = 1),  
          panel.border = element_blank(),  
          plot.background = element_rect(fill = fillVal, color = colVal),
          plot.margin = margin(20, 20, 20, 20),
          plot.caption = element_text(color = colorVal, hjust = 0.5, 
                                      face = 2, size = 20, 
                                      margin = margin(150, 20, 20, 20),
          ))
  
  # Turn Warnings Back on
  options(warn = defaultW)
  return(p)
}