Nothing
#' Summary of a rpt object
#'
#'
#' @param object An rpt object returned from one of the rpt functions
#' @param \dots Additional arguments; none are used in this method.
#'
#' @references
#' Nakagawa, S. and Schielzeth, H. (2010) \emph{Repeatability for Gaussian and
#' non-Gaussian data: a practical guide for biologists}. Biological Reviews 85: 935-956
#'
#' @author Holger Schielzeth (holger.schielzeth@@uni-jena.de),
#' Shinichi Nakagawa (s.nakagawa@unsw.edu.au),
#' Martin Stoffel (martin.adam.stoffel@@gmail.com)
#'
#' @keywords models
#'
#' @export
#'
#'
#'
#'
#'
summary.rpt <- function(object, ...) {
# helper functions for
CI <- object$CI
calc_CI <- function(x) {
out <- stats::quantile(x, c((1 - CI)/2, 1 - (1 - CI)/2), na.rm = TRUE)
out
}
extr_comps <- function(x) {
CI <- calc_CI(x)
out <- data.frame("N" = length(x), "Mean" = mean(x), "Median" = stats::median(x),
calc_CI(x)[[1]], calc_CI(x)[[2]])
names(out)[4:5] <- names(calc_CI(x))
out
}
if(object$datatype=="Gaussian") {
for(i in 1:length(object$R)) {
if (any(is.na(object$CI_emp))) {
CI_1 <- NA
CI_2 <- NA
} else {
CI_1 <- as.numeric(object$CI_emp[i, 1])
CI_2 <- as.numeric(object$CI_emp[i, 2])
}
if (any(!is.na(object$se))) {
SE <- unlist(object$se)[[i]]
} else {
SE <- NA
}
if (any(!is.na(object$R_boot))) {
RBOOT <- object$R_boot[[i]]
} else {
RBOOT <- NA
}
object$rpt[[i]] <- structure(data.frame(object$R[i], SE, CI_1, CI_2,
unname(object$P[i, 2]), round(unname(object$P[i, 1]), 3)),
names = c("R", "SE", names(object$CI_emp)[1], names(object$CI_emp)[2],
names(object$P)[2], names(object$P)[1]),
row.names = "rpt")
bootperm <- structure(data.frame(do.call(rbind, lapply(list(RBOOT, object$R_permut[[i]]), extr_comps))),
row.names = c("boot", "permut"), names = c("N", "Mean", "Median", names(object$CI_emp)))
object$boot[[i]] <- bootperm[1, ]
object$permut[[i]] <- bootperm[2, ]
}
class(object) <- "summary.rpt"
return(object)
}
if(object$datatype=="Poisson" | object$datatype=="Binary" | object$datatype=="Proportion") {
# warning("Not yet implemented")
# cat("\n", "Repeatability calculation using the glmm method", "\n\n")
boot <- list(object$R_boot_org, object$R_boot_link)
perm <- list(object$R_permut_org, object$R_permut_link)
for(i in 1:ncol(object$R)) {
object$rpt[[i]] <- structure(data.frame(R = object$R[[i]], object$se[[i]],
do.call(rbind, lapply(object$CI_emp, function(x) x[i, ])),
t(object$P[i, c("P_permut_org", "P_permut_link")])),
names = c("R", "SE", names(calc_CI(object$R_boot_org[[1]])), "P_permut"),
row.names = c("Org", "Link"))
object$boot[[i]] <- structure(do.call(rbind,
lapply(boot, function(x) extr_comps(x[[i]]))),
row.names = c("Org", "Link"))
object$permut[[i]] <- structure(cbind(
do.call(rbind, lapply(perm, function(x) extr_comps(x[[i]]))),
t(object$P[i, c("P_permut_org", "P_permut_link")])),
row.names = c("Org", "Link"))
names(object$permut[[i]])[6] <- "P_permut"
}
class(object) <- "summary.rpt"
return(object)
}
}
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.