Commit aba70072 authored by Facundo Muñoz's avatar Facundo Muñoz ®️
Browse files

Competitiveness: use residual fertility rather than sterile fertility.

Fix #1.
parent cf6588ff
Pipeline #46556 passed with stages
in 14 minutes and 42 seconds
......@@ -2,7 +2,7 @@ Package: sit
Type: Package
Title: Analyse Mark-Release-Recapture Data from Sterile Insect
Technique (SIT) Field Experiments
Version: 1.1.2.9001
Version: 1.1.2.9002
Authors@R: c(person("Françoise", "Chirara", email =
"francoise.chirara@cirad.fr", role = c("ctb"), comment = "Logo
designer"), person("Facundo", "Muñoz", email =
......
......@@ -18,7 +18,7 @@
#' always be included in the results with a value of `NA` in `pop_col`.
#' @param following_days Integer or missing (default). Number of days after
#' releases to return, if `following_releases` is not missing.
#' @param sterile_fertility Numeric. Default: 0.05.
#' @param residual_fertility Numeric. Default: 0.05.
#' @param species Character. Filter results for a given species or ignore the
#' species if missing.
#'
......@@ -31,7 +31,7 @@ sit_competitiveness <- function(
x,
following_releases = sit_revents(x, type = "areal"),
following_days = 7,
sterile_fertility = 0.01,
residual_fertility = 0.01,
species = NULL
) {
......@@ -90,10 +90,10 @@ sit_competitiveness <- function(
sit_fertility <- fertility_rate(egg_areal, pool = TRUE)
res <- fried_index(
sterile_wild_mr = swmr,
natural_fertility = natural_fertility,
sit_fertility = sit_fertility,
sterile_fertility = sterile_fertility
sterile_wild_mr = swmr,
natural_fertility = natural_fertility,
sit_fertility = sit_fertility,
residual_fertility = residual_fertility
)
comp_table <- data.frame(
......@@ -101,7 +101,7 @@ sit_competitiveness <- function(
"Sterile-wild mortaility ratio", "Natural fertility",
"Observed fertility in SIT area", "Sterile fertility (assumed)"
),
Value = c(swmr, natural_fertility, sit_fertility, sterile_fertility)
Value = c(swmr, natural_fertility, sit_fertility, residual_fertility)
)
ans <- structure(res, components = comp_table, class = 'sit_competitiveness')
......@@ -159,7 +159,7 @@ print.sit_competitiveness <- function(x, digits = 2, ...) {
#' in a natural (wild) population.
#' @param sit_fertility Number between 0 and 1. Proportion of fertile eggs
#' in the target population.
#' @param sterile_fertility Number between 0 and 1. Proportion of fertile eggs
#' @param residual_fertility Number between 0 and 1. Proportion of fertile eggs
#' in a completely sterile population. Also called _residual_ fertility.
#'
#' @return Non-negative number.
......@@ -170,13 +170,13 @@ print.sit_competitiveness <- function(x, digits = 2, ...) {
#' sterile_wild_mr = 0.3,
#' natural_fertility = .9,
#' sit_fertility = .71,
#' sterile_fertility = .05
#' residual_fertility = .05
#' )
fried_index <- function(
sterile_wild_mr,
natural_fertility,
sit_fertility,
sterile_fertility
residual_fertility
) {
if (!any(sterile_wild_mr > 0)) {
......@@ -185,7 +185,7 @@ fried_index <- function(
)
}
if (any(sit_fertility == sterile_fertility, na.rm = TRUE)) {
if (any(sit_fertility == residual_fertility, na.rm = TRUE)) {
stop(
"Cannot estimate competitiveness when the estimated fertility equals",
" the sterile fertility."
......@@ -193,7 +193,7 @@ fried_index <- function(
}
(natural_fertility - sit_fertility) /
(sit_fertility - sterile_fertility) /
(sit_fertility - residual_fertility) /
sterile_wild_mr
}
......
......@@ -8,7 +8,7 @@ fried_index(
sterile_wild_mr,
natural_fertility,
sit_fertility,
sterile_fertility
residual_fertility
)
}
\arguments{
......@@ -21,7 +21,7 @@ in a natural (wild) population.}
\item{sit_fertility}{Number between 0 and 1. Proportion of fertile eggs
in the target population.}
\item{sterile_fertility}{Number between 0 and 1. Proportion of fertile eggs
\item{residual_fertility}{Number between 0 and 1. Proportion of fertile eggs
in a completely sterile population. Also called \emph{residual} fertility.}
}
\value{
......@@ -60,6 +60,6 @@ fried_index(
sterile_wild_mr = 0.3,
natural_fertility = .9,
sit_fertility = .71,
sterile_fertility = .05
residual_fertility = .05
)
}
......@@ -8,7 +8,7 @@ sit_competitiveness(
x,
following_releases = sit_revents(x, type = "areal"),
following_days = 7,
sterile_fertility = 0.05,
residual_fertility = 0.01,
species = NULL
)
}
......@@ -24,7 +24,7 @@ always be included in the results with a value of \code{NA} in \code{pop_col}.}
\item{following_days}{Integer or missing (default). Number of days after
releases to return, if \code{following_releases} is not missing.}
\item{sterile_fertility}{Numeric. Default: 0.05.}
\item{residual_fertility}{Numeric. Default: 0.05.}
\item{species}{Character. Filter results for a given species or ignore the
species if missing.}
......
......@@ -9,7 +9,7 @@ test_that("fried_index works as expected", {
sterile_wild_mr = 1,
natural_fertility = nf_vals,
sit_fertility = nf_vals / 2,
sterile_fertility = 0
residual_fertility = 0
) == 1
)
)
......@@ -22,7 +22,7 @@ test_that("fried_index works as expected", {
sterile_wild_mr = 1,
natural_fertility = nf_vals,
sit_fertility = nf_vals,
sterile_fertility = 0
residual_fertility = 0
) == 0
)
)
......@@ -37,7 +37,7 @@ test_that("fried_index works as expected", {
sterile_wild_mr = 1,
natural_fertility = nf_vals,
sit_fertility = .1,
sterile_fertility = .1
residual_fertility = .1
), "Cannot estimate"
)
......@@ -50,7 +50,7 @@ test_that("Fried index is robust agains some NaNs", {
sterile_wild_mr = rep(1, 3),
natural_fertility = c(.8, NA, .85),
sit_fertility = c(.2, NaN, .3),
sterile_fertility = c(0, Inf, .1)
residual_fertility = c(0, Inf, .1)
),
NA
)
......
......@@ -22,13 +22,13 @@ test_that("Retreiving results from sit_prototype works without failing", {
),
NA
)
expect_error(sit_competitiveness(sit_prototype, sterile_fertility = 0.05), NA)
expect_error(sit_competitiveness(sit_prototype, residual_fertility = 0.05), NA)
expect_error(
sit_competitiveness(
sit_prototype,
following_releases = sit_revents(sit_prototype, type = "areal")[1,],
following_days = 10,
sterile_fertility = 0.05
residual_fertility = 0.05
),
NA
)
......
......@@ -272,7 +272,7 @@ This requires the estimation of:
```{r compet-default}
sit_competitiveness(sit_prototype, sterile_fertility = 0.05)
sit_competitiveness(sit_prototype, residual_fertility = 0.05)
```
If there were more than one areal release, we could compute the estimated
......@@ -285,7 +285,7 @@ sit_competitiveness(
sit_prototype,
following_releases = sit_revents(sit_prototype, type = "areal")[1,],
following_days = 10,
sterile_fertility = 0.05
residual_fertility = 0.05
)
```
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment