Merge pull request #61 from SoerenPannier/bug/archiving_mumin

Bug/archiving mumin

DESCRIPTION

@@ -34,12 +34,11 @@ URL: https://github.com/SoerenPannier/emdi
 LazyData: true
 Encoding: UTF-8
 Copyright: inst/COPYRIGHTS
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Imports:
     nlme,
     moments,
     ggplot2,
-    MuMIn,
     gridExtra,
     openxlsx,
     reshape2,

NAMESPACE

@@ -133,7 +133,6 @@ export(write.excel)
 export(write.ods)
 importFrom(HLMdiag,mdffits)
 importFrom(MASS,ginv)
-importFrom(MuMIn,r.squaredGLMM)
 importFrom(boot,boot)
 importFrom(formula.tools,"lhs<-")
 importFrom(formula.tools,lhs)

NEWS.md

@@ -1,3 +1,8 @@
+# emdi 2.2.2
+* Addition of logit transformation in FH model 
+* Removal of MuMIn dependency
+
+
 # emdi 2.2.1
 * Substitution of maptools and rgeos by sf due to depreciation of the former
 * Substitution of ggplot2::fortify by ggplot2::geom_sf due to depreciation of the former

R/summary.direct.R

@@ -1,10 +1,7 @@
 # Summarizes an emdi Direct Object
 
 #' @export
-#' @importFrom moments skewness kurtosis
-#' @importFrom MuMIn r.squaredGLMM
 #' @rdname emdi_summaries
-
 summary.direct <- function(object, ...) {
   throw_class_error(object, "direct")
 

R/summary.ebp.R

@@ -2,7 +2,6 @@
 
 #' @export
 #' @importFrom moments skewness kurtosis
-#' @importFrom MuMIn r.squaredGLMM
 #' @rdname emdi_summaries
 
 summary.ebp <- function(object, ...) {
@@ -105,7 +104,7 @@ summary.ebp <- function(object, ...) {
   )
   tempMod <- object$model
   tempMod$call$fixed <- object$fixed
-  r_squared <- suppressWarnings(r.squaredGLMM(tempMod))
+  r_squared <-lme_rsquared(tempMod)
   if (is.matrix(r_squared)) {
     r_marginal <- r_squared[1, 1]
     r_conditional <- r_squared[1, 2]
@@ -188,3 +187,41 @@ icc <- function(model) {
   e <- model$sigma^2
   u / (u + e)
 }
+
+# Conditional and marginal R square
+# Code for conditional and marginal R square is an adapted copy from the MuMIn R Package Version: 1.47.5 under the GPL-2 License
+
+lme_rsquared <- function(x) {
+
+  VarFx <- var(fitted(x, level = 0L))
+  mmRE <- model.matrix(x$modelStruct$reStruct,
+                       data = x$data[rownames(x$fitted), ,
+                                     drop = FALSE])
+  n <- nrow(mmRE)
+  sigma2 <- x$sigma^2
+  reStruct <- x$modelStruct$reStruct
+  if ((m <- length(reStruct)) > 1L) {
+    nams <- names(reStruct)
+    for (i in seq.int(m)) attr(reStruct[[i]], "Dimnames")[[2L]] <- paste(nams[[i]],
+                                                                         attr(reStruct[[i]], "Dimnames")[[2L]], sep = ".")
+  }
+  varRe <- sum(vapply(reStruct, function(z) {
+    sig <- nlme::pdMatrix(z) * sigma2
+    mm1 <- mmRE[, rownames(sig), drop = FALSE]
+    sum(matmultdiag(mm1 %*% sig, ty = mm1)) / n
+  }, FUN.VALUE = numeric(1)))
+  varTot <- sum(VarFx, varRe)
+  res <- c(VarFx, varTot)/(varTot + sigma2)
+  names(res) <- c("R2m", "R2c")
+
+  return(res)
+}
+
+matmultdiag <- function (x, y, ty = t(y))
+{
+  if (ncol(x) != ncol(ty))
+    stop("non-conformable arguments")
+  if (nrow(x) != nrow(ty))
+    stop("result is not a square matrix")
+  return(rowSums(x * ty))
+}

R/summary.emdi.R

@@ -21,8 +21,7 @@
 #' R2 from generalized linear mixed-effects models. Methods in Ecology and
 #' Evolution, 4(2), 133-142.
 #' @seealso \code{\link{emdiObject}}, \code{\link{direct}}, \code{\link{ebp}},
-#' \code{\link{fh}}, \code{\link[MuMIn]{r.squaredGLMM}},
-#' \code{\link[moments]{skewness}},
+#' \code{\link{fh}}, \code{\link[moments]{skewness}},
 #' \code{\link[moments]{kurtosis}}, \code{\link[stats]{shapiro.test}}
 #' @examples
 #' \donttest{

R/summary.fh.R

@@ -2,7 +2,6 @@
 
 #' @export
 #' @importFrom moments skewness kurtosis
-#' @importFrom MuMIn r.squaredGLMM
 #' @rdname emdi_summaries
 
 summary.fh <- function(object, ...) {