Study is complete, all tags are no longer active. All times in Pacific Standard Time.
See tagging details below:Release_week | First_release_time | Last_release_time | Number_fish_released | Release_location | Release_rkm | Mean_length | Mean_weight |
---|---|---|---|---|---|---|---|
Week 1 | 2018-05-02 21:00:00 | 2018-05-02 21:00:00 | 8 | DeerCkRST | 441.728 | 84.9 | 6.9 |
Week 2 | 2018-05-07 21:00:00 | 2018-05-14 21:00:00 | 14 | DeerCkRST | 441.728 | 82.1 | 6.5 |
Week 3 | 2018-05-17 21:00:00 | 2018-05-17 21:00:00 | 4 | DeerCkRST | 441.728 | 80.2 | 6.2 |
Sacramento real-time receivers deployed 2018-02-01, Georgiana_Slough and Sac_BlwGeorgiana receivers deployed 2018-04-16, data current as of 2025-04-22 08:00:00. All times in Pacific Standard Time.
setwd(paste(file.path(Sys.getenv("USERPROFILE"),"Desktop",fsep="\\"), "\\Real-time data massaging\\products", sep = ""))
library(cder)
library(reshape2)
detects_study <- read.csv("C:/Users/field/Desktop/Real-time data massaging/products/Study_detection_files/detects_DeerCk-Wild-2018.csv", stringsAsFactors = F)
detects_study$DateTime_PST <- as.POSIXct(detects_study$DateTime_PST, format = "%Y-%m-%d %H:%M:%S", "Etc/GMT+8")
detects_study <- detects_study[detects_study$general_location == "TowerBridge",]
tagcodes <- read.csv("qry_HexCodes.txt", stringsAsFactors = F)
tagcodes$RelDT <- as.POSIXct(tagcodes$RelDT, format = "%m/%d/%Y %H:%M:%S %p", tz = "Etc/GMT+8")
tagcodes$Release_week <- NA
tagcodes[tagcodes$RelDT < as.POSIXct("2018-05-05"), "Release_week"] <- "Week 1"
tagcodes[tagcodes$RelDT > as.POSIXct("2018-05-05") & tagcodes$RelDT < as.POSIXct("2018-05-15"), "Release_week"] <- "Week 2"
tagcodes[tagcodes$RelDT > as.POSIXct("2018-05-15") & tagcodes$RelDT < as.POSIXct("2018-05-20"), "Release_week"] <- "Week 3"
#wlk_flow <- read.csv("wlk.csv")
if (nrow(detects_study) == 0){
"No detections yet"
} else {
detects_study <- merge(detects_study,aggregate(list(first_detect = detects_study$DateTime_PST), by = list(TagCode= detects_study$TagCode), FUN = min))
detects_study$Day <- as.Date(detects_study$first_detect, "Etc/GMT+8")
detects_study <- merge(detects_study, tagcodes[,c("TagID_Hex", "RelDT", "StudyID", "Release_week", "tag_life")], by.x = "TagCode", by.y = "TagID_Hex")
starttime <- as.Date(min(detects_study$RelDT), "Etc/GMT+8")
endtime <- min(as.Date(c(Sys.time())), max(as.Date(detects_study$RelDT)+detects_study$tag_life))
wlk_flow <- cdec_query("WLK", "20", "H", starttime, endtime+1)
wlk_flow$datetime <- as.Date(wlk_flow$DateTime)
wlk_flow_day <- aggregate(list(parameter_value = wlk_flow$Value),
by = list(Day = wlk_flow$datetime),
FUN = mean, na.rm = T)
daterange <- data.frame(Day = seq.Date(from = starttime, to = endtime, by = "day"))
rels <- unique(tagcodes[tagcodes$StudyID == unique(detects_study$StudyID), "Release_week"])
rel_num <- length(rels)
rels_no_detects <- as.character(rels[!(rels %in% unique(detects_study$Release_week))])
tagcount <- aggregate(list(unique_tags = detects_study$TagCode), by = list(Day = detects_study$Day, Release_week = detects_study$Release_week ), FUN = function(x){length(unique(x))})
tagcount1 <- reshape2::dcast(tagcount, Day ~ Release_week)
daterange1 <- merge(daterange, tagcount1, all.x=T)
if(length(rels_no_detects)>0){
for(i in rels_no_detects){
daterange1 <- cbind(daterange1, x=NA)
names(daterange1)[names(daterange1) == 'x'] <- paste(i)
}
}
daterange2 <- merge(daterange1, wlk_flow_day, by = "Day", all.x = T)
rownames(daterange2) <- daterange2$Day
daterange2$Day <- NULL
par(mar=c(6, 5, 2, 5) + 0.1)
barp <- barplot(t(daterange2[,1:ncol(daterange2)-1]), plot = FALSE, beside = T)
barplot(t(daterange2[,1:ncol(daterange2)-1]), beside = T, col=rainbow(rel_num),
xlab = "", ylab = "Number of fish arrivals per day",
ylim = c(0,max(daterange2[,1:ncol(daterange2)-1], na.rm = T)*1.2),
las = 2, xlim=c(0,max(barp)+1), cex.lab = 1.5, yaxt = "n", xaxt = "n")#,
#legend.text = colnames(daterange2[,1:ncol(daterange2)-1]),
#args.legend = list(x ='topright', bty='n', inset=c(-0.2,0)), title = "Release Group")
legend(x ='topleft', legend = colnames(daterange2[,1:ncol(daterange2)-1]), fill= rainbow(rel_num), horiz = T, title = "Release Week")
ybreaks <- if(max(daterange2[,1:ncol(daterange2)-1], na.rm = T) < 4) {max(daterange2[,1:ncol(daterange2)-1], na.rm = T)} else {5}
xbreaks <- if(ncol(barp) > 10) {seq(1, ncol(barp), 2)} else {1:ncol(barp)}
barpmeans <- colMeans(barp)
axis(1, at = barpmeans[xbreaks], labels = rownames(daterange2[xbreaks,]), las = 2)
axis(2, at = pretty(0:max(daterange2[,1:ncol(daterange2)-1], na.rm = T), ybreaks))
par(new=T)
plot(x = barpmeans, daterange2$parameter_value, yaxt = "n", xaxt = "n", ylab = "", xlab = "", col = "blue", type = "l", lwd=2, xlim=c(0,max(barp)+1), ylim = c(min(daterange2$parameter_value, na.rm = T), max(daterange2$parameter_value, na.rm=T)*1.1))#, ylab = "Returning adults", xlab= "Outmigration year", yaxt="n", col="red", pch=20)
axis(side = 4)#, labels = c(2000:2016), at = c(2000:2016))
mtext("Flow (cfs) at Wilkins Slough", side=4, line=3, cex=1.5, col="blue")
}
2.1 Detections at Tower Bridge (downtown Sacramento) versus Sacramento River flows at Wilkins Slough
Release Week | Survival (%) | SE | 95% lower C.I. | 95% upper C.I. | Detection efficiency (%) |
---|---|---|---|---|---|
ALL | 3.8 | 3.8 | 0.5 | 22.8 | 100 |
Week 1 | 0.0 | 0.0 | 0.0 | 0.0 | NA |
Week 2 | 7.1 | 6.9 | 1.0 | 37.0 | NA |
Week 3 | 0.0 | 0.0 | 0.0 | 0.0 | NA |
general_location | First_arrival | Mean_arrival | Fish_count | Percent_arrived | rkm |
---|---|---|---|---|---|
TowerBridge | 2018-05-30 21:04:37 | 2018-05-30 21:10:07 | 1 | 3.85 | 172.000 |
I80-50_Br | 2018-05-30 21:35:44 | 2018-05-30 21:42:29 | 1 | 3.85 | 170.748 |
No detections for Week 1 release group yet
general_location | First_arrival | Mean_arrival | Fish_count | Percent_arrived | rkm |
---|---|---|---|---|---|
TowerBridge | 2018-05-30 21:04:37 | 2018-05-30 21:10:07 | 1 | 7.14 | 172.000 |
I80-50_Br | 2018-05-30 21:35:44 | 2018-05-30 21:42:29 | 1 | 7.14 | 170.748 |
No detections for Week 3 release group yet