Add muhaz tidiers

DESCRIPTION

@@ -19,8 +19,7 @@ Authors@R: c(
     person("Jens", "Preussner", email = " jens.preussner@mpi-bn.mpg.de", role = "ctb"),
     person("Jay", "Hesselberth", email = "jay.hesselberth@gmail.com", role = "ctb"),
     person("Hadley", "Wickham", email = "hadley@rstudio.com", role = "ctb"),
-    person("Matthew", "Lincoln", email = "matthew.d.lincoln@gmail.com", role = "ctb")
-    )
+    person("Matthew", "Lincoln", email = "matthew.d.lincoln@gmail.com", role = "ctb"))
 Maintainer: David Robinson <admiral.david@gmail.com>
 Description: Convert statistical analysis objects from R into tidy data frames,
     so that they can more easily be combined, reshaped and otherwise processed
@@ -90,6 +89,7 @@ Suggests:
     robust,
     akima,
     AER,
+    muhaz,
     speedlm,
     speedglm,
     randomForest

NAMESPACE

@@ -61,6 +61,7 @@ S3method(glance,lmodel2)
 S3method(glance,matrix)
 S3method(glance,merMod)
 S3method(glance,mlm)
+S3method(glance,muhaz)
 S3method(glance,multinom)
 S3method(glance,nlrq)
 S3method(glance,nls)
@@ -150,6 +151,7 @@ S3method(tidy,map)
 S3method(tidy,matrix)
 S3method(tidy,merMod)
 S3method(tidy,mle2)
+S3method(tidy,muhaz)
 S3method(tidy,multinom)
 S3method(tidy,nlrq)
 S3method(tidy,nls)

R/muhaz_tidiers.R

@@ -0,0 +1,54 @@
+#' Tidying methods for kernel based hazard rate estimates
+#'
+#' These methods tidy the output of \code{muhaz} objects as returned by the
+#' \code{\link[muhaz]{muhaz}} function, which provides kernel based
+#' non-parametric hazard rate estimators.
+#'
+#' The "augment" method is not useful and therefore not
+#' available for \code{muhaz} objects.
+#'
+#' @param x \code{muhaz} object
+#'
+#' @template boilerplate
+#'
+#' @return \code{tidy.muhaz} returns a tibble containing two columns:
+#' \code{time} at which the hazard rate was estimated and \code{estimate}.
+#'
+#' @name muhaz_tidiers
+#'
+#' @examples
+#' if (require("muhaz", quietly = TRUE)) {
+#'   data(ovarian, package="survival")
+#'   x <- muhaz(ovarian$futime, ovarian$fustat)
+#'   tidy(x)
+#'   glance(x)
+#' }
+#'
+#' @export
+tidy.muhaz <- function(x, ...) {
+
+  bind_cols(x[c("est.grid", "haz.est")]) %>%
+    rename("time"="est.grid", "estimate"="haz.est")
+
+}
+
+#' @rdname muhaz_tidiers
+#'
+#' @param ... extra arguments (not used)
+#'
+#' @return \code{glance.muhaz} returns a one-row data.frame with the columns
+#'   \item{nobs}{Number of observations used for estimation}
+#'   \item{min.time}{The minimum observed event or censoring time}
+#'   \item{max.time}{The maximum observed event or censoring time}
+#'   \item{min.harzard}{Minimal estimated hazard}
+#'   \item{max.hazard}{Maximal estimated hazard}
+#'
+#' @export
+glance.muhaz <- function(x, ...) {
+
+  bind_cols(x$pin[c("nobs", "min.time", "max.time")]) %>%
+    mutate(
+      min.hazard = min(x$haz.est),
+      max.hazard = max(x$haz.est))
+
+}

tests/testthat/test-muhaz.R

@@ -0,0 +1,11 @@
+if (requireNamespace("muhaz")) {
+    context("Kernel based hazard rate estimates via muhaz")
+    data(ovarian, package = "survival")
+    mz <- muhaz::muhaz(ovarian$futime, ovarian$fustat)
+    test_that("tidy works on muhaz objects", {
+        tidy(mz)
+    })
+    test_that("glance works on muhaz objects", {
+        glance(mz)
+    })
+}