Merge pull request #102 from adibender/devel

Maintainance update
adibender · Apr 17, 2019 · 1724497 · 1724497
2 parents 35d0273 + 1eacb01
commit 1724497
Show file tree

Hide file tree

Showing 10 changed files with 42 additions and 110 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: pammtools
 Title: Piece-Wise Exponential Additive Mixed Modeling Tools
 Version: 0.1.11
-Date: 2019-03-28
+Date: 2019-04-17
 Authors@R: c(
     person("Andreas", "Bender", , "[email protected]", role = c("aut", "cre"), comment=c(ORCID = "0000-0001-5628-8611")),
     person("Fabian", "Scheipl", , "[email protected]", role = c("aut")))

diff --git a/NAMESPACE b/NAMESPACE
@@ -5,8 +5,6 @@ S3method(arrange,ped)
 S3method(as_ped,data.frame)
 S3method(as_ped,list)
 S3method(as_ped,nested_fdf)
-S3method(distinct_,nested_fdf)
-S3method(distinct_,ped)
 S3method(fill,nested_fdf)
 S3method(fill,ped)
 S3method(filter,nested_fdf)
@@ -25,7 +23,6 @@ S3method(gg_laglead,nested_fdf)
 S3method(gg_smooth,default)
 S3method(group_by,nested_fdf)
 S3method(group_by,ped)
-S3method(group_by_,nested_fdf)
 S3method(group_by_,ped)
 S3method(inner_join,nested_fdf)
 S3method(inner_join,ped)
@@ -43,8 +40,6 @@ S3method(nest_tdc,default)
 S3method(nest_tdc,list)
 S3method(rename,nested_fdf)
 S3method(rename,ped)
-S3method(rename_,nested_fdf)
-S3method(rename_,ped)
 S3method(right_join,nested_fdf)
 S3method(right_join,ped)
 S3method(sample_frac,nested_fdf)
@@ -56,8 +51,6 @@ S3method(sample_n,nested_fdf)
 S3method(sample_n,ped)
 S3method(select,nested_fdf)
 S3method(select,ped)
-S3method(select_,nested_fdf)
-S3method(select_,ped)
 S3method(slice,nested_fdf)
 S3method(slice,ped)
 S3method(summarise,nested_fdf)
@@ -85,7 +78,6 @@ export(arrange)
 export(as_ped)
 export(combine_df)
 export(cumulative)
-export(distinct_)
 export(fcumu)
 export(fill)
 export(filter)
@@ -121,14 +113,12 @@ export(mutate)
 export(nest_tdc)
 export(ped_info)
 export(rename)
-export(rename_)
 export(right_join)
 export(riskset_info)
 export(sample_frac)
 export(sample_info)
 export(sample_n)
 export(select)
-export(select_)
 export(seq_range)
 export(sim_pexp)
 export(slice)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,13 @@
