Add log-likelihood draws to output of submodel_test_statistics

R/select_submodels.R

@@ -12,7 +12,7 @@
 #' function selects the model, after which the selected information criterion increases
 #' for the first time.
 #' @param teststats optional. A named list of test statistics for each model in `object`. Usually,
-#' the result of a call to \code{\link{submodel_test_statistics}}.
+#' the result of a call to \code{\link{submodel_test_statistics}[["teststats"]]}.
 #' 
 #' @examples
 #' # Load data
@@ -93,13 +93,25 @@ select_submodels <- function(object, ic = "BIC", select = "order", teststats = N
     criteria <- submodel_test_statistics(object)[["teststats"]]
   } else {
     # Basic checks
+    if (!"data.frame" %in% class(teststats)) {
+      stop("If provided, argument 'teststats' must be of class data.frame.")
+    }
     if (length(teststats) != length(unique(names(object)))) {
       stop("Number of countries in argument 'object' differs from number of countries in argument 'teststats'.")
     }
-    criteria <- teststats[["teststats"]]
+    criteria <- teststats
   }
+
   names_object <- names(object)
 
+  crit <- list()
+  ctry <- unique(names(object))
+  for (i in 1:length(ctry)) {
+    crit[[i]] <- criteria[criteria[, "ctry"] == ctry[i],]
+  }
+  names(crit) <- ctry
+  criteria <- crit
+
   # Select final country models
   result <- NULL
   for (i in 1:length(criteria)) {

R/submodel_test_statistics.R

@@ -245,10 +245,11 @@ submodel_test_statistics <- function(object, ...){
   result <- NULL
   ctry_names <- unique(teststats[, "ctry"])
   for (i in 1:length(ctry_names)) {
-    result[[i]][["teststats"]] <- teststats[teststats[, "ctry"] == ctry_names[i], -1]
-    rownames(result[[i]][["teststats"]]) <- NULL
+    result[[i]] <- teststats[teststats[, "ctry"] == ctry_names[i], -1]
+    rownames(result[[i]]) <- NULL
     names(result)[i] <- ctry_names[i]
   }
+  names(loglik) <- teststats[, "ctry"]
 
   result <- list(teststats = teststats,
                  loglik = loglik)