################################################################################################################## ## Graydon McKee ## 2018 ## GLATOS detection efficiency code for Black Bay ################################################################################################################## ## 800 m spacing receiverLineDetSim <- function(vel=1,delayRng=c(120,360),burstDur=5.0, recSpc=800,maxDist=2000,rngFun,outerLim=c(0,0),nsim=1000,showPlot=FALSE) { #check if rngFun is function if(any(!is.function(rngFun))) stop(paste0("Error: argument 'rngFun' must be a function...\n", "see ?receiverLineDetSim\n check: is.function(rngFun)")) #Define receiver line if(any(is.na(recSpc))) recSpc <- 0 #to simulate one receiver xLim <- c(0,sum(recSpc)+sum(outerLim)) recLoc <- c(outerLim[1], outerLim[1] + cumsum(recSpc)) yLim <- c(-maxDist, maxDist) #Simulate tag transmissions nTrns <- floor((diff(yLim)/vel)/delayRng[1]) #number of transmissions #sample delays del <- matrix(runif(nTrns*nsim,delayRng[1],delayRng[2]), nrow=nsim, ncol=nTrns) del <- del + burstDur #add burst duration (for Vemco) trans <- t(apply(del, 1, cumsum)) #time series of signal transmissions #"center" the fish track over the receiver line; with some randomness trans <- trans - matrix(runif(nsim, trans[,nTrns/2],trans[,(nTrns/2)+1]), nrow=nsim, ncol=nTrns) #row = simulated fish; col = signal transmission fsh.x <- matrix(runif(nsim, xLim[1], xLim[2]), nrow=nsim, ncol=nTrns) #convert from time to distance from start fsh.y <- matrix(trans*vel, nrow=nsim, ncol=nTrns) #Optional quick and dirty plot just to see what is happening if(showPlot){ plot(NA, xlim=xLim, ylim=yLim, asp=c(1,1), xlab="Distance (in meters) along receiver line", ylab="Distance (in meters) along fish path") #fish tracks and transmissions for(i in 1:nsim){ lines(fsh.x[i,], fsh.y[i,], col="grey") #fish tracks points(fsh.x[i,], fsh.y[i,], pch=20, cex=0.8) #signal transmissions } #receiver locations points(recLoc, rep(0,length(recLoc)), pch=21, bg='red', cex=1.2) legend("topleft",legend=c("receiver","sim. fish path","tag transmit"), pch=c(21,124,20),col=c("black","grey","black"),pt.bg=c("red",NA,NA), pt.cex=c(1.2,1,0.8)) } #Simulate detections #calculate distances between transmissions and receivers for(i in 1:length(recLoc)){ #loop through receivers if(i == 1) { #pre-allocate objects, if first receiver succ <- detP <- distM <- vector("list",length(recLoc)) nDets <- matrix(NA, nrow=nsim, ncol=length(recLoc)) #col = receiver } #tag-receiver distances in meters distM[[i]] <- sqrt((fsh.x - recLoc[i])^2 + (fsh.y)^2) #detection probabilities detP[[i]] <- matrix(rngFun(distM[[i]]), nrow=nsim) #detected=1, not=0 succ[[i]] <- matrix(rbinom(length(detP[[i]]), 1, detP[[i]]), nrow=nsim) #number of times each transmitter detected on ith receiver nDets[,i] <- rowSums(succ[[i]]) } #max detects on any one receiver for each transmitter maxDet <- apply(nDets, 1, max) #proportion of transmitters detected more than once on any receiver detProb <- mean(maxDet>1) return(detProb) } pdrf <- function(dm, b=c(5.5, -1/120)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } #preview detection range curve plot(pdrf(0:2000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") #Five receivers and allow fish to pass to left and right of line dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,1), outerLim=c(400, 400), nsim=10000, showPlot=F) dp dph <- receiverLineDetSim(rngFun=pdrf, recSpc=c(800,1600,800), outerLim=c(400, 400), nsim=10000) dph ################################################### ## BEI ## Figure out the curvature of the detection range BEI.r<-subset(rangeTesting,rangeTesting$group=='BEI') plot(BEI.r$y~BEI.r$x) model <- glm(BEI.r$y~BEI.r$x,family="binomial") model summary(model) ## Create curve for gate pdrf.BEI <- function(dm, b=c(3.452692, -0.003538)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } plot(pdrf.BEI(0:2000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## Simulate fish passes ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,8), outerLim=c(400, 400), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,8), outerLim=c(400, 400), nsim=10000, showPlot=F) dp ## GEP ## Figure out the curvature of the detection range GEP.r<-subset(rangeTesting,rangeTesting$group=='GEP') plot(GEP.r$y~GEP.r$x) model <- glm(GEP.r$y~GEP.r$x,family="binomial") model summary(model) ## Create curve for gate pdrf.GEP <- function(dm, b=c(5.986417, -0.005841)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } plot(pdrf.GEP(0:2000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## Simulate fish passes ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10000, showPlot=F) dp ## Lost Receiver dph <- receiverLineDetSim(rngFun=pdrf, recSpc=c(800,1600,800), outerLim=c(400, 400), nsim=10000) dph ## EDI ## Figure out the curvature of the detection range EDI.r<-subset(rangeTesting,rangeTesting$group=='EDI') plot(EDI.r$y~EDI.r$x) model <- glm(EDI.r$y~EDI.r$x,family="binomial") model summary(model) ## Create curve for gate pdrf.EDI <- function(dm, b=c(6.9544068, -0.0046634)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } plot(pdrf.EDI(0:4000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## Simulate fish passes 1 receivers ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10000, showPlot=F) dp ## Simulate fish passes 2 receivers ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10000, showPlot=F) dp ###################################################################################################################### ## 1440 m spacing receiverLineDetSim <- function(vel=1,delayRng=c(120,360),burstDur=5.0, recSpc=1440,maxDist=2000,rngFun,outerLim=c(0,0),nsim=1000,showPlot=FALSE) { #check if rngFun is function if(any(!is.function(rngFun))) stop(paste0("Error: argument 'rngFun' must be a function...\n", "see ?receiverLineDetSim\n check: is.function(rngFun)")) #Define receiver line if(any(is.na(recSpc))) recSpc <- 0 #to simulate one receiver xLim <- c(0,sum(recSpc)+sum(outerLim)) recLoc <- c(outerLim[1], outerLim[1] + cumsum(recSpc)) yLim <- c(-maxDist, maxDist) #Simulate tag transmissions nTrns <- floor((diff(yLim)/vel)/delayRng[1]) #number of transmissions #sample delays del <- matrix(runif(nTrns*nsim,delayRng[1],delayRng[2]), nrow=nsim, ncol=nTrns) del <- del + burstDur #add burst duration (for Vemco) trans <- t(apply(del, 1, cumsum)) #time series of signal transmissions #"center" the fish track over the receiver line; with some randomness trans <- trans - matrix(runif(nsim, trans[,nTrns/2],trans[,(nTrns/2)+1]), nrow=nsim, ncol=nTrns) #row = simulated fish; col = signal transmission fsh.x <- matrix(runif(nsim, xLim[1], xLim[2]), nrow=nsim, ncol=nTrns) #convert from time to distance from start fsh.y <- matrix(trans*vel, nrow=nsim, ncol=nTrns) #Optional quick and dirty plot just to see what is happening if(showPlot){ plot(NA, xlim=xLim, ylim=yLim, asp=c(1,1), xlab="Distance (in meters) along receiver line", ylab="Distance (in meters) along fish path") #fish tracks and transmissions for(i in 1:nsim){ lines(fsh.x[i,], fsh.y[i,], col="grey") #fish tracks points(fsh.x[i,], fsh.y[i,], pch=20, cex=0.8) #signal transmissions } #receiver locations points(recLoc, rep(0,length(recLoc)), pch=21, bg='red', cex=1.2) legend("topleft",legend=c("receiver","sim. fish path","tag transmit"), pch=c(21,124,20),col=c("black","grey","black"),pt.bg=c("red",NA,NA), pt.cex=c(1.2,1,0.8)) } #Simulate detections #calculate distances between transmissions and receivers for(i in 1:length(recLoc)){ #loop through receivers if(i == 1) { #pre-allocate objects, if first receiver succ <- detP <- distM <- vector("list",length(recLoc)) nDets <- matrix(NA, nrow=nsim, ncol=length(recLoc)) #col = receiver } #tag-receiver distances in meters distM[[i]] <- sqrt((fsh.x - recLoc[i])^2 + (fsh.y)^2) #detection probabilities detP[[i]] <- matrix(rngFun(distM[[i]]), nrow=nsim) #detected=1, not=0 succ[[i]] <- matrix(rbinom(length(detP[[i]]), 1, detP[[i]]), nrow=nsim) #number of times each transmitter detected on ith receiver nDets[,i] <- rowSums(succ[[i]]) } #max detects on any one receiver for each transmitter maxDet <- apply(nDets, 1, max) #proportion of transmitters detected more than once on any receiver detProb <- mean(maxDet>1) return(detProb) } pdrf <- function(dm, b=c(5.5, -1/120)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } #preview detection range curve plot(pdrf(0:2000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## 10 fish to see what is happening dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1440,4), outerLim=c(720, 720), nsim=10, showPlot=T) #Five receivers and allow fish to pass to left and right of line dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1440,4), outerLim=c(720, 720), nsim=10000, showPlot=F) dp dph <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1440,4), outerLim=c(720, 720), nsim=10000) dph ################################################### ## BEI ## Figure out the curvature of the detection range BEI.r<-subset(rangeTesting,rangeTesting$group=='BEI') plot(BEI.r$y~BEI.r$x) model <- glm(BEI.r$y~BEI.r$x,family="binomial") model summary(model) ## Create curve for gate pdrf.BEI <- function(dm, b=c(3.452692, -0.003538)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } plot(pdrf.BEI(0:2000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## Simulate fish passes ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1440,4), outerLim=c(720, 720), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1440,4), outerLim=c(720, 720), nsim=10000, showPlot=F) dp ## GEP ## Figure out the curvature of the detection range GEP.r<-subset(rangeTesting,rangeTesting$group=='GEP') plot(GEP.r$y~GEP.r$x) model <- glm(GEP.r$y~GEP.r$x,family="binomial") model summary(model) ## Create curve for gate pdrf.GEP <- function(dm, b=c(5.986417, -0.005841)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } plot(pdrf.GEP(0:2000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## Simulate fish passes ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1333,2), outerLim=c(667, 667), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(1333,2), outerLim=c(667, 667), nsim=10000, showPlot=F) dp ## Lost Receiver dph <- receiverLineDetSim(rngFun=pdrf, recSpc=c(800,1600,800), outerLim=c(400, 400), nsim=10000) dph ## EDI ## Figure out the curvature of the detection range EDI.r<-subset(rangeTesting,rangeTesting$group=='EDI') plot(EDI.r$y~EDI.r$x) model <- glm(EDI.r$y~EDI.r$x,family="binomial") model summary(model) ## Create curve for gate pdrf.EDI <- function(dm, b=c(6.9544068, -0.0046634)){ p <- 1/(1+exp(-(b[1]+b[2]*dm))) return(p) } plot(pdrf.EDI(0:4000),type="l",ylab="Probability of detecting each coded burst", xlab="Distance between receiver and transmitter") ## Simulate fish passes 1 receivers ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=0, outerLim=c(667, 667), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=0, outerLim=c(667, 667), nsim=10000, showPlot=F) dp ## Simulate fish passes 2 receivers ## Check dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10, showPlot=T) ## Run dp <- receiverLineDetSim(rngFun=pdrf, recSpc=rep(800,4), outerLim=c(400, 400), nsim=10000, showPlot=F) dp