transform.setpars.parameter <- function(min.exposure, max.exposure,
pmin, pmax, improvement)
#-----------------------------------------------------
# description:
# The function transforms the user defined parameter
# (they describe the detection function in a "user
# friendly" way)) into the parameter that are really
# used inside the detection function.
#
# author: M. Erdelmeier
#-----------------------------------------------------
#-----------------------------------------------------
# input/output-variables: #-----------------------------------------------------
# name | type | I/O | description
#---------------------------------------------------------------------
# improvement | real | I | improvement in detection (per occasion
# | | | at minimum effort and mean exposure)
# max.exposure | real | I | value of maximum exposure
# min.exposure | real | I | value of minimum exposure
# pmax | real | I | expected proportion of detected groups
# | | | at first occasion, maximum exposure and
# | | | minimum effort
# pmin | real | I | expected proportion of detected groups
# | | | at first occasion, minimum exposure and
# | | | minimum effort
#-----------------------------------------------------
# used objects
#-----------------------------------------------------
# name | type | R/W | description
#---------------------------------------------------------------------
#-----------------------------------------------------
# local variables
#-----------------------------------------------------
# name | type | description
#-----------------------------------------------------------------
# mean.exposure | real | 0.5*(min.exposure + max.exposure)
# theta0 | real | calculated parameter of detection function
# theha1 | real | calculated parameter of detection function
# theta2 | real | calculated parameter of detection function
#-------------------------------------------------------
# programming part
#-------------------------------------------------------
{
# calculate theta1 (from detection function)
if (min.exposure != max.exposure)
theta1 <- (log(1 - pmin)-log(1 - pmax))/
(max.exposure - min.exposure)
if (min.exposure == max.exposure)
# no increase in probability caused by exposure values
# (because exposure boundaries are identically)
theta1 <- 0
# calculate theha0 (from detection function)
theta0 <- (-1) * theta1 * min.exposure - log(1 - pmin)
# now calculate theta2 (from detection function),
# use mean of exposure boundaries
# (problems like NAs may be caused by non sensible
# parameter configuration)
mean.exposure <- (min.exposure + max.exposure)/2
theta2 <- (-1) * log((1 + improvement) *
exp((-1) * (theta0+theta1*mean.exposure)) - improvement) /
(theta0 + theta1*mean.exposure) - 1
# test if valid data could be generated by given parameters
if (is.na(theta0) | is.na(theta1) | is.na(theta2))
stop("\nThe given parameters lead to invalid values.\n")
if ((theta0==Inf) | (theta1==Inf) | (theta2==Inf))
stop("\nThe given parameters lead to invalid values.\n")
# generate return value
theta <- list(zero=theta0, one=theta1, two=theta2)
return(theta)
}
#===========================================================
# detection.removalmethods
#===========================================================
detection.removalmethods <- function(theta0, theta1, theta2,
exposure, effort)
#-----------------------------------------------------
# description:
# This function is used by every removal method
# because its functionality is similar for each
# method.
# It constructs a matrix with the dimensions
# "animal groups" and "number of search occasions"
# It calculates the detection probability of each
# animal group in each survey occasion.
# This function depends (aside of some parameters)
# of the exposure of each group, the survey effort
# and the survey time (survey event):
#
# P(detect | exposure, effort, occasions) =
# 1-exp[-(th0+th1*expos)*effort*(1+th2*(occasion.number-1))]
#
# !!! (occasion number are reduced by one because this leads to
# !!! some simplifications, e.g. in the parameter setup
# !!! of theta0, theta1 or theta2 in the user interface)
#
# author: M. Erdelmeier
#-----------------------------------------------------
#-----------------------------------------------------
# input/output-variables: #-----------------------------------------------------
# name | type | I/O | description
#---------------------------------------------------------------------
# effort | vector | I | search effort of each occasion
# | of real | |
# exposure | vector | I | exposure value of each group
# | of real | |
# p.detect | array | O | matrix with the detection probability
# | of real | | of each group in each survey
# theta0 | real | I | parameter of detection function
# | | | (belongs to exposure)
# theta1 | real | I | parameter of detection function
# | | | (belongs to exposure)
# theta2 | real | I | parameter of detection function
# | | | (belongs to survey occasion)
#-----------------------------------------------------
# used objects
#-----------------------------------------------------
# name | type | R/W | description
#---------------------------------------------------------------------
#-----------------------------------------------------
# local variables
#-----------------------------------------------------
# name | type | description
#-----------------------------------------------------------------
# n.groups | vector | number of animal groups
# | of int |
# n.occ | int | number of survey occasions
# occasions| vector | vector of survey occasions:
# | of int | 1,...,n.occ
# x1 | array | temporary variable
# | of real |
# x2 | array | temporary variable
# | of real |
# x3 | array | temporary variable
# | of real |
#-------------------------------------------------------
# programming part
#-------------------------------------------------------
{
## YYY delete later !!!
# theta0 <- 0.1
# theta1 <- 0.2
# theta2 <- 0.3
# exposure <- c(1,2,3)
# effort <- c(5,4,3,2,1)
## get important data
n.groups <- length(exposure)
n.occ <- length(effort)
## vector of occasion numbers
occasions <- 1:n.occ
## calculate the detection probability for each group in
## each survey (depends on exposure of the group, the
## survey effort and the survey time respective number):
## p=1-exp[-(th0+th1*expos)*effort*(1+th2*(occasion.number-1))]
## !!! (occasion number are reduced by one because this leads to
## !!! some simplifications, e.g. in the parameter setup
## !!! of theta0, theta1 or theta2 in the user interface)
x1 <- rep(theta0 + theta1*exposure, n.occ)
x1 <- matrix(x1, ncol=n.occ)
x2 <- effort*(1 + theta2*(occasions-1))
x2 <- rep(x2, rep(n.groups, n.occ))
x2 <- matrix(x2, ncol=n.occ)
x3 <- (-1)*x1*x2
p.detect <- 1 - exp(x3)
## return the matrix with the detection probabilities
return(p.detect)
}
#===========================================================
# detection.capture.recapture
#===========================================================
detection.capture.recapture <- function(theta0, theta1, theta2,
exposure, effort)
#-----------------------------------------------------
# description:
# This function is used by every capture-recapture
# method because its functionality is similar for
# each method.
# It constructs a matrix with the dimensions
# "animal groups" and "number of search occasions"
# It calculates the detection probability of each
# animal group in each survey occasion.
# This function depends (aside of some parameters)
# of the exposure of each group, the survey effort
# and the survey time (survey event):
#
# P(detect | exposure, effort, occasions) =
# 1 - exp[-(th0+th1*expos)*effort*(1+th2*(occasion.number-1))]
#
# !!! (occasion number are reduced by one because this leads
# !!! to simplifications, e.g. in the parameter setup
# !!! of theta0, theta1 or theta2 in the user interface)
#
# author: M. Erdelmeier
#-----------------------------------------------------
#-----------------------------------------------------
# input/output-variables: #-----------------------------------------------------
# name | type | I/O | description
#---------------------------------------------------------------------
# exposure | vector | I | exposure value of each group
# | of real | |
# p.detect | array | O | matrix with the detection probability
# | of real | | of each group in each survey
# effort | vector | I | search effort of each occasion
# | of real | |
# theta0 | real | I | parameter of detection function
# | | | (belongs to exposure)
# theta1 | real | I | parameter of detection function
# | | | (belongs to exposure)
# theta2 | real | I | parameter of detection function
# | | | (belongs to survey occasion)
#-----------------------------------------------------
# used objects
#-----------------------------------------------------
# name | type | R/W | description
#---------------------------------------------------------------------
#-----------------------------------------------------
# local variables
#-----------------------------------------------------
# name | type | description
#-----------------------------------------------------------------
# n.groups | vector | number of animal groups
# | of int |
# n.occ | int | number of survey occasions
# occasions| vector | vector of survey occasions:
# | of int | 1,...,n.occ
# x1 | array | temporary variable
# | of real |
# x2 | array | temporary variable
# | of real |
# x3 | array | temporary variable
# | of real |
#-------------------------------------------------------
# programming part
#-------------------------------------------------------
{
## get important data
n.groups <- length(exposure)
n.occ <- length(effort)
## vector of occasion numbers
occasions <- 1:n.occ
## calculate the detection probability for each group in
## each survey (depends on exposure of the group, the
## survey effort and the survey time respective number):
## p=1-exp[-(th0+th1*expos)*effort*(1+th2*(occasion.number-1))]
## !!! (occasion number are reduced by one because this leads
## !!! to simplifications, e.g. in the parameter setup
## !!! of theta0, theta1 or theta2 in the user interface)
x1 <- rep(theta0 + theta1*exposure, n.occ)
x1 <- matrix(x1, ncol=n.occ)
x2 <- effort*(1 + theta2*(occasions-1))
x2 <- rep(x2, rep(n.groups, n.occ))
x2 <- matrix(x2, ncol=n.occ)
x3 <- (-1)*x1*x2
p.detect <- 1 - exp(x3)
## return the matrix with the detection probabilities
return(p.detect)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.