try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
library(knitr)
library(kableExtra)
library(lubridate)
library(data.table)
library(ggplot2)
library(RMark)
library(scales)
library(viridis)
library(forcats)
library(reshape2)
library(png)
library(dataRetrieval)
library(rerddap)
library(plotly)
study <- "SJ_Steelhead_April_2024"
detects_study <- fread("study_detections_archive_2024.csv", stringsAsFactors = F,
colClasses = c(DateTime_PST = "character", RelDT = "character")) %>%
filter(Study_ID == study) %>%
mutate(DateTime_PST = as.POSIXct(DateTime_PST, format = "%Y-%m-%d %H:%M:%S", tz="Etc/GMT+8"),
release_time = as.POSIXct(RelDT, format = "%Y-%m-%d %H:%M:%S", tz="Etc/GMT+8")) %>%
rename(., weight=Weight, length=Length, release_rkm=Rel_rkm, release_location=Rel_loc, river_km=rkm)
latest <- read.csv("latest_download.csv", stringsAsFactors = F)$x
##################################################################################################################
#### TO RUN THE FOLLOWING CODE CHUNKS FROM HERE ON DOWN USING R ERDDAP, UN-COMMENT THESE NEXT 9 LINES OF CODE ####
##################################################################################################################
# cache_delete_all()
# query = paste('&','Study_ID','="', study, '"', sep = '')
# datafile=URLencode(paste("https://oceanview.pfeg.noaa.gov/erddap/tabledap/","FEDcalFishTrack",".csv?",query,sep = ""))
# options(url.method = "libcurl", download.file.method = "libcurl", timeout = 180)
# detects_study <- data.frame(read.csv(datafile,row.names = NULL, stringsAsFactors = F))
# detects_study <- detects_study[-1,]
# detects_study$DateTime_PST <- as.POSIXct(detects_study$local_time, format = "%Y-%m-%d %H:%M:%S", "Etc/GMT+8")
# detects_study$release_time <- as.POSIXct(detects_study$release_time, format = "%Y-%m-%d %H:%M:%S", "Etc/GMT+8")
# detects_study$river_km <- as.numeric(detects_study$river_km)
##################################################################################################################
Study is complete, all tags are no longer active as of 2024-09-25. All times in Pacific Standard Time.
if (nrow(detects_study) == 0){
cat("Study has not yet begun ")
} else {
if (min(detects_study$release_time) > Sys.time()){
cat("Study has not yet begun, below data is a placeholder: ")
}
if (min(detects_study$release_time) < Sys.time()){
cat(paste("Study began on ", min(detects_study$release_time), ", see tagging details below:", sep = ""))
}
######################################
#### RELEASE GROUPS ASSIGNED HERE ####
######################################
detects_study$Release <- detects_study$release_location
study_tagcodes <- as.data.frame(unique(detects_study[,c("TagCode", "release_time", "weight", "length", "release_rkm",
"release_location", "Release","Rel_latitude","Rel_longitude")]))
release_stats <- study_tagcodes %>%
group_by(Release) %>%
summarise(First_release_time = min(release_time),
Last_release_time = max(release_time),
Number_fish_released = length(unique(TagCode)),
Release_location = head(release_location, 1),
Release_rkm = head(release_rkm,1),
Mean_length = mean(length, na.rm=T),
Mean_weight = mean(weight, na.rm=T),
Release_lat = head(Rel_latitude,1),
Release_lon = head(Rel_longitude,1)) %>%
mutate(Mean_length = round(Mean_length, 1),
Mean_weight = round(Mean_weight, 1),
First_release_time = format(First_release_time, tz = "Etc/GMT+8"),
Last_release_time = format(Last_release_time, tz = "Etc/GMT+8")) %>%
arrange(First_release_time)
release_stats_all <- study_tagcodes %>%
summarise(First_release_time = min(release_time),
Last_release_time = max(release_time),
Number_fish_released = length(unique(TagCode)),
Release_location = NA,
Release_rkm = mean(release_rkm,na.rm = T),
Mean_length = mean(length, na.rm=T),
Mean_weight = mean(weight, na.rm=T),
Release_lat = head(Rel_latitude,1),
Release_lon = head(Rel_longitude,1)) %>%
mutate(Mean_length = round(Mean_length, 1),
Mean_weight = round(Mean_weight, 1),
Release_rkm = round(Release_rkm,1),
First_release_time = format(First_release_time, tz = "Etc/GMT+8"),
Last_release_time = format(Last_release_time, tz = "Etc/GMT+8"))
release_stats <- rbind(release_stats, data.frame(Release = "ALL", release_stats_all))
kable(release_stats[,!names(release_stats)%in% c("Release_lon","Release_lat","release_location")], format = "html", row.names = F) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive", "bordered"), full_width = F, position = "left")
}
Study began on 2024-04-17 08:00:00, see tagging details below:
Release | First_release_time | Last_release_time | Number_fish_released | Release_location | Release_rkm | Mean_length | Mean_weight |
---|---|---|---|---|---|---|---|
Dos_Reis_Rel | 2024-04-17 08:00:00 | 2024-04-19 08:32:00 | 104 | Dos_Reis_Rel | 151.90 | 239.9 | 140.3 |
Head_of_Old_River_Rel | 2024-04-17 08:34:00 | 2024-04-19 09:16:00 | 91 | Head_of_Old_River_Rel | 156.00 | 240.2 | 136.8 |
DurhamFerry_Rel | 2024-04-17 08:46:00 | 2024-04-19 08:59:00 | 140 | DurhamFerry_Rel | 183.58 | 242.0 | 142.2 |
ALL | 2024-04-17 08:00:00 | 2024-04-19 09:16:00 | 335 | NA | 166.30 | 240.8 | 140.1 |
library(leaflet)
library(maps)
library(htmlwidgets)
library(leaflet.extras)
library(dplyr)
library(dbplyr)
library(DBI)
library(odbc)
library(data.table)
# Create connection with cloud database
con <- dbConnect(odbc(),
Driver = "SQL Server",
Server = "calfishtrack-server.database.windows.net",
Database = "realtime_detections",
UID = "realtime_user",
PWD = "Pass@123",
Port = 1433)
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
## THIS CODE CHUNK WILL NOT WORK IF USING ONLY ERDDAP DATA, REQUIRES ACCESS TO LOCAL FILES
if (nrow(detects_study[is.na(detects_study$DateTime_PST)==F,]) == 0){
cat("No detections yet")
# Use dbplyr to load realtime_locs and qryHexCodes sql table
gen_locs <- tbl(con, "realtime_locs") %>% collect()
# gen_locs <- read.csv("realtime_locs.csv", stringsAsFactors = F) %>% filter(is.na(stop))
leaflet(data = gen_locs[is.na(gen_locs$stop),]) %>%
# setView(-72.14600, 43.82977, zoom = 8) %>%
addProviderTiles("Esri.WorldStreetMap", group = "Map") %>%
addProviderTiles("Esri.WorldImagery", group = "Satellite") %>%
addProviderTiles("Esri.WorldShadedRelief", group = "Relief") %>%
# Marker data are from the sites data frame. We need the ~ symbols
# to indicate the columns of the data frame.
addMarkers(~longitude, ~latitude, label = ~general_location, group = "Receiver Sites", popup = ~location) %>%
# addAwesomeMarkers(~lon_dd, ~lat_dd, label = ~locality, group = "Sites", icon=icons) %>%
addScaleBar(position = "bottomleft") %>%
addLayersControl(
baseGroups = c("Street Map", "Satellite", "Relief"),
overlayGroups = c("Receiver Sites"),
options = layersControlOptions(collapsed = FALSE)) %>%
addSearchFeatures(targetGroups = c("Receiver Sites"))
} else {
# Use dbplyr to load realtime_locs and qryHexCodes sql table
gen_locs <- tbl(con, "realtime_locs") %>% collect()
# gen_locs <- read.csv("realtime_locs.csv", stringsAsFactors = F)
endtime <- min(as.Date(format(Sys.time(), "%Y-%m-%d")),
max(as.Date(detects_study$release_time)+(as.numeric(detects_study$tag_life)*1.5)))
beacon_by_day <- fread("beacon_by_day.csv", stringsAsFactors = F) %>%
mutate(day = as.Date(day)) %>%
# Subset to only look at data for the correct beacon for that day
filter(TagCode == beacon) %>%
# Only keep beacon by day for days since fish were released
filter(day >= as.Date(min(study_tagcodes$release_time)) & day <= endtime) %>%
dplyr::left_join(., gen_locs[,c("location", "general_location","rkm")], by = "location")
arrivals_per_day <- detects_study %>%
group_by(general_location, TagCode) %>%
summarise(DateTime_PST = min(DateTime_PST, na.rm = T)) %>%
arrange(TagCode, general_location) %>%
mutate(day = as.Date(DateTime_PST, "%Y-%m-%d", tz = "Etc/GMT+8")) %>%
group_by(day, general_location) %>%
summarise(New_arrivals = length(TagCode)) %>%
na.omit() %>%
mutate(day = as.Date(day)) %>%
dplyr::left_join(unique(beacon_by_day[,c("general_location", "day", "rkm")]), .,
by = c("general_location", "day")) %>%
arrange(general_location, day) %>%
mutate(day = as.factor(day)) %>%
filter(general_location != "Bench_test") %>% # Remove bench test
filter(!(is.na(general_location))) # Remove NA locations
## Remove sites that were not operation the whole time
#### FOR THE SEASONAL SURVIVAL PAGE, KEEP ALL SITES SINCE PEOPLE WANT TO SEE DETECTIONS OF LATER FISH AT NEWLY
#### DEPLOYED SPOTS
gen_locs_days_in_oper <- arrivals_per_day %>%
group_by(general_location) %>%
summarise(days_in_oper = length(day))
#gen_locs_days_in_oper <- gen_locs_days_in_oper[gen_locs_days_in_oper$days_in_oper ==
# max(gen_locs_days_in_oper$days_in_oper),]
arrivals_per_day_in_oper <- arrivals_per_day %>%
filter(general_location %in% gen_locs_days_in_oper$general_location)
fish_per_site <- arrivals_per_day_in_oper %>%
group_by(general_location) %>%
summarise(fish_count = sum(New_arrivals, na.rm=T))
gen_locs_mean_coords <- gen_locs %>%
filter(is.na(stop) & general_location %in% fish_per_site$general_location) %>%
group_by(general_location) %>%
summarise(latitude = mean(latitude), # estimate mean lat and lons for each genloc
longitude = mean(longitude))
fish_per_site <- merge(fish_per_site, gen_locs_mean_coords)
release_stats_agg <- aggregate(cbind(Release_lon, Release_lat) ~ Release_location, data = release_stats[release_stats$Release != "ALL",], FUN = mean)
release_stats_agg <- merge(release_stats_agg, aggregate(Number_fish_released ~ Release_location, data = release_stats[release_stats$Release != "ALL",], FUN = sum))
if(!is.na(release_stats$Release_lat[1])){
leaflet(data = fish_per_site) %>%
addProviderTiles("Esri.WorldStreetMap", group = "Map") %>%
addProviderTiles("Esri.WorldImagery", group = "Satellite") %>%
addProviderTiles("Esri.WorldShadedRelief", group = "Relief") %>%
# Marker data are from the sites data frame. We need the ~ symbols
# to indicate the columns of the data frame.
addPulseMarkers(data = fish_per_site[seq(from = 1, to = nrow(fish_per_site), by = 2),], lng = ~longitude, lat = ~latitude, label = ~fish_count,
labelOptions = labelOptions(noHide = T, direction = "left", textsize = "15px"), group = "Receiver Sites",
popup = ~general_location, icon = makePulseIcon(heartbeat = 1.3)) %>%
addPulseMarkers(data = fish_per_site[seq(from = 2, to = nrow(fish_per_site), by = 2),], lng = ~longitude, lat = ~latitude, label = ~fish_count,
labelOptions = labelOptions(noHide = T, direction = "right", textsize = "15px"), group = "Receiver Sites",
popup = ~general_location, icon = makePulseIcon(heartbeat = 1.3)) %>%
addCircleMarkers(data = release_stats_agg, ~Release_lon, ~Release_lat, label = ~Number_fish_released, stroke = F, color = "blue", fillOpacity = 1,
group = "Release Sites", popup = ~Release_location, labelOptions = labelOptions(noHide = T, textsize = "15px")) %>%
addScaleBar(position = "bottomleft") %>%
addLegend("bottomright", labels = c("Receivers", "Release locations"), colors = c("red","blue")) %>%
addLayersControl(baseGroups = c("Street Map", "Satellite", "Relief"), options = layersControlOptions(collapsed = FALSE))
} else {
leaflet(data = fish_per_site) %>%
addProviderTiles("Esri.WorldStreetMap", group = "Map") %>%
addProviderTiles("Esri.WorldImagery", group = "Satellite") %>%
addProviderTiles("Esri.WorldShadedRelief", group = "Relief") %>%
# Marker data are from the sites data frame. We need the ~ symbols
# to indicate the columns of the data frame.
addPulseMarkers(lng = fish_per_site$longitude, lat = fish_per_site$latitude, label = ~fish_count,
labelOptions = labelOptions(noHide = T, textsize = "15px"), group = "Receiver Sites",
popup = ~general_location, icon = makePulseIcon(heartbeat = 1.3)) %>%
addScaleBar(position = "bottomleft") %>%
addLayersControl(baseGroups = c("Street Map", "Satellite", "Relief"),
options = layersControlOptions(collapsed = FALSE))
}
}
2.1 Map of unique fish detections at operational realtime detection locations
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
if (nrow(detects_study[is.na(detects_study$DateTime_PST)==F,]) > 0){
detects_study <- detects_study[order(detects_study$TagCode, detects_study$DateTime_PST),]
## Now estimate the time in hours between the previous and next detection, for each detection.
detects_study$prev_genloc <- shift(detects_study$general_location, fill = NA, type = "lag")
#detects_study$prev_genloc <- shift(detects_study$General_Location, fill = NA, type = "lag")
## Now make NA the time diff values when it's between 2 different tagcodes or genlocs
detects_study[which(detects_study$TagCode != shift(detects_study$TagCode, fill = NA, type = "lag")), "prev_genloc"] <- NA
detects_study[which(detects_study$general_location != detects_study$prev_genloc), "prev_genloc"] <- NA
detects_study$mov_score <- 0
detects_study[is.na(detects_study$prev_genloc), "mov_score"] <- 1
detects_study$mov_counter <- cumsum(detects_study$mov_score)
detects_summary <- aggregate(list(first_detect = detects_study$DateTime_PST), by = list(TagCode = detects_study$TagCode, release_time = detects_study$release_time, mov_counter = detects_study$mov_counter ,general_location = detects_study$general_location, river_km = detects_study$river_km, release_rkm = detects_study$release_rkm), min)
detects_summary <- detects_summary[is.na(detects_summary$first_detect) == F,]
releases <- aggregate(list(first_detect = detects_study$release_time), by = list(TagCode = detects_study$TagCode, release_time = detects_study$release_time, release_location=detects_study$release_location,release_rkm = detects_study$release_rkm), min)
releases$river_km <- releases$release_rkm
releases$mov_counter <- NA
releases$general_location <- NA
releases$general_location <- releases$release_location
releases$release_location <- NULL
detects_summary <- rbindlist(list(detects_summary, releases), use.names = T)
detects_summary <- detects_summary[order(detects_summary$TagCode, detects_summary$first_detect),]
starttime <- as.Date(min(detects_study$release_time), "Etc/GMT+8")
## Endtime should be either now, or end of predicted tag life, whichever comes first
endtime <- min(as.Date(format(Sys.time(), "%Y-%m-%d"))+1, max(as.Date(detects_study$release_time)+(as.numeric(detects_study$tag_life))))
#par(mar=c(6, 5, 2, 5) + 0.1)
plot_ly(detects_summary, x = ~first_detect, y = ~river_km, color = ~TagCode, width = 900, height = 600, dynamicTicks = TRUE, connectgaps = TRUE, mode = "lines+markers", type = "scatter",hoverinfo = "text",
text = ~paste("</br> TagCode: ", TagCode,
"</br> Arrival: ", first_detect,
"</br> Location: ", general_location)) %>%
layout(showlegend = T,
xaxis = list(title = "<b> Date <b>", mirror=T,ticks="outside",showline=T, range=c(starttime,endtime)),
yaxis = list(title = "<b> Kilometers upstream of the Golden Gate <b>", mirror=T,ticks="outside",showline=T, range=c(max(detects_study$Rel_rkm)+10, min(gen_locs[is.na(gen_locs$stop),"rkm"])-10)),
legend = list(title=list(text='<b> Tag Code </b>')),
margin=list(l = 50,r = 100,b = 50,t = 50)
)
}else{
plot(1:2, type = "n", xlab = "",xaxt = "n", yaxt = "n", ylab = "Kilometers upstream of the Golden Gate")
text(1.5,1.5, labels = "NO DETECTIONS YET", cex = 2)
}
2.2 Waterfall Detection Plot
_______________________________________________________________________________________________________
library(dplyr)
library(cder)
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
recv_locs <- gen_locs
detects_omr_cor <- detects_study[detects_study$general_location %in% c("Old_River_Quimby", "Holland_Cut_Quimby", "Old River", "MiddleRiver", "Clifton_Court_US_Radial_Gates", "SWP_radial_gates_DS", "SWP_radial_gates_US", "CVP_Trash_Rack_1", "CVP_Tank", "SWP_intake", "Clifton_Court_Intake_Canal"),]
if (nrow(detects_omr_cor)>0) {
# Save the last detection at each location
detects_omr_cor <- merge(detects_omr_cor,aggregate(list(last_detect = detects_omr_cor$DateTime_PST), by = list(TagCode= detects_omr_cor$TagCode, general_location = detects_omr_cor$general_location), FUN = max))
# Convert last detection to day
detects_omr_cor$Day <- as.Date(detects_omr_cor$last_detect, "Etc/GMT+8")
starttime <- as.Date(min(detects_omr_cor$release_time), "Etc/GMT+8")
## Endtime should be either now or end of predicted tag life, whichever comes first
endtime <- min(as.Date(format(Sys.time(), "%Y-%m-%d")),
max(as.Date(detects_study$release_time)+(as.numeric(detects_study$tag_life))))
daterange <- data.frame(Date = seq.Date(from = starttime, to = endtime, by = "day"))
rels <- unique(study_tagcodes$Release)
rel_num <- length(rels)
rels_no_detects <- as.character(rels[!(rels %in% unique(detects_omr_cor$Release))])
tagcount <- aggregate(list(unique_tags = detects_omr_cor$TagCode),
by = list(Date = detects_omr_cor$Day, Location = detects_omr_cor$general_location),
FUN = function(x){length(unique(x))})
tagcount$Location <- factor(tagcount$Location, levels = c("Old_River_Quimby", "Holland_Cut_Quimby",
"MiddleRiver", "Clifton_Court_US_Radial_Gates",
"CVP_Trash_Rack_1", "CVP_Tank",
"Clifton_Court_Intake_Canal"))
tagcount1 <- reshape2::dcast(tagcount, Date ~ Location, drop = FALSE)
daterange1 <- merge(daterange, tagcount1, all.x=T)
daterange1[is.na(daterange1)] <- 0
daterange2 <- daterange1
rownames(daterange2) <- daterange2$Date
par(mar=c(6, 5, 2, 5) + 0.1)
daterange3 <- melt(daterange2, id.vars = "Date", variable.name = ".", )
# Add latitude to daterange df
locs <- data.frame(general_location = unique(daterange3$.)) %>%
left_join(., recv_locs, by = 'general_location') %>% filter(is.na(stop) | stop > min(detects_omr_cor$RelDT)) %>%
select(location, general_location, latitude) %>% group_by(general_location) %>%
summarise(latitude = mean(latitude))
locs <- locs[order(locs$latitude, decreasing = FALSE),]
locs$loc_num <- seq.int(nrow(locs))
daterange4 <- daterange3 %>% left_join(., locs, by = c("." = "general_location"))
# Get flow data from CDEC
BTC_flow <- cdec_query("OMR", "20", "H", starttime, endtime)
# Fish movement
move_df <- detects_omr_cor %>%
distinct(., TagCode, last_detect, general_location,
.keep_all = TRUE) # find last detection and remove duplicate value for that column
dup_codes <- move_df$TagCode[which(duplicated(move_df$TagCode))] # then get the tag codes that were detected at multiple locations
move_df <- move_df[(move_df$TagCode %in% dup_codes),] # save only the fish that were detected at multiple locations
if(nrow(move_df)>1){
move_df$Day <- as.Date(move_df$last_detect, "Etc/GMT+8")
new_move_df <- NULL
for(i in 1:length(unique(move_df$TagCode))){
tmp_code <- unique(move_df$TagCode)[i]
tmp_move_df <- move_df %>% filter(TagCode == tmp_code) # subset data
tmp_move_df <- tmp_move_df[order(tmp_move_df$last_detect, decreasing = FALSE),] # order data
for(j in 1:(length(tmp_move_df$TagCode) - 1)){
tmp_new_move_df <- data.frame(TagCode = tmp_code, location1 = tmp_move_df$general_location[j],
day1 = tmp_move_df$Day[j], location2 = tmp_move_df$general_location[j+1],
day2 = tmp_move_df$Day[j+1])
tmp_new_move_df$loc_num1 <- locs$loc_num[which(locs$general_location == tmp_new_move_df$location1)]
tmp_new_move_df$loc_num2 <- locs$loc_num[which(locs$general_location == tmp_new_move_df$location2)]
new_move_df <- rbind(new_move_df, tmp_new_move_df)
}
}
fig1 <- plot_ly(data = daterange4, type = 'scatter', mode = "markers",
marker = list(color = ~ value, size = ~value*5,
colorbar = list(title = "Num. of arrivals", len = 0.35, x = 1.06, y = 0.73),
colorscale = 'Viridis', line = list(width = 0)),
hoverinfo = 'text', text = ~paste('Date:', Date,'<br># of arrivals:', value),
x = ~Date, y = ~loc_num) %>%
add_annotations(x = new_move_df$day2, y = new_move_df$loc_num2, axref="x", ayref="y", text="", showarrow=TRUE,
ax = new_move_df$day1, ay = new_move_df$loc_num1, arrowcolor = 'darkgrey',
opacity = 0.5, standoff = 5, startstandoff = 5) %>%
layout(xaxis = list(range = c(min(daterange$Date) - 1, max(daterange$Date) + 1), showgrid = FALSE, showline = TRUE),
yaxis = list(range = c(min(locs$loc_num) - 1, max(locs$loc_num) + 1), showline = TRUE,
title = "", ticktext = locs$general_location, tickvals = locs$loc_num), showlegend = FALSE) %>%
add_annotations(text = sprintf("<b>North<b>"), xref = 'paper', yref = 'paper', x = -0.13, xanchor = 'left',
y = 1.05, yanchor = 'top', showarrow = FALSE, font = list(size = 20)) %>%
add_annotations(text = sprintf("<b>South<b>"), xref = 'paper', yref = 'paper', x = -0.13, xanchor = 'left',
y = 0.04, yanchor = 'top', showarrow = FALSE, font = list(size = 20))
fig2 <- plot_ly(data = BTC_flow, type = 'scatter', mode = 'lines') %>%
add_trace(x = ~DateTime, y = ~Value) %>%
layout(xaxis = list(range = c(min(daterange$Date) - 1, max(daterange$Date) + 1), showgrid = FALSE, showline = TRUE),
yaxis = list(title = "Flow (cfs) at OMR"))
subplot(fig1, fig2, nrows = 2, margin = 0.04, heights = c(0.7, 0.3), titleY = TRUE)
}else{
plot(1:2, type = "n", xlab = "",xaxt = "n", yaxt = "n", ylab = "Number of fish arrivals per day")
text(1.5,1.5, labels = "NOT ENOUGH DETECTIONS", cex = 2)
}
}else{
plot(1:2, type = "n", xlab = "",xaxt = "n", yaxt = "n", ylab = "Number of fish arrivals per day")
text(1.5,1.5, labels = "NO DETECTIONS YET", cex = 2)
}
2.3 (BETA) Detections in the Old and Middle rivers (OMR) for duration of tag life (top) and flow at OMR (bottom). Arrows indicate fish movement.
_______________________________________________________________________________________________________
library(tidyr)
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
detects_4 <- detects_study %>% filter(general_location == "Benicia_west" | general_location == "Benicia_east")
if(nrow(detects_4) == 0){
plot(1:2, type = "n", xlab = "",xaxt = "n", yaxt = "n", ylab = "Number of fish arrivals per day")
text(1.5,1.5, labels = "NO DETECTIONS YET", cex = 2)
} else {
detects_4 <- detects_4 %>%
dplyr::left_join(., detects_4 %>%
group_by(TagCode) %>%
summarise(first_detect = min(DateTime_PST))) %>%
mutate(Day = as.Date(as.Date(first_detect, "Etc/GMT+8")))
starttime <- as.Date(min(detects_4$release_time), "Etc/GMT+8")
# Endtime should be either now, or end of predicted tag life, whichever comes first
endtime <- min(as.Date(format(Sys.time(), "%Y-%m-%d")),
max(as.Date(detects_study$release_time)+(as.numeric(detects_study$tag_life))))
daterange <- data.frame(Day = seq.Date(from = starttime, to = endtime, by = "day"))
rels <- unique(study_tagcodes$Release)
rel_num <- length(rels)
rels_no_detects <- as.character(rels[!(rels %in% unique(detects_4$Release))])
tagcount1 <- detects_4 %>%
group_by(Day, Release) %>%
summarise(unique_tags = length(unique(TagCode))) %>%
spread(Release, unique_tags)
daterange1 <- merge(daterange, tagcount1, all.x=T)
daterange1[is.na(daterange1)] <- 0
if(length(rels_no_detects)>0){
for(i in rels_no_detects){
daterange1 <- cbind(daterange1, x=NA)
names(daterange1)[names(daterange1) == "x"] <- paste(i)
}
}
## reorder columns in alphabetical order so its coloring in barplots is consistent
daterange1 <- daterange1[,order(colnames(daterange1))]
daterange2 <- daterange1
rownames(daterange2) <- daterange2$Day
daterange2$Day <- NULL
par(mar=c(6, 5, 2, 5) + 0.1)
daterange2$Date <- as.Date(row.names(daterange2))
daterange3 <- melt(daterange2, id.vars = "Date", variable.name = ".", )
daterange3$. <- factor(daterange3$., levels = sort(unique(daterange3$.), decreasing = T))
plot_ly(daterange3, width = 900, height = 600, dynamicTicks = TRUE) %>%
add_bars(x = ~Date, y = ~value, color = ~.) %>%
add_annotations( text="Release (click on legend items to isolate)", xref="paper", yref="paper",
x=0.01, xanchor="left",
y=1.056, yanchor="top", # Same y as legend below
legendtitle=TRUE, showarrow=FALSE ) %>%
layout(showlegend = T,
barmode = "stack",
xaxis = list(title = "Date", mirror=T,ticks="outside",showline=T),
yaxis = list(title = "Number of fish arrivals per day", mirror=T,ticks="outside",showline=T),
legend = list(orientation = "h",x = 0.34, y = 1.066),
margin=list(l = 50,r = 100,b = 50,t = 50))
}
2.4 Detections at Benicia Bridge for duration of tag life
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
try(benicia <- read.csv("benicia_surv.csv", stringsAsFactors = F))
detects_benicia <- detects_study[detects_study$general_location %in% c("Benicia_west", "Benicia_east"),]
endtime <- min(as.Date(format(Sys.time(), "%Y-%m-%d")), max(as.Date(detects_study$release_time)+(as.numeric(detects_study$tag_life))))
if(nrow(detects_benicia) == 0){
if(as.numeric(difftime(Sys.time(), min(detects_study$RelDT), units = "days"))>30){
WR.surv <- data.frame("Release"="ALL", "estimate"=0, "se"=NA, "lcl"=NA, "ucl"=NA, "Detection_efficiency"=NA)
} else {
WR.surv <- data.frame("Release"=NA, "estimate"="NO DETECTIONS YET", "se"=NA, "lcl"=NA, "ucl"=NA, "Detection_efficiency"=NA)
}
WR.surv1 <- WR.surv
colnames(WR.surv1) <- c("Release Group", "Survival (%)", "SE", "95% lower C.I.", "95% upper C.I.", "Detection efficiency (%)")
print(kable(WR.surv1, row.names = F, "html", caption = "3.1 Minimum survival to Benicia Bridge East Span (using CJS survival model)") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive", "bordered"), full_width = F, position = "left"))
} else if(length(table(detects_benicia$general_location)) == 1){
if(as.numeric(difftime(Sys.time(), min(detects_study$RelDT), units = "days"))>30){
WR.surv <- data.frame("Release"="ALL", "estimate"=round(length(unique(detects_benicia$TagCode))/length(unique(detects_study$TagCode))*100,1),
"se"=NA, "lcl"=NA, "ucl"=NA, "Detection_efficiency"=NA)
} else {
WR.surv <- data.frame("Release" = NA, "estimate" = "NOT ENOUGH DETECTIONS", "se" = NA, "lcl" = NA, "ucl" = NA, "Detection_efficiency" = NA)
}
WR.surv1 <- WR.surv
colnames(WR.surv1) <- c("Release Group", "Survival (%)", "SE", "95% lower C.I.", "95% upper C.I.", "Detection efficiency (%)")
print(kable(WR.surv1, row.names = F, "html", caption = "3.1 Minimum survival to Benicia Bridge East Span (using CJS survival model)") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive", "bordered"), full_width = F, position = "left"))
} else {
# Only do survival to Benicia here
test3 <- detects_study[which(detects_study$river_km < 53),]
# calculate mean and SD travel time
travel <- aggregate(list(first_detect = test3$DateTime_PST), by = list(Release = test3$Release, TagCode = test3$TagCode, RelDT = test3$RelDT), min)
travel$days <- as.numeric(difftime(travel$first_detect, travel$RelDT, units = "days"))
travel_final <- aggregate(list(mean_travel_time = travel$days), by = list(Release = travel$Release), mean)
travel_final <- merge(travel_final, aggregate(list(sd_travel_time = travel$days), by = list(Release = travel$Release), sd))
travel_final <- merge(travel_final, aggregate(list(n = travel$days), by = list(Release = travel$Release), length))
travel_final <- rbind(travel_final, data.frame(Release = "ALL", mean_travel_time = mean(travel$days), sd_travel_time = sd(travel$days), n = nrow(travel)))
# Create inp for survival estimation
inp <- as.data.frame(reshape2::dcast(test3, TagCode ~ river_km, fun.aggregate = length))
# Sort columns by river km in descending order
# Count number of genlocs
gen_loc_sites <- ncol(inp)-1
inp <- inp[,c(1,order(names(inp[,2:(gen_loc_sites+1)]), decreasing = T)+1)]
inp <- merge(study_tagcodes, inp, by = "TagCode", all.x = T)
inp2 <- inp[,(ncol(inp)-gen_loc_sites+1):ncol(inp)]
inp2[is.na(inp2)] <- 0
inp2[inp2 > 0] <- 1
inp <- cbind(inp, inp2)
groups <- as.character(sort(unique(inp$Release)))
groups_w_detects <- names(table(test3$Release))
inp[,groups] <- 0
for(i in groups){
inp[as.character(inp$Release) == i, i] <- 1
}
inp$inp_final <- paste("1",apply(inp2, 1, paste, collapse=""),sep="")
if(length(groups) > 1){
# make sure factor levels have a release that has detections first. if first release in factor order has zero #detectins, model goes haywire
inp.df <- data.frame(ch = as.character(inp$inp_final), freq = 1, rel = inp$Release, stringsAsFactors = F)
WR.process <- process.data(inp.df, model="CJS", begin.time=1)
WR.ddl <- make.design.data(WR.process)
WR.mark.all <- mark(WR.process, WR.ddl, model.parameters=list(Phi=list(formula=~time),p=list(formula=~time)), silent = T, output = F)
inp.df <- inp.df[inp.df$rel %in% groups_w_detects,]
inp.df$rel <- factor(inp.df$rel, levels = groups_w_detects)
if(length(groups_w_detects) > 1){
WR.process <- process.data(inp.df, model="CJS", begin.time=1, groups = "rel")
WR.ddl <- make.design.data(WR.process)
WR.mark.rel <- mark(WR.process, WR.ddl, model.parameters=list(Phi=list(formula=~time*rel),p=list(formula=~time)), silent = T, output = F)
} else {
WR.process <- process.data(inp.df, model="CJS", begin.time=1)
WR.ddl <- make.design.data(WR.process)
WR.mark.rel <- mark(WR.process, WR.ddl, model.parameters=list(Phi=list(formula=~time),p=list(formula=~time)), silent = T, output = F)
}
WR.surv <- cbind(Release = "ALL",round(WR.mark.all$results$real[1,c("estimate", "se", "lcl", "ucl")] * 100,1))
WR.surv.rel <- cbind(Release = groups_w_detects, round(WR.mark.rel$results$real[seq(from=1,to=length(groups_w_detects)*2,by = 2),
c("estimate", "se", "lcl", "ucl")] * 100,1))
WR.surv.rel <- merge(WR.surv.rel, data.frame(Release = groups), all.y = T)
WR.surv.rel[is.na(WR.surv.rel$estimate),"estimate"] <- 0
WR.surv <- rbind(WR.surv, WR.surv.rel)
} else {
inp.df <- data.frame(ch = as.character(inp$inp_final), freq = 1, stringsAsFactors = F)
WR.process <- process.data(inp.df, model="CJS", begin.time=1)
WR.ddl <- make.design.data(WR.process)
WR.mark.all <- mark(WR.process, WR.ddl, model.parameters=list(Phi=list(formula=~time),p=list(formula=~time)), silent = T, output = F)
WR.surv <- cbind(Release = c("ALL", groups),round(WR.mark.all$results$real[1,c("estimate", "se", "lcl", "ucl")] * 100,1))
}
WR.surv$Detection_efficiency <- NA
WR.surv[1,"Detection_efficiency"] <- round(WR.mark.all$results$real[gen_loc_sites+1,"estimate"] * 100,1)
WR.surv1 <- WR.surv
colnames(WR.surv1)[1] <- "Release"
WR.surv1 <- merge(WR.surv1, travel_final, by = "Release", all.x = T)
WR.surv1$mean_travel_time <- round(WR.surv1$mean_travel_time,1)
WR.surv1$sd_travel_time <- round(WR.surv1$sd_travel_time,1)
colnames(WR.surv1) <- c("Release", "Survival (%)", "SE", "95% lower C.I.",
"95% upper C.I.", "Detection efficiency (%)", "Mean time to Benicia (days)", "SD of time to Benicia (days)", "Count")
#colnames(WR.surv1) <- c("Release Group", "Survival (%)", "SE", "95% lower C.I.", "95% upper C.I.", "Detection efficiency (%)")
print(kable(WR.surv1, row.names = F, "html", caption = "3.3 Minimum survival to Benicia Bridge East Span (using CJS survival model), and travel time") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive", "bordered"), full_width = F, position = "left"))
}
Release | Survival (%) | SE | 95% lower C.I. | 95% upper C.I. | Detection efficiency (%) | Mean time to Benicia (days) | SD of time to Benicia (days) | Count |
---|---|---|---|---|---|---|---|---|
ALL | 11.4 | 1.7 | 8.4 | 15.3 | 96.8 | 13.3 | 7.0 | 38 |
Dos_Reis_Rel | 14.5 | 3.5 | 8.9 | 22.7 | NA | 11.2 | 6.6 | 15 |
DurhamFerry_Rel | 7.9 | 2.3 | 4.4 | 13.8 | NA | 15.4 | 6.5 | 11 |
Head_of_Old_River_Rel | 13.3 | 3.6 | 7.7 | 21.9 | NA | 14.1 | 7.8 | 12 |
if(exists("benicia")==T & is.numeric(WR.surv1[1,2])){
# Find mean release time per release group, and ALL
reltimes <- aggregate(list(RelDT = study_tagcodes$release_time), by = list(Release = study_tagcodes$Release), FUN = mean)
reltimes <- rbind(reltimes, data.frame(Release = "ALL", RelDT = mean(study_tagcodes$release_time)))
# Assign whether the results are tentative or final
quality <- "tentative"
if(endtime < as.Date(format(Sys.time(), "%Y-%m-%d"))){
quality <- "final"
}
WR.surv <- merge(WR.surv, reltimes, by = "Release", all.x = T)
WR.surv$RelDT <- as.POSIXct(WR.surv$RelDT, origin = "1970-01-01")
benicia$RelDT <- as.POSIXct(benicia$RelDT)
# remove old benicia record for this studyID
benicia <- benicia[!benicia$StudyID == unique(detects_study$Study_ID),]
benicia <- rbind(benicia, data.frame(WR.surv, StudyID = unique(detects_study$Study_ID), data_quality = quality))
write.csv(benicia, "benicia_surv.csv", row.names = F, quote = F)
}
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
if(nrow(detects_study[is.na(detects_study$DateTime_PST)==F,]) == 0){
"No detections yet"
} else {
arrivals <- detects_study %>%
group_by(general_location, TagCode) %>%
summarise(DateTime_PST = min(DateTime_PST)) %>%
arrange(TagCode)
tag_stats <- arrivals %>%
group_by(general_location) %>%
summarise(First_arrival = min(DateTime_PST),
Mean_arrival = mean(DateTime_PST),
Last_arrival = max(DateTime_PST),
Fish_count = length(unique(TagCode))) %>%
mutate(Percent_arrived = round(Fish_count/nrow(study_tagcodes) * 100,2)) %>%
dplyr::left_join(., unique(detects_study[,c("general_location", "river_km")])) %>%
arrange(desc(river_km)) %>%
mutate(First_arrival = format(First_arrival, tz = "Etc/GMT+8"),
Mean_arrival = format(Mean_arrival, tz = "Etc/GMT+8"),
Last_arrival = format(Last_arrival, tz = "Etc/GMT+8")) %>%
na.omit()
print(kable(tag_stats, row.names = F,
caption = "4.1 Detections for all releases combined",
"html") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive", "bordered"), full_width = F, position = "left"))
count <- 0
for(j in sort(unique(study_tagcodes$Release))){
if(nrow(detects_study[detects_study$Release == j,]) > 0){
count <- count + 1
arrivals1 <- detects_study %>%
filter(Release == j) %>%
group_by(general_location, TagCode) %>%
summarise(DateTime_PST = min(DateTime_PST)) %>%
arrange(TagCode)
rel_count <- nrow(study_tagcodes[study_tagcodes$Release == j,])
tag_stats1 <- arrivals1 %>%
group_by(general_location) %>%
summarise(First_arrival = min(DateTime_PST),
Mean_arrival = mean(DateTime_PST),
Last_arrival = max(DateTime_PST),
Fish_count = length(unique(TagCode))) %>%
mutate(Percent_arrived = round(Fish_count/rel_count * 100,2)) %>%
dplyr::left_join(., unique(detects_study[,c("general_location", "river_km")])) %>%
arrange(desc(river_km)) %>%
mutate(First_arrival = format(First_arrival, tz = "Etc/GMT+8"),
Mean_arrival = format(Mean_arrival, tz = "Etc/GMT+8"),
Last_arrival = format(Last_arrival, tz = "Etc/GMT+8")) %>%
na.omit()
final_stats <- kable(tag_stats1, row.names = F,
caption = paste("4.2.", count, " Detections for ", j, " release groups", sep = ""),
"html")
print(kable_styling(final_stats, bootstrap_options = c("striped", "hover", "condensed", "responsive", "bordered"), full_width = F, position = "left"))
} else {
cat("\n\n\\pagebreak\n")
print(paste("No detections for",j,"release group yet", sep=" "), quote = F)
cat("\n\n\\pagebreak\n")
}
}
}
general_location | First_arrival | Mean_arrival | Last_arrival | Fish_count | Percent_arrived | river_km |
---|---|---|---|---|---|---|
MiddleRiver | 2024-04-20 02:18:02 | 2024-04-27 20:38:14 | 2024-05-21 13:32:14 | 17 | 5.07 | 150.000 |
Clifton_Court_US_Radial_Gates | 2024-04-18 18:58:11 | 2024-04-27 17:53:50 | 2024-06-03 20:40:24 | 31 | 9.25 | 146.000 |
Holland_Cut_Quimby | 2024-04-18 22:45:07 | 2024-04-29 01:05:41 | 2024-05-10 09:20:25 | 16 | 4.78 | 145.000 |
CVP_Tank | 2024-04-21 00:50:08 | 2024-05-04 17:05:45 | 2024-05-23 08:29:03 | 9 | 2.69 | 144.531 |
CVP_Trash_Rack_1 | 2024-04-18 11:52:42 | 2024-04-28 12:01:55 | 2024-10-27 04:58:09 | 57 | 17.01 | 144.500 |
Clifton_Court_Intake_Canal | 2024-04-19 07:15:07 | 2024-05-02 11:03:55 | 2024-05-24 21:03:27 | 12 | 3.58 | 142.721 |
Old_River_Quimby | 2024-04-23 10:34:02 | 2024-05-18 08:27:39 | 2024-09-18 11:06:58 | 7 | 2.09 | 141.000 |
SacRiverWalnutGrove_2 | 2024-04-21 16:51:17 | 2024-04-28 19:44:11 | 2024-05-05 22:37:05 | 2 | 0.60 | 120.300 |
Georg_Sl_1 | 2024-04-21 16:37:55 | 2024-04-28 19:21:09 | 2024-05-05 22:04:23 | 2 | 0.60 | 119.600 |
Benicia_east | 2024-04-22 05:50:39 | 2024-05-01 08:40:56 | 2024-05-19 15:50:53 | 37 | 11.04 | 52.240 |
Benicia_west | 2024-04-22 05:53:09 | 2024-05-07 04:12:35 | 2024-10-06 06:25:16 | 31 | 9.25 | 52.040 |
general_location | First_arrival | Mean_arrival | Last_arrival | Fish_count | Percent_arrived | river_km |
---|---|---|---|---|---|---|
MiddleRiver | 2024-04-20 02:18:02 | 2024-04-28 14:13:51 | 2024-05-21 13:32:14 | 10 | 9.62 | 150.000 |
Clifton_Court_US_Radial_Gates | 2024-04-29 16:32:58 | 2024-05-17 06:36:41 | 2024-06-03 20:40:24 | 2 | 1.92 | 146.000 |
Holland_Cut_Quimby | 2024-04-23 00:02:55 | 2024-05-01 18:12:22 | 2024-05-10 09:20:25 | 4 | 3.85 | 145.000 |
CVP_Tank | 2024-04-29 05:48:46 | 2024-04-30 00:41:21 | 2024-04-30 19:33:56 | 2 | 1.92 | 144.531 |
CVP_Trash_Rack_1 | 2024-04-22 17:28:52 | 2024-04-28 06:26:10 | 2024-05-05 14:17:56 | 8 | 7.69 | 144.500 |
Clifton_Court_Intake_Canal | 2024-05-24 21:03:27 | 2024-05-24 21:03:27 | 2024-05-24 21:03:27 | 1 | 0.96 | 142.721 |
Old_River_Quimby | 2024-04-23 12:12:03 | 2024-04-27 04:08:02 | 2024-05-08 03:50:30 | 4 | 3.85 | 141.000 |
Benicia_east | 2024-04-22 18:40:06 | 2024-04-29 09:35:11 | 2024-05-15 13:08:43 | 15 | 14.42 | 52.240 |
Benicia_west | 2024-04-22 18:40:58 | 2024-05-12 09:55:28 | 2024-10-06 06:25:16 | 13 | 12.50 | 52.040 |
general_location | First_arrival | Mean_arrival | Last_arrival | Fish_count | Percent_arrived | river_km |
---|---|---|---|---|---|---|
MiddleRiver | 2024-04-26 21:11:05 | 2024-04-27 03:02:03 | 2024-04-27 08:55:52 | 3 | 2.14 | 150.000 |
Clifton_Court_US_Radial_Gates | 2024-04-23 05:24:51 | 2024-05-02 06:42:08 | 2024-05-12 18:35:08 | 6 | 4.29 | 146.000 |
Holland_Cut_Quimby | 2024-04-27 09:22:08 | 2024-05-02 01:01:36 | 2024-05-06 16:41:05 | 2 | 1.43 | 145.000 |
CVP_Tank | 2024-04-29 10:32:23 | 2024-05-11 09:30:43 | 2024-05-23 08:29:03 | 2 | 1.43 | 144.531 |
CVP_Trash_Rack_1 | 2024-04-20 06:50:20 | 2024-04-29 10:55:58 | 2024-05-23 04:57:27 | 14 | 10.00 | 144.500 |
Clifton_Court_Intake_Canal | 2024-04-30 12:49:33 | 2024-05-07 22:23:33 | 2024-05-17 14:04:01 | 3 | 2.14 | 142.721 |
Old_River_Quimby | 2024-04-23 10:34:02 | 2024-07-06 10:50:30 | 2024-09-18 11:06:58 | 2 | 1.43 | 141.000 |
Benicia_east | 2024-04-26 06:52:15 | 2024-05-03 10:33:51 | 2024-05-13 12:37:17 | 10 | 7.14 | 52.240 |
Benicia_west | 2024-04-26 06:55:36 | 2024-05-04 11:37:27 | 2024-05-13 19:01:45 | 8 | 5.71 | 52.040 |
general_location | First_arrival | Mean_arrival | Last_arrival | Fish_count | Percent_arrived | river_km |
---|---|---|---|---|---|---|
MiddleRiver | 2024-04-20 16:12:12 | 2024-04-26 13:51:21 | 2024-05-04 15:32:55 | 4 | 4.40 | 150.000 |
Clifton_Court_US_Radial_Gates | 2024-04-18 18:58:11 | 2024-04-24 20:45:20 | 2024-05-19 16:58:36 | 23 | 25.27 | 146.000 |
Holland_Cut_Quimby | 2024-04-18 22:45:07 | 2024-04-27 08:39:49 | 2024-05-04 21:34:55 | 10 | 10.99 | 145.000 |
CVP_Tank | 2024-04-21 00:50:08 | 2024-05-03 21:53:32 | 2024-05-17 02:38:43 | 5 | 5.49 | 144.531 |
CVP_Trash_Rack_1 | 2024-04-18 11:52:42 | 2024-04-28 04:09:03 | 2024-10-27 04:58:09 | 35 | 38.46 | 144.500 |
Clifton_Court_Intake_Canal | 2024-04-19 07:15:07 | 2024-04-27 14:34:07 | 2024-05-21 07:44:04 | 8 | 8.79 | 142.721 |
Old_River_Quimby | 2024-05-04 21:00:24 | 2024-05-04 21:00:24 | 2024-05-04 21:00:24 | 1 | 1.10 | 141.000 |
SacRiverWalnutGrove_2 | 2024-04-21 16:51:17 | 2024-04-28 19:44:11 | 2024-05-05 22:37:05 | 2 | 2.20 | 120.300 |
Georg_Sl_1 | 2024-04-21 16:37:55 | 2024-04-28 19:21:09 | 2024-05-05 22:04:23 | 2 | 2.20 | 119.600 |
Benicia_east | 2024-04-22 05:50:39 | 2024-05-02 01:59:02 | 2024-05-19 15:50:53 | 12 | 13.19 | 52.240 |
Benicia_west | 2024-04-22 05:53:09 | 2024-05-02 12:26:56 | 2024-05-19 15:54:36 | 10 | 10.99 | 52.040 |
library(dplyr)
library(dbplyr)
library(DBI)
library(odbc)
library(data.table)
# Create connection with cloud database
con <- dbConnect(odbc(),
Driver = "SQL Server",
Server = "calfishtrack-server.database.windows.net",
Database = "realtime_detections",
UID = "realtime_user",
PWD = "Pass@123",
Port = 1433)
try(setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = "")))
# THIS CODE CHUNK WILL NOT WORK IF USING ONLY ERDDAP DATA, REQUIRES ACCESS TO LOCAL FILES
if(nrow(detects_study[is.na(detects_study$DateTime_PST)==F,]) == 0){
"No detections yet"
} else {
arrivals <- detects_study %>%
group_by(general_location, TagCode) %>%
summarise(DateTime_PST = min(DateTime_PST)) %>%
mutate(day = as.Date(DateTime_PST, "%Y-%m-%d", tz = "Etc/GMT+8"))
# Use dbplyr to load realtime_locs and qryHexCodes sql table
gen_locs <- tbl(con, "realtime_locs") %>% collect()
# gen_locs <- read.csv("realtime_locs.csv", stringsAsFactors = F)
beacon_by_day <- fread("beacon_by_day.csv", stringsAsFactors = F) %>%
mutate(day = as.Date(day)) %>%
filter(TagCode == beacon) %>% # Now subset to only look at data for the correct beacon for that day
filter(day >= as.Date(min(study_tagcodes$release_time)) &
day <= endtime) %>% # Now only keep beacon by day for days since fish were released
dplyr::left_join(., gen_locs[,c("location", "general_location","rkm")], by = "location")
arrivals_per_day <- arrivals %>%
group_by(day, general_location) %>%
summarise(New_arrivals = length(TagCode)) %>%
arrange(general_location) %>% na.omit() %>%
mutate(day = as.Date(day)) %>%
dplyr::left_join(unique(beacon_by_day[,c("general_location", "day", "rkm")]),
., by = c("general_location", "day")) %>%
arrange(general_location, day) %>%
mutate(day = factor(day)) %>%
filter(general_location != "Bench_test") %>% # Remove bench test and other NA locations
filter(!(is.na(general_location))) %>%
arrange(desc(rkm)) %>% # Change order of data to plot decreasing river_km
mutate(general_location = factor(general_location, unique(general_location)))
endtime <- min(as.Date(format(Sys.time(), "%Y-%m-%d")),
max(as.Date(detects_study$release_time)+(as.numeric(detects_study$tag_life)*1.5)))
crosstab <- xtabs(formula = arrivals_per_day$New_arrivals ~ arrivals_per_day$day + arrivals_per_day$general_location,
addNA =T)
crosstab[is.na(crosstab)] <- ""
crosstab[crosstab==0] <- NA
crosstab <- as.data.frame.matrix(crosstab)
kable(crosstab, align = "c", caption = "4.3 Fish arrivals per day (\"NA\" means receivers were non-operational)") %>%
kable_styling(c("striped", "condensed"), font_size = 11, full_width = F, position = "left", fixed_thead = TRUE) %>%
column_spec(column = 1:ncol(crosstab),width_min = "50px",border_left = T, border_right = T) %>%
column_spec(1, bold = T, width_min = "75px")%>%
scroll_box(height = "700px")
}
Blw_Salt_RT | MeridianBr | Stan_Valley_Oak | TowerBridge | I80-50_Br | MiddleRiver | Clifton_Court_US_Radial_Gates | Holland_Cut_Quimby | CVP_Tank | CVP_Trash_Rack_1 | Clifton_Court_Intake_Canal | Old_River_Quimby | SacRiverWalnutGrove_2 | Georg_Sl_1 | Sac_BlwGeorgiana | Sac_BlwGeorgiana2 | Benicia_east | Benicia_west | |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
2024-04-17 | ||||||||||||||||||
2024-04-18 | 1 | 1 | 2 | |||||||||||||||
2024-04-19 | 1 | 10 | 1 | |||||||||||||||
2024-04-20 | 2 | 5 | 11 | 1 | ||||||||||||||
2024-04-21 | 3 | 1 | 5 | 1 | 1 | |||||||||||||
2024-04-22 | 2 | 1 | 1 | 4 | 2 | 2 | ||||||||||||
2024-04-23 | 1 | 6 | 3 | 2 | 1 | 4 | ||||||||||||
2024-04-24 | 2 | 2 | 2 | 1 | 1 | |||||||||||||
2024-04-25 | 1 | 1 | 3 | 1 | ||||||||||||||
2024-04-26 | 2 | 2 | 1 | 1 | 6 | 5 | ||||||||||||
2024-04-27 | 3 | 2 | 1 | 3 | 1 | 2 | 2 | |||||||||||
2024-04-28 | 1 | 2 | 6 | 3 | 2 | |||||||||||||
2024-04-29 | 3 | 2 | 2 | 1 | 3 | 2 | ||||||||||||
2024-04-30 | 1 | 1 | 1 | 2 | 1 | 3 | 3 | |||||||||||
2024-05-01 | 1 | 3 | 2 | |||||||||||||||
2024-05-02 | 1 | 1 | 1 | |||||||||||||||
2024-05-03 | 1 | 1 | ||||||||||||||||
2024-05-04 | 1 | 1 | 1 | 1 | ||||||||||||||
2024-05-05 | 1 | 1 | 1 | 1 | 1 | 1 | ||||||||||||
2024-05-06 | 1 | |||||||||||||||||
2024-05-07 | 1 | 1 | 1 | |||||||||||||||
2024-05-08 | 1 | 1 | 1 | 1 | ||||||||||||||
2024-05-09 | 1 | 1 | ||||||||||||||||
2024-05-10 | 1 | 3 | 3 | |||||||||||||||
2024-05-11 | 1 | |||||||||||||||||
2024-05-12 | 1 | 1 | ||||||||||||||||
2024-05-13 | 1 | 1 | ||||||||||||||||
2024-05-14 | ||||||||||||||||||
2024-05-15 | 1 | 1 | ||||||||||||||||
2024-05-16 | 2 | |||||||||||||||||
2024-05-17 | 2 | 1 | ||||||||||||||||
2024-05-18 | ||||||||||||||||||
2024-05-19 | 1 | 1 | 1 | |||||||||||||||
2024-05-20 | ||||||||||||||||||
2024-05-21 | 1 | 1 | ||||||||||||||||
2024-05-22 | ||||||||||||||||||
2024-05-23 | 1 | 1 | ||||||||||||||||
2024-05-24 | 1 | |||||||||||||||||
2024-05-25 | ||||||||||||||||||
2024-05-26 | ||||||||||||||||||
2024-05-27 | ||||||||||||||||||
2024-05-28 | ||||||||||||||||||
2024-05-29 | ||||||||||||||||||
2024-05-30 | ||||||||||||||||||
2024-05-31 | ||||||||||||||||||
2024-06-01 | ||||||||||||||||||
2024-06-02 | ||||||||||||||||||
2024-06-03 | 1 | |||||||||||||||||
2024-06-04 | ||||||||||||||||||
2024-06-05 | ||||||||||||||||||
2024-06-06 | ||||||||||||||||||
2024-06-07 | ||||||||||||||||||
2024-06-08 | ||||||||||||||||||
2024-06-09 | ||||||||||||||||||
2024-06-10 | ||||||||||||||||||
2024-06-11 | ||||||||||||||||||
2024-06-12 | ||||||||||||||||||
2024-06-13 | ||||||||||||||||||
2024-06-14 | ||||||||||||||||||
2024-06-15 | ||||||||||||||||||
2024-06-16 | ||||||||||||||||||
2024-06-17 | ||||||||||||||||||
2024-06-18 | ||||||||||||||||||
2024-06-19 | ||||||||||||||||||
2024-06-20 | ||||||||||||||||||
2024-06-21 | ||||||||||||||||||
2024-06-22 | ||||||||||||||||||
2024-06-23 | ||||||||||||||||||
2024-06-24 | ||||||||||||||||||
2024-06-25 | ||||||||||||||||||
2024-06-26 | ||||||||||||||||||
2024-06-27 | ||||||||||||||||||
2024-06-28 | ||||||||||||||||||
2024-06-29 | ||||||||||||||||||
2024-06-30 | ||||||||||||||||||
2024-07-01 | ||||||||||||||||||
2024-07-02 | ||||||||||||||||||
2024-07-03 | ||||||||||||||||||
2024-07-04 | ||||||||||||||||||
2024-07-05 | ||||||||||||||||||
2024-07-06 | ||||||||||||||||||
2024-07-07 | ||||||||||||||||||
2024-07-08 | ||||||||||||||||||
2024-07-09 | ||||||||||||||||||
2024-07-10 | ||||||||||||||||||
2024-07-11 | ||||||||||||||||||
2024-07-12 | ||||||||||||||||||
2024-07-13 | ||||||||||||||||||
2024-07-14 | ||||||||||||||||||
2024-07-15 | ||||||||||||||||||
2024-07-16 | ||||||||||||||||||
2024-07-17 | ||||||||||||||||||
2024-07-18 | ||||||||||||||||||
2024-07-19 | ||||||||||||||||||
2024-07-20 | ||||||||||||||||||
2024-07-21 | ||||||||||||||||||
2024-07-22 | ||||||||||||||||||
2024-07-23 | ||||||||||||||||||
2024-07-24 | ||||||||||||||||||
2024-07-25 | ||||||||||||||||||
2024-07-26 | ||||||||||||||||||
2024-07-27 | ||||||||||||||||||
2024-07-28 | ||||||||||||||||||
2024-07-29 | ||||||||||||||||||
2024-07-30 | ||||||||||||||||||
2024-07-31 | ||||||||||||||||||
2024-08-01 | ||||||||||||||||||
2024-08-02 | ||||||||||||||||||
2024-08-03 | ||||||||||||||||||
2024-08-04 | ||||||||||||||||||
2024-08-05 | ||||||||||||||||||
2024-08-06 | ||||||||||||||||||
2024-08-07 | ||||||||||||||||||
2024-08-08 | ||||||||||||||||||
2024-08-09 | ||||||||||||||||||
2024-08-10 | ||||||||||||||||||
2024-08-11 | ||||||||||||||||||
2024-08-12 | ||||||||||||||||||
2024-08-13 | ||||||||||||||||||
2024-08-14 | NA | |||||||||||||||||
2024-08-15 | ||||||||||||||||||
2024-08-16 | NA | |||||||||||||||||
2024-08-17 | NA | |||||||||||||||||
2024-08-18 | NA | |||||||||||||||||
2024-08-19 | NA | |||||||||||||||||
2024-08-20 | NA | |||||||||||||||||
2024-08-21 | NA | |||||||||||||||||
2024-08-22 | NA | |||||||||||||||||
2024-08-23 | NA | |||||||||||||||||
2024-08-24 | NA | |||||||||||||||||
2024-08-25 | NA | |||||||||||||||||
2024-08-26 | NA | |||||||||||||||||
2024-08-27 | NA | |||||||||||||||||
2024-08-28 | NA | |||||||||||||||||
2024-08-29 | NA | |||||||||||||||||
2024-08-30 | NA | |||||||||||||||||
2024-08-31 | NA | |||||||||||||||||
2024-09-01 | NA | |||||||||||||||||
2024-09-02 | NA | |||||||||||||||||
2024-09-03 | NA | |||||||||||||||||
2024-09-04 | NA | |||||||||||||||||
2024-09-05 | NA | |||||||||||||||||
2024-09-06 | NA | |||||||||||||||||
2024-09-07 | NA | |||||||||||||||||
2024-09-08 | NA | |||||||||||||||||
2024-09-09 | NA | |||||||||||||||||
2024-09-10 | NA | |||||||||||||||||
2024-09-11 | ||||||||||||||||||
2024-09-12 | ||||||||||||||||||
2024-09-13 | ||||||||||||||||||
2024-09-14 | ||||||||||||||||||
2024-09-15 | ||||||||||||||||||
2024-09-16 | ||||||||||||||||||
2024-09-17 | ||||||||||||||||||
2024-09-18 | 1 | |||||||||||||||||
2024-09-19 | ||||||||||||||||||
2024-09-20 | ||||||||||||||||||
2024-09-21 | ||||||||||||||||||
2024-09-22 | ||||||||||||||||||
2024-09-23 | ||||||||||||||||||
2024-09-24 | ||||||||||||||||||
2024-09-25 |
rm(list = ls())
cleanup(ask = F)
For questions or comments, please contact cyril.michel@noaa.gov