Use summary.rq in quantreg tidiers, and return tibbles. Closes #373. (#…

…376)

R/nls_tidiers.R

@@ -8,7 +8,7 @@
 #' @param data original data this was fitted on; if not given this will
 #' attempt to be reconstructed from nls (may not be successful)
 #'
-#' @return All tidying methods return a `data.frame` without rownames.
+#' @return All tidying methods return a `tibble` without rownames.
 #' The structure depends on the method chosen.
 #'
 #' @template augment_NAs
@@ -60,7 +60,7 @@ tidy.nls <- function(x, conf.int = FALSE, conf.level = .95,
       term = names(co), estimate = unname(co),
       stringsAsFactors = FALSE
     )
-    return(ret)
+    return(tibble::as_tibble(ret))
   }
 
   nn <- c("estimate", "std.error", "statistic", "p.value")
@@ -75,7 +75,7 @@ tidy.nls <- function(x, conf.int = FALSE, conf.level = .95,
     colnames(CI) <- c("conf.low", "conf.high")
     ret <- cbind(ret, unrowname(CI))
   }
-  ret
+  tibble::as_tibble(ret)
 }
 
 
@@ -97,7 +97,7 @@ augment.nls <- function(x, data = NULL, newdata = NULL, ...) {
     # use predictions on new data
     newdata <- fix_data_frame(newdata, newcol = ".rownames")
     newdata$.fitted <- stats::predict(x, newdata = newdata)
-    return(newdata)
+    return(tibble::as_tibble(newdata))
   }
 
   if (is.null(data)) {
@@ -113,14 +113,14 @@ augment.nls <- function(x, data = NULL, newdata = NULL, ...) {
     # }
   }
 
-  return(augment_columns(x, data))
+  return(tibble::as_tibble(augment_columns(x, data)))
 
   # move rownames if necessary
   data <- fix_data_frame(data, newcol = ".rownames")
 
   data$.fitted <- stats::predict(x)
   data$.resid <- stats::resid(x)
-  data
+  tibble::as_tibble(data)
 }
 
 
@@ -145,5 +145,5 @@ glance.nls <- function(x, ...) {
     sigma = s$sigma, isConv = s$convInfo$isConv,
     finTol = s$convInfo$finTol
   ))
-  finish_glance(ret, x)
+  tibble::as_tibble(finish_glance(ret, x))
 }

R/rq_tidiers.R

@@ -30,13 +30,13 @@ NULL
 #' If `se.type != 'rank'` and `conf.int = TRUE`, confidence intervals 
 #' are standard t based intervals.
 #'
-#' @return `tidy.rq` returns a data frame with one row for each coefficient.
+#' @return `tidy.rq` returns a tibble with one row for each coefficient.
 #' The columns depend upon the confidence interval method selected.
 #'
 #' @export
-tidy.rq <- function(x, se.type = "rank", conf.int = TRUE, conf.level = 0.95, alpha = 1 - conf.level, ...) {
+tidy.rq <- function(x, se.type = "rank", conf.int = TRUE, conf.level = 0.9, alpha = 1 - conf.level, ...) {
   # summary.rq often issues warnings when computing standard errors
-  rq_summary <- suppressWarnings(summary(x, se = se.type, alpha = alpha, ...))
+  rq_summary <- suppressWarnings(quantreg::summary.rq(x, se = se.type, alpha = alpha, ...))
   process_rq(rq_obj = rq_summary, se.type = se.type, conf.int = conf.int, conf.level = conf.level, ...)
 }
 
@@ -47,9 +47,9 @@ tidy.rq <- function(x, se.type = "rank", conf.int = TRUE, conf.level = 0.95, alp
 #' method selected.
 #'
 #' @export
-tidy.rqs <- function(x, se.type = "rank", conf.int = TRUE, conf.level = 0.95, alpha = 1 - conf.level, ...) {
+tidy.rqs <- function(x, se.type = "rank", conf.int = TRUE, conf.level = 0.9, alpha = 1 - conf.level, ...) {
   # summary.rq often issues warnings when computing standard errors
-  rq_summary <- suppressWarnings(summary(x, se = se.type, alpha = alpha, ...))
+  rq_summary <- suppressWarnings(quantreg::summary.rqs(x, se = se.type, alpha = alpha, ...))
   plyr::ldply(rq_summary, process_rq, se.type = se.type, conf.int = conf.int, conf.level = conf.level, ...)
 }
 
@@ -75,7 +75,7 @@ tidy.nlrq <- function(x, conf.int = FALSE, conf.level = 0.95, ...) {
     ret[["conf.low"]] <- ret[["estimate"]] + (cv[1] * ret[["std.error"]])
     ret[["conf.high"]] <- ret[["estimate"]] + (cv[2] * ret[["std.error"]])
   }
-  ret
+  tibble::as_tibble(ret)
 }
 
 #' @rdname rq_tidiers
@@ -100,7 +100,7 @@ glance.rq <- function(x, ...) {
   n <- length(fitted(x))
   s <- summary(x)
 
-  data.frame(
+  tibble::tibble(
     tau = x[["tau"]],
     logLik = logLik(x),
     AIC = AIC(x),
@@ -131,7 +131,7 @@ glance.rqs <- function(x, ...) {
 glance.nlrq <- function(x, ...) {
   n <- length(x[["m"]]$fitted())
   s <- summary(x)
-  data.frame(
+  tibble::tibble(
     tau = x[["m"]]$tau(),
     logLik = logLik(x),
     AIC = AIC(x),
@@ -215,15 +215,16 @@ augment.rqs <- function(x, data = model.frame(x), newdata, ...) {
     pred <- setNames(as.data.frame(pred), x[["tau"]])
     # pred <- reshape2::melt(pred,measure.vars = 1:ncol(pred),variable.name = ".tau",value.name = ".fitted")
     pred <- tidyr::gather(data = pred, key = ".tau", value = ".fitted")
-    return(unrowname(cbind(original, pred[, -1, drop = FALSE])))
+    ret <- unrowname(cbind(original, pred[, -1, drop = FALSE]))
   } else {
     original <- newdata[rep(seq_len(nrow(newdata)), n_tau), ]
     pred <- predict(x, newdata = newdata, stepfun = FALSE, ...)
     pred <- setNames(as.data.frame(pred), x[["tau"]])
     # pred <- reshape2::melt(pred,measure.vars = 1:ncol(pred),variable.name = ".tau",value.name = ".fitted")
     pred <- tidyr::gather(data = pred, key = ".tau", value = ".fitted")
-    return(unrowname(cbind(original, pred)))
+    ret <- unrowname(cbind(original, pred))
   }
+  tibble::as_tibble(ret)
 }
 
 #' @rdname rq_tidiers
@@ -273,5 +274,5 @@ process_rq <- function(rq_obj, se.type = "rank",
     co[["conf.high"]] <- co[["estimate"]] + (cv[2] * co[["std.error"]])
   }
   co[["tau"]] <- rq_obj[["tau"]]
-  fix_data_frame(co, colnames(co))
+  tibble::as_tibble(fix_data_frame(co, colnames(co)))
 }