Accomidate Creation of Star Maps.
benyamindsmith opened this issue · comments
Some Links
- https://mapsformoments.co.uk/9-star-map?step=design
- https://github.com/astronexus/HYG-Database
- https://astronomy.stackexchange.com/questions/32875/i-am-looking-for-the-skymap-api-to-create-nightsky-star-maps
- https://astronomy.stackexchange.com/questions/51508/is-there-a-library-api-like-leaflet-available-for-starmaps
- https://observablehq.com/@pcarleton/visualizing-the-night-sky-working-with-d3-celestial
- https://github.com/ofrohn/d3-celestial
- https://kimnewzealand.github.io/2019/02/21/celestial-maps/
- https://stackoverflow.com/questions/75064069/creating-star-map-visualizations-based-on-location-and-date/
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()
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()
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'))
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),
))
Will be working on this in a separate package called starBliss
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)
}