CalFishTrack

2017-2018 Season (PROVISIONAL DATA)

Note: Chinook salmon stock assignments not currently available, but likely a combination of fall and spring-run fish

1. Project Status

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-11 21:00:00	2018-05-11 21:00:00	20	RBDD	461.579	95.0	10.6
Week 2	2018-05-18 21:00:00	2018-05-18 21:00:00	29	RBDD	461.579	92.0	9.1
Week 3	2018-05-22 21:00:00	2018-05-23 21:00:00	55	RBDD	461.579	95.3	10.1
Week 4	2018-05-30 21:00:00	2018-05-31 21:00:00	101	RBDD	441.728	92.2	8.9
Week 5	2018-06-04 21:00:00	2018-06-06 21:00:00	104	RBDD	441.728	93.1	9.2

2. Real-time Fish Detections

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 09: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_RBDD-2018.csv", stringsAsFactors = F)
detects_study$DateTime_PST <- as.POSIXct(detects_study$DateTime_PST, format = "%Y-%m-%d %H:%M:%S", "Etc/GMT+8")

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-12"), "Release_week"] <- "Week 1"
tagcodes[tagcodes$RelDT > as.POSIXct("2018-05-12") & tagcodes$RelDT < as.POSIXct("2018-05-20"), "Release_week"] <- "Week 2"
tagcodes[tagcodes$RelDT > as.POSIXct("2018-05-20") & tagcodes$RelDT < as.POSIXct("2018-05-24"), "Release_week"] <- "Week 3"
tagcodes[tagcodes$RelDT > as.POSIXct("2018-05-24") & tagcodes$RelDT < as.POSIXct("2018-06-01"), "Release_week"] <- "Week 4"
tagcodes[tagcodes$RelDT > as.POSIXct("2018-06-01") & tagcodes$RelDT < as.POSIXct("2018-06-07"), "Release_week"] <- "Week 5"

#wlk_flow <- read.csv("wlk.csv")

if (nrow(detects_study) == 0){
  "No detections yet"
} else {
  
  detects_study <- detects_study[detects_study$general_location == "TowerBridge",]
  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", border=NA)#,
  #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

## [1] "No detections at Benicia yet"

3. Survival Probability

3.1 Minimum survival to Tower Bridge (using CJS survival model)
Release Week	Survival (%)	SE	95% lower C.I.	95% upper C.I.	Detection efficiency (%)
ALL	3.2	1.0	1.7	5.9	100
Week 1	5.0	4.9	0.7	28.2	NA
Week 2	6.9	4.7	1.7	23.8	NA
Week 3	12.7	4.5	6.2	24.4	NA
Week 4	0.0	0.0	0.0	0.0	NA
Week 5	0.0	0.0	0.0	0.0	NA

3.2 Reach-specific survival and probability of entering Georgiana Slough

[1] “Too few detections: routing probability cannot be estimated”

3.3 Minimum survival to Benicia Bridge East Span (using CJS survival model)

[1] “No detections yet”

4. Detection Statistics

4.1 Detections for all release weeks combined
general_location	First_arrival	Mean_arrival	Fish_count	Percent_arrived	rkm
TowerBridge	2018-05-19 19:46:57	2018-05-24 00:49:29	10	3.24	172.000
I80-50_Br	2018-05-25 14:31:32	2018-05-28 13:59:00	7	2.27	170.748
Sac_BlwGeorgiana	2018-06-09 16:55:44	2018-06-09 16:59:24	1	0.32	119.058
Sac_BlwGeorgiana2	2018-06-09 17:09:44	2018-06-09 17:11:56	1	0.32	118.398

4.2 Detections for Week 1 release groups
general_location	First_arrival	Mean_arrival	Fish_count	Percent_arrived	rkm
TowerBridge	2018-05-19 19:46:57	2018-05-19 20:54:27	1	5	172

4.3 Detections for Week 2 release groups
general_location	First_arrival	Mean_arrival	Fish_count	Percent_arrived	rkm
TowerBridge	2018-05-25 20:49:36	2018-05-26 01:01:20	2	6.90	172.000
I80-50_Br	2018-05-25 14:31:32	2018-05-25 19:55:58	1	3.45	170.748

4.4 Detections for Week 3 release groups
general_location	First_arrival	Mean_arrival	Fish_count	Percent_arrived	rkm
TowerBridge	2018-05-28 17:16:37	2018-05-30 06:18:51	7	12.73	172.000
I80-50_Br	2018-05-28 18:11:12	2018-05-29 19:56:40	6	10.91	170.748
Sac_BlwGeorgiana	2018-06-09 16:55:44	2018-06-09 16:59:24	1	1.82	119.058
Sac_BlwGeorgiana2	2018-06-09 17:09:44	2018-06-09 17:11:56	1	1.82	118.398

No detections for Week 4 release group yet

No detections for Week 5 release group yet