Add methods for filler contrasts

Author: mmrabe

NAMESPACE

@@ -15,6 +15,7 @@ export(contr.hypothesis)
 export(eqs2cmat)
 export(eqs2hmat)
 export(filler_contrasts)
+export(filler_names)
 export(ginv2)
 export(has_intercept)
 export(hmat)
@@ -24,10 +25,12 @@ export(hypr)
 export(is_centered)
 export(is_intercept)
 export(remove_intercept)
+export(target_names)
 export(thmat)
 export(which_centered)
 export(which_filler)
 export(which_intercept)
+export(which_target)
 exportMethods("&")
 exportMethods("*")
 exportMethods("+")

R/hypr.R

@@ -1183,9 +1183,39 @@ filler_contrasts <- function(x, how.many = nlevels(x), rescale = TRUE) {
 #' @describeIn filler_contrasts Return indices of filler contrasts
 #' @export
 which_filler <- function(x) {
-  if(!inherits(x, "hypr")) stop("`x` must be a hypr object!")
-  if(!is.null(attr(x@cmat, "which_fillers"))) return(attr(x@cmat, "which_fillers"))
-  integer(0)
+  if(inherits(x, "hypr") || inherits(x, "hypr_cmat")) {
+    cm <- if(inherits(x, "hypr")) cmat(x, add_intercept = FALSE, remove_intercept = FALSE) else x
+    if(!is.null(attr(cm, "which_fillers"))) return(attr(cm, "which_fillers"))
+    integer(0)
+  } else stop("`x` must be a hypr object or hypr cmat!")
+}
+
+#' @describeIn filler_contrasts Return indices of filler contrasts
+#' @export
+which_target <- function(x) {
+  if(inherits(x, "hypr") || inherits(x, "hypr_cmat")) {
+    cm <- if(inherits(x, "hypr")) cmat(x, add_intercept = FALSE, remove_intercept = FALSE) else x
+    setdiff(seq_len(ncol(cm)), which_filler(cm))
+  } else stop("`x` must be a hypr object or hypr cmat!")
+}
+
+
+#' @describeIn filler_contrasts Return names of filler contrasts
+#' @export
+filler_names <- function(x) {
+  if(inherits(x, "hypr") || inherits(x, "hypr_cmat")) {
+    cm <- if(inherits(x, "hypr")) cmat(x, add_intercept = FALSE, remove_intercept = FALSE) else x
+    colnames(cm)[which_filler(cm)]
+  } else stop("`x` must be a hypr object or hypr cmat!")
+}
+
+#' @describeIn filler_contrasts Return names of target contrasts
+#' @export
+target_names <- function(x) {
+  if(inherits(x, "hypr") || inherits(x, "hypr_cmat")) {
+    cm <- if(inherits(x, "hypr")) cmat(x, add_intercept = FALSE, remove_intercept = FALSE) else x
+    colnames(cm)[-which_filler(cm)]
+  } else stop("`x` must be a hypr object or hypr cmat!")
 }