Nothing
#' @title Calculation of the number of daily on- and off-bouts
#' @description Calculation of number and duration of incubation
#' on- and off-bouts.
#' @param data data frame containing a time-series vector of 1's and 0's, where "1"
#' means "incubating individual inside nest" and "0" means "incubating individual
#' outside nest". This vector,
#' under the name of "inc.vector", is provided by \code{\link{incRscan}} in the
#' first object of the returned list. A column named "date" is needed to refer to daily
#' calculations.
#' @param vector.incubation name of the column (vector class) storing the
#' information about the presence/absence of the incubating individual in the nest.
#' @param dec_time (character class) name of the column with decimal time.
#' @param temp (character class) name of the column with incubation temperatures.
#' @param sampling.rate time difference between two consecutive recording points.
#' Effectively, the rate at which data points were recorded
#' (e.g. 1 data point per 50sec).
#' The time units of the returned object will depend on the units of this argument.
#' @return
#' This function returns a list with two objects. The first object, named \code{total_bouts}, is a list of
#' individual on- and off-bouts, giving information about their start time, duration, start nest temperature and
#' final nest temperature. The second object, \code{day_bouts}, provides a summary of on-
#' and off-bouts per day of observation. This second table shows number and mean duration of on- and off-bout
#' per day. Mean times are shown in those time units you specify the argument \emph{sampling.rate}.
#' @author Pablo Capilla-Lasheras
#' @examples
#' #' # loading example data
#' data(incR_procdata)
#' incRbouts (data=incR_procdata,
#' vector.incubation="incR_score",
#' dec_time="dec_time",
#' temp="temperature",
#' sampling.rate=240) # sampling rate in seconds.
#' @seealso \code{\link{incRprep}} \code{\link{incRscan}} \code{\link{incRact}}
#' \code{\link{incRatt}}
#' @export
incRbouts <- function (data, vector.incubation, dec_time, temp, sampling.rate) {
##### CHECKING FOR COLUMN NAMES #####
if (base::is.null(data$date)){
stop("No column for 'date")
}
# splitting df by day
df01 <- base::split (data, data$date)
# defining table to write results in
data.days <- base::data.frame (date=base::rep(NA, length=base::length(df01)),
number.on.bouts=base::rep(NA, length=base::length(df01)),
number.off.bouts=base::rep(NA, length=base::length(df01)),
mean.time.on.bout=base::rep(NA, length=base::length(df01)),
mean.time.off.bout=base::rep(NA, length=base::length(df01)))
# loop to fill table of results
## if only 2 days
#if (base::length(df01)==2){
# final.loop <- 2
#} else { ## if more than 2 days...
# final.loop <- base::length(df01)-1}
# bout specific data table
list.bouts <- base::as.list(NA)
for (k in 1:length(df01)) {
df00 <- df01[[k]]
# per day data
rle_incR_score_values <- base::rle(df00[[vector.incubation]])$values
rle_incR_score_length <- base::rle(df00[[vector.incubation]])$lengths
# data frame to store results
# defining table to write results in
data.bouts <- base::data.frame (date=base::rep(NA, length=base::length(rle_incR_score_values)),
type=base::rep(NA, length=base::length(rle_incR_score_values)),
start_time=base::rep(NA, length=base::length(rle_incR_score_values)),
duration=base::rep(NA, length=base::length(rle_incR_score_values)),
start_temp=base::rep(NA, length=base::length(rle_incR_score_values)),
final_temp=base::rep(NA, length=base::length(rle_incR_score_values)))
data.bouts$date <- base::as.character(base::unique (df00$date)) # working date
data.bouts$type <- base::ifelse(rle_incR_score_values == 1, "onbout", "offbout")
# metrics per bout
to_merge <- base::do.call(args = base::lapply(base::as.list(base::c(1:base::length(rle_incR_score_values))),
function(bout){
if(base::eval(bout) == 1){
start_time <- base::round(df00[[dec_time]][1], digits = 3)
duration <- rle_incR_score_length[bout] * sampling.rate
start_temp <- df00[[temp]][1]
final_temp <- df00[[temp]][base::sum(base::rle(df00[[vector.incubation]])$lengths[1:bout])]
} else {
start_time <- base::round(df00[[dec_time]][base::sum(base::rle(df00[[vector.incubation]])$lengths[1:(bout-1)])+1],
digits = 3)
duration <- rle_incR_score_length[bout] * sampling.rate
start_temp <- df00[[temp]][base::sum(base::rle(df00[[vector.incubation]])$lengths[1:(bout-1)])+1]
final_temp <- df00[[temp]][base::sum(base::rle(df00[[vector.incubation]])$lengths[1:bout])]
}
return(base::c(start_time, duration, start_temp, final_temp))
}),
what = "rbind")
data.bouts[,c(3:6)] <- to_merge
list.bouts[[k]] <- data.bouts
}
# day specific data table
# for each day
for (k in 1:length(df01)){#1:final.loop) {
# selecting working day
df00 <- df01[[k]]
data.days$date[k] <- base::as.character(base::unique (df00$date)) # working date
# per day data
rle_incR_score_values <- base::rle(df00[[vector.incubation]])$values
rle_incR_score_length <- base::rle(df00[[vector.incubation]])$lengths
data.days$number.off.bouts[k] <- base::length(rle_incR_score_values[rle_incR_score_values == 0])
data.days$number.on.bouts[k] <- base::length(rle_incR_score_values[rle_incR_score_values == 1])
data.days$mean.time.on.bout[k] <- base::mean(rle_incR_score_length[rle_incR_score_values == 1]) * sampling.rate
data.days$mean.time.off.bout[k] <- base::mean(rle_incR_score_length[rle_incR_score_values == 0]) * sampling.rate
}
# output
return(base::list(total_bouts = base::do.call(args = list.bouts, what = "rbind"),
day_bouts = data.days))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.