setup
if (!nzchar(system.file(package = "librarian"))) {
install.packages("librarian")
}
::shelf(
librarianquiet = TRUE,
"jiho/castr", dplyr, oce, patchwork, purrr, tidyr
readr, here, fs, ggplot2, glue, )
tryCatch({
plots <- list()
for (station_name in unique(cruise_df$station)) {
subset_df <- filter(cruise_df, station == station_name)
plots[[station_name]] <- ggplot(subset_df, aes(x = time_elapsed)) +
geom_point(aes(y = depth), color = "blue") + # Plot depth in blue
geom_line(aes(y = sea_water_pressure), color = "red") + # Plot sea water pressure in red
ggtitle(glue("{station_name}")) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank()
) # Remove individual axis titles and text
}
# drop nulls
plots <- purrr::compact(plots)
# Combine all plots into a grid
combined_plot <- wrap_plots(plots) +
plot_layout(ncol = 4) + # Adjust ncol to set number of columns in the grid
plot_annotation(
title = "Depth (blue) and Pressure (red)",
subtitle = "Each panel represents a different station",
caption = "Time Elapsed (x-axis) vs Depth & Pressure (y-axis)"
) +
theme(
plot.tag = element_text(size = 12, face = "bold"),
plot.tag.position = "topleft",
axis.title.x = element_text(margin = margin(t = 10)),
axis.title.y = element_text(margin = margin(r = 10))
)
print(combined_plot)
}, error = function(er){
print(er)
});
<error/rlang_error>
Error in `geom_point()`:
! Problem while computing aesthetics.
ℹ Error occurred in the 1st layer.
Caused by error in `FUN()`:
! object 'time_elapsed' not found
---
Backtrace:
▆
1. ├─base::tryCatch(...)
2. │ └─base (local) tryCatchList(expr, classes, parentenv, handlers)
3. │ └─base (local) tryCatchOne(expr, names, parentenv, handlers[[1L]])
4. │ └─base (local) doTryCatch(return(expr), name, parentenv, handler)
5. ├─base::print(combined_plot)
6. └─patchwork:::print.patchwork(combined_plot)
7. └─patchwork:::build_patchwork(plot, plot$layout$guides %||% "auto")
8. └─base::lapply(x$plots, plot_table, guides = guides)
9. ├─patchwork (local) FUN(X[[i]], ...)
10. └─patchwork:::plot_table.ggplot(X[[i]], ...)
11. └─ggplot2::ggplotGrob(x)
12. ├─ggplot2::ggplot_gtable(ggplot_build(x))
13. │ └─ggplot2:::attach_plot_env(data$plot$plot_env)
14. │ └─base::options(ggplot2_plot_env = env)
15. ├─ggplot2::ggplot_build(x)
16. └─ggplot2:::ggplot_build.ggplot(x)
17. └─ggplot2:::by_layer(...)
18. ├─rlang::try_fetch(...)
19. │ ├─base::tryCatch(...)
20. │ │ └─base (local) tryCatchList(expr, classes, parentenv, handlers)
21. │ │ └─base (local) tryCatchOne(expr, names, parentenv, handlers[[1L]])
22. │ │ └─base (local) doTryCatch(return(expr), name, parentenv, handler)
23. │ └─base::withCallingHandlers(...)
24. └─ggplot2 (local) f(l = layers[[i]], d = data[[i]])
25. └─l$compute_aesthetics(d, plot)
26. └─ggplot2 (local) compute_aesthetics(..., self = self)
27. └─base::lapply(aesthetics, eval_tidy, data = data, env = env)
28. └─rlang (local) FUN(X[[i]], ...)
p <- ggplot(cruise_df, aes(x = time, y = depth, fill = station)) +
geom_col() + # This creates the bars
# geom_text(aes(label = station), vjust = -0.3) + # This adds labels to each bar, adjust vjust for position
labs(x = "Time", y = "Depth", title = "Depth over Time by Station") + # Set labels and title
theme_minimal() # Use a minimal theme
print(p)
ctd_load <- function(data, other_params = NULL) {
# create csv into ctd object
test_ctd <-
as.ctd(
salinity = data$sea_water_salinity,
temperature = data$sea_water_temperature,
pressure = data$sea_water_pressure,
station = data$station
)
# add additional columns to ctd object
if (!is.null(other_params)) {
for (param_name in other_params) {
test_ctd <-
oceSetData(
object = test_ctd,
name = param_name,
value = data[[param_name]]
)
}
}
print(glue("{data$station[1]}:\t{length(test_ctd@data$scan)} scans"))
return(test_ctd)
}
# Define other parameters to add
other_params <- c(
"cruise_id", "station", "time", "time_elapsed",
"latitude", "longitude", "sea_water_electrical_conductivity",
"CDOM", "dissolved_oxygen","oxygen_saturation", "chlorophyll_concentration",
"chlorophyll_fluorescence", "photosynthetically_available_radiation",
"beam_attenuation","beam_transmission", "depth", "sea_water_sigma_t",
"descent_rate", "sound_velocity"
)
# Split data by station and create data list
ctd_FK <- cruise_df %>%
split(.$station) %>%
map(~ ctd_load(.x, other_params = other_params)) # ~ is a lambda(x)
21/LK: 5988 scans
MR: 4800 scans
WS: 6333 scans
=== station: 21/LK
# scans: 5988
=== station: MR
# scans: 4800
=== station: WS
# scans: 6333
# Loop through each CTD cast
for (i in seq(ctd_FK)){
cast <- ctd_FK[[i]] # Assuming each sublist contains only one relevant CTD object
tryCatch({
# Extract metadata for station name and cruise ID
station_name <- cast@metadata$station[1]
cruise_id <- cast@data$cruise_id[1]
# Generate a title with station name and cruise ID
overall_title <- glue::glue("Station: {station_name}, Cruise ID: {cruise_id}")
# Set margins: increase the outer margin for the title
par(oma = c(0, 0, 3, 0)) # Top outer margin increased for title
# Plotting function with specific parameters
oce::plot(
x = ctdDecimate(ctdTrim(cast)),
which = c(
"sea_water_electrical_conductivity",
"descent_rate", "sound_velocity",
"sea_water_sigma_t"
),
main = "" # No main title for individual subplots
)
# Place a single overall title at the top of the plot frame
mtext(overall_title, side = 3, line = 1, outer = TRUE, cex = 1.5)
# Reset outer margins to default
par(oma = c(0, 0, 0, 0))
}, error = function(e) {
print(e$message) # Print any errors that occur during plotting
})
}
# Loop through each CTD cast
for (i in seq(ctd_FK)){
cast <- ctd_FK[[i]] # Assuming each sublist contains only one relevant CTD object
tryCatch({
# Extract metadata for station name and cruise ID
station_name <- cast@metadata$station[1]
cruise_id <- cast@data$cruise_id[1]
# Generate a title with station name and cruise ID
overall_title <- glue::glue("Station: {station_name}, Cruise ID: {cruise_id}")
# Set margins: increase the outer margin for the title
par(oma = c(0, 0, 3, 0)) # Top outer margin increased for title
# Plotting function with specific parameters
oce::plot(
x = ctdDecimate(ctdTrim(cast)),
which = c(
"CDOM", "dissolved_oxygen",
"oxygen_saturation",
"chlorophyll_concentration", "chlorophyll_fluorescence"
),
main = "" # No main title for individual subplots
)
# Place a single overall title at the top of the plot frame
mtext(overall_title, side = 3, line = 1, outer = TRUE, cex = 1.5)
# Reset outer margins to default
par(oma = c(0, 0, 0, 0))
}, error = function(e) {
print(e$message) # Print any errors that occur during plotting
})
}
[1] "In plot,ctd-method() : which=\"CDOMdissolved_oxygenoxygen_saturationchlorophyll_concentrationchlorophyll_fluorescence\" cannot be handled"
[1] "In plot,ctd-method() : which=\"CDOMdissolved_oxygenoxygen_saturationchlorophyll_concentrationchlorophyll_fluorescence\" cannot be handled"
[1] "In plot,ctd-method() : which=\"CDOMdissolved_oxygenoxygen_saturationchlorophyll_concentrationchlorophyll_fluorescence\" cannot be handled"
# Loop through each CTD cast
for (i in seq(ctd_FK)){
cast <- ctd_FK[[i]] # Assuming each sublist contains only one relevant CTD object
tryCatch({
# Extract metadata for station name and cruise ID
station_name <- cast@metadata$station[1]
cruise_id <- cast@data$cruise_id[1]
# Generate a title with station name and cruise ID
overall_title <- glue::glue("Station: {station_name}, Cruise ID: {cruise_id}")
# Set margins: increase the outer margin for the title
par(oma = c(0, 0, 3, 0)) # Top outer margin increased for title
# Plotting function with specific parameters
oce::plot(
x = ctdDecimate(ctdTrim(cast)),
which = c(
"photosynthetically_available_radiation",
"beam_attenuation","beam_transmission"
),
main = "" # No main title for individual subplots
)
# Place a single overall title at the top of the plot frame
mtext(overall_title, side = 3, line = 1, outer = TRUE, cex = 1.5)
# Reset outer margins to default
par(oma = c(0, 0, 0, 0))
}, error = function(e) {
print(e$message) # Print any errors that occur during plotting
})
}
combined_df <- data.frame()
for (i in seq(ctd_FK)){
cast <- ctd_FK[[i]] # 1 is selecting only the first sublist
# print(class(cast))
# clean cast
trimmed_cast <- ctdTrim(cast)
decimated_cast <- ctdDecimate(trimmed_cast, p = 0.5) # binned to 0.5 m
# convert to df
cast_df <- as.data.frame(decimated_cast@data)
# Add metadata
# assumes station ID and cruise ID the same for all & just uses 1st one
cast_df <- mutate(
cast_df,
station = cast@data$station[1],
cruise_id = cast@data$cruise_id[1]
)
# drop NA rows left by cleaning
cast_df <- subset(cast_df, !is.na(scan))
# Append the data to the combined dataframe
combined_df <- rbind(combined_df, cast_df)
}
# Save to CSV
file_path <- here(glue("data/cleaned/{cruise_id}.csv"))
write.csv(combined_df, file_path, row.names = FALSE)