+# pammtools 0.1.11
+
+## bugs
+* fixes bug in **`dplyr`** reverse dependency (see #101)
+* fixes bug in tidiers for Aalen models (see #99)
+
+## documentation
+* Better documentation and functionality for `make_newdata`
+* Added new vignette linking to tutorial paper (online only)
+
 # pammtools 0.1.9
 * maintainance update: fixes CRAN issues due to new RNG
 
@@ -26,7 +36,7 @@
 * Updates homepage (via pkgdown)
 
 
-# pamtools 0.1.3
+# pammtools 0.1.3
 
 ## Minor changes
 

diff --git a/R/cumulative-coefficient.R b/R/cumulative-coefficient.R
@@ -128,10 +128,14 @@ cumu_coef <- function(data, model, term, ...) {
 #' @inherit get_cumu_coef
 #' @keywords internal
 get_cumu_coef_baseline <- function(data, model, ...) {
+
+  vars_modify <- colnames(data)[map_lgl(data, is.numeric)] %>%
+    setdiff(c("tstart", "tend", "intlen", "intmid"))
+
   data %>%
     mutate_at(
-      .vars = vars(-one_of(c("tstart", "tend", "intlen", "intmid", "interval"))),
-      .funs = ~0) %>%
+      .vars = vars(one_of(vars_modify)),
+      .funs = ~c(0)) %>%
     add_cumu_hazard(model) %>%
     mutate(
       method      = class(model)[1],

diff --git a/R/tidyverse-methods.R b/R/tidyverse-methods.R
@@ -79,13 +79,6 @@ ungroup.ped <- function(x, ...) {
 #-------------------------------------------------------------------------------
 # single table: row ops
 
-#' @export
-#' @export distinct_
-#' @rdname dplyr_verbs
-distinct_.ped <- function(.data, ..., .dots = list()) {
-  reped(distinct_(unped(.data), ..., .dots = .dots))
-}
-
 #' @export
 #' @export filter
 #' @rdname dplyr_verbs
@@ -128,13 +121,6 @@ select.ped <- function(.data, ...) {
   reped(select(unped(.data), ...))
 }
 
-#' @export
-#' @export select_
-#' @rdname dplyr_verbs
-select_.ped <- function(.data, ..., .dots = list()) {
-  reped(select_(unped(.data), ..., .dots = .dots))
-}
-
 #' @param keep_attributes conserve attributes? defaults to \code{TRUE}
 #' @export
 #' @export mutate
@@ -157,13 +143,6 @@ rename.ped <- function(.data, ...) {
   reped(rename(unped(.data), ...))
 }
 
-#' @export
-#' @export rename_
-#' @rdname dplyr_verbs
-rename_.ped <- function(.data, ..., .dots = list()) {
-  reped(rename_(unped(.data), ..., .dots = .dots))
-}
-
 #' @export
 #' @export summarise
 #' @rdname dplyr_verbs
@@ -275,21 +254,6 @@ fill.ped <- function(data, ..., .direction=c("down", "up"), keep_attributes=TRUE
 
 }
 
-# #' @inheritParams tidyr::fill_
-# #' @export fill_
-# #' @export
-# #' @rdname tidyr_verbs
-# fill_.ped <- function(data, fill_cols, .direction=c("down", "up")) {
-
-#   data_attr   <- ped_attr(data)
-#   tbl <- reped(fill_(unped(data), fill_cols, .direction))
-#   attributes(tbl) <- c(attributes(tbl), data_attr)
-
-#   return(tbl)
-
-# }
-
-
 #' @importFrom purrr discard
 un_nested_df <- function(nested_fdf) {
   class(nested_fdf) <- class(nested_fdf) %>% discard(~.=="nested_fdf")
@@ -322,14 +286,6 @@ group_by.nested_fdf <- function(.data, ..., add = FALSE) {
   re_nested_df(group_by(un_nested_df(.data), ..., add = add))
 }
 
-#' @inheritParams dplyr::group_by_
-#' @export
-#' @export group_by_
-#' @rdname dplyr_verbs
-group_by_.nested_fdf <- function(.data, ..., .dots = list(), add = FALSE) {
-  re_nested_df(group_by_(un_nested_df(.data), ..., .dots = .dots, add = add))
-}
-
 #' @export
 #' @export ungroup
 #' @rdname dplyr_verbs
@@ -340,13 +296,6 @@ ungroup.nested_fdf <- function(x, ...) {
 #-------------------------------------------------------------------------------
 # single table: row ops
 
-#' @export
-#' @export distinct_
-#' @rdname dplyr_verbs
-distinct_.nested_fdf <- function(.data, ..., .dots = list()) {
-  re_nested_df(distinct_(un_nested_df(.data), ..., .dots = .dots))
-}
-
 #' @export
 #' @export filter
 #' @rdname dplyr_verbs
@@ -389,12 +338,6 @@ select.nested_fdf <- function(.data, ...) {
   re_nested_df(select(un_nested_df(.data), ...))
 }
 
-#' @export
-#' @export select_
-#' @rdname dplyr_verbs
-select_.nested_fdf <- function(.data, ..., .dots = list()) {
-  re_nested_df(select_(un_nested_df(.data), ..., .dots = .dots))
-}
 
 #' @param keep_attributes conserve attributes? defaults to \code{TRUE}
 #' @export
@@ -418,12 +361,6 @@ rename.nested_fdf <- function(.data, ...) {
   re_nested_df(rename(un_nested_df(.data), ...))
 }
 
-#' @export
-#' @export rename_
-#' @rdname dplyr_verbs
-rename_.nested_fdf <- function(.data, ..., .dots = list()) {
-  re_nested_df(rename_(un_nested_df(.data), ..., .dots = .dots))
-}
 
 #' @export
 #' @export summarise
@@ -515,11 +452,15 @@ right_join.nested_fdf <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x"
 #' @export fill
 #' @rdname tidyr_verbs
 #' @keywords internal
-fill.nested_fdf <- function(data, ..., .direction=c("down", "up"), keep_attributes=TRUE) {
+fill.nested_fdf <- function(
+  data,
+  ...,
+  .direction = c("down", "up"),
+  keep_attributes = TRUE) {
   if (keep_attributes) {
     data_attr   <- nested_fdf_attr(data)
   }
-  tbl <- re_nested_df(fill(un_nested_df(data), ..., .direction=.direction))
+  tbl <- re_nested_df(fill(un_nested_df(data), ..., .direction = .direction))
   if (keep_attributes) {
     attributes(tbl) <- c(attributes(tbl), data_attr)
   }

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -18,9 +18,6 @@ reference:
       - int_info
       - ped_info
       - make_newdata
-      - gg_slice
-      - gg_partial
-      - get_cumu_eff
   - title: "Extract information from PAMMs"
     desc: "Functions that help extract information from fitted model objects,
     e.g., smooth effects for plotting"
@@ -44,6 +41,7 @@ reference:
       - gg_smooth
       - gg_tensor
       - gg_re
+      - gg_slice
       - gg_partial
       - gg_partial_ll
       - gg_laglead

diff --git a/cran-comments.md b/cran-comments.md
@@ -1,14 +1,15 @@
 ## Test environments
 * R release and devel with Travis CI
-* R 3.5.2 patched with appveyor
-* win-builder (devel and release)
+* R 3.5.3 patched with AppVeyor
+* win-builder (R version 3.6.0 beta (2019-04-16 r76403))
+* win-builder
 * R-hub
 
 ## R CMD check results
 
 0 errors | 0 warnings | 0 notes
 
-* maintainance update: fixes CRAN issues due to new RNG
+* Fixes dplyr reverse dependency bug + documentation updates
 
 ## Reverse dependencies
 

diff --git a/man/dplyr_verbs.Rd b/man/dplyr_verbs.Rd
diff --git a/tests/testthat/test-cumulative-coefficients.R b/tests/testthat/test-cumulative-coefficients.R
@@ -17,10 +17,18 @@ test_that("Cumulative coefficients work", {
 
   ## pam
   ped <- as_ped(df, formula = Surv(days, status)~ x1 + age)
-  pam <- mgcv::gam(ped_status ~ x1 + age, data = ped, family = poisson(),
-    offset = offset)
+  pam <- mgcv::gam(ped_status ~ s(tend) + x1 + age, data = ped,
+    family = poisson(), offset = offset)
   cumu_coef_pam <- get_cumu_coef(pam, ped, terms = c("age", "x1"), nsim = 20L)
   expect_data_frame(cumu_coef_pam, nrows = 36L, ncols = 6L)
   expect_equal(unique(cumu_coef_pam$variable), c("age", "x1 (b)", "x1 (c)"))
+  cumu_coef_pam <- get_cumu_coef(pam, ped, terms = c("(Intercept)", "age"))
+  expect_data_frame(cumu_coef_pam, nrows = 24L, ncols = 6L)
+  # ggplot(
+  #   filter(cc2, variable == "(Intercept)"),
+  #   aes(x = time, y = cumu_hazard)) +
+  # geom_step() +
+  # geom_step(data = filter(cumu_coef_aalen, variable == "(Intercept)"), col = 2)
+
 
 })