Fix for "1" spec with by (#197)

Plus loose ends from previous commit

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: emmeans
 Type: Package
 Title: Estimated Marginal Means, aka Least-Squares Means
-Version: 1.4.690003
-Date: 2020-05-17
+Version: 1.4.690004
+Date: 2020-05-19
 Authors@R: c(person("Russell", "Lenth", role = c("aut", "cre", "cph"), 
     email = "russell-lenth@uiowa.edu"),
     person("Henrik", "Singmann", role = "ctb"),

NEWS.md

@@ -8,6 +8,7 @@ emmeans 1.4.69xxxxxxxx
     methods used. (comparison arrows, for starters)
   * Touch-ups to `plot()`, especially regarding comparison arrows
   * Bug fix for `stanreg` models (#196)
+  * Fixed error in `emmeans(obj, "1", by = "something")` (#197)
 
 
 emmeans 1.4.6

R/MCMC-support.R

@@ -533,9 +533,10 @@ emm_basis.stanreg = function(object, trms, xlev, grid, mode, rescale, ...) {
     if(is.null(contr <- object$contrasts))
         contr = attr(model.matrix(object), "contrasts")
     X = model.matrix(trms, m, contrasts.arg = contr)
-    nms = colnames(X)
-    bhat = rstanarm::fixef(object)[nms]
-    V = vcov(object)[nms,nms]
+    bhat = rstanarm::fixef(object)
+    nms = intersect(colnames(X), names(bhat))
+    bhat = bhat[nms]
+    V = vcov(object)[nms, nms]
     misc = list()
     if (!is.null(object$family)) {
         if (is.character(object$family)) # work around bug for stan_polr
@@ -583,7 +584,7 @@ emm_basis.stanreg = function(object, trms, xlev, grid, mode, rescale, ...) {
     # estimability...
     nbasis = estimability::all.estble
     all.nms = colnames(X)
-    if (length(names(bhat)) < (n <- length(all.nms))) {
+    if (length(nms) < length(all.nms)) {
         coef = NA * X[1, ]
         coef[names(bhat)] = bhat
         bhat = coef

R/emmeans.R

@@ -286,6 +286,9 @@ emmeans = function(object, specs, by = NULL,
         options $tran = tran
     }
 
+    if(length(specs) > 0 && specs == "1")
+        specs = character(0)
+
     if(is.null(nesting <- object@model.info$nesting)) 
         {
         RG = object

R/ref-grid.R

@@ -526,8 +526,8 @@ ref_grid <- function(object, at, cov.reduce = mean, cov.keep = get_emm_option("c
     # we've added args `misc` and `options` so emm_basis methods can access and use these if they want
     basis = emm_basis(object, trms, xlev, grid, misc = attr(data, "misc"), options = options, ...)
     if(length(basis$bhat) != ncol(basis$X))
-        stop("Non-conformable elements in reference grid.\n",
-             " Possibly due to rank deficiency not handled as expected.",
+        stop("Something went wrong:\n",
+             " Non-conformable elements in reference grid.",
              call. = TRUE)
 
     misc = basis$misc