diff --git a/DESCRIPTION b/DESCRIPTION index 827cac06..7965755f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: visR Title: Clinical Graphs and Tables Adhering to Graphical Principles -Version: 0.2.0.9007 +Version: 0.2.0.9008 Authors@R: c( person(given = "Mark", family = "Baillie", diff --git a/NAMESPACE b/NAMESPACE index 422a305a..1161d65d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -53,7 +53,6 @@ export(get_summary) export(get_tableone) export(render) export(summarize_long) -export(summarize_short) export(tableone) export(the_lhs) export(tidyme) diff --git a/R/get_quantile.R b/R/get_quantile.R index db3880a5..8676ad50 100644 --- a/R/get_quantile.R +++ b/R/get_quantile.R @@ -1,80 +1,78 @@ #' @title Wrapper around quantile methods #' -#' @description S3 method for extracting quantiles. +#' @description S3 method for extracting quantiles. #' No default method is available at the moment. -#' +#' #' @seealso \code{\link[survival]{quantile.survfit}} -#' +#' #' @param x An object of class \code{survfit} #' @param probs probabilities Default = c(0.25,0.50,0.75) #' @inheritParams survival::quantile.survfit #' @param ... other arguments passed on to the method -#' +#' #' @examples -#' +#' #' ## Kaplan-Meier estimates #' survfit_object <- visR::estimate_KM(data = adtte, strata = c("TRTP")) -#' +#' #' ## visR quantiles #' visR::get_quantile(survfit_object) -#' +#' #' ## survival quantiles #' quantile(survfit_object) -#' +#' #' @return A data frame with quantiles of the object -#' +#' #' @rdname get_quantile -#' #' @export - +#' get_quantile <- function(x, ...){ UseMethod("get_quantile", x) -} +} #' @rdname get_quantile #' @method get_quantile survfit #' @export - get_quantile.survfit <- function(x, ..., probs = c(0.25, 0.50, 0.75), conf.int = TRUE, tolerance = sqrt(.Machine$double.eps) ) { - + # User input validation --------------------------------------------------- if (conf.int == TRUE & !base::all(c("lower", "upper") %in% names(x))) stop("Confidence limits were not part of original estimation.") - + if (!base::all(is.numeric(probs) == TRUE) | (!base::all(probs < 1))) stop("probs should be a numeric vector.") - + if (!is.numeric(tolerance)) stop("tolerance should be numeric") - + # Extract quantiles ------------------------------------------------------- - + q <- quantile( x ,probs = probs ,conf.int = conf.int ,tolerance = tolerance ,type = 3 ) - + qdf <- do.call(rbind.data.frame, q) - + strata <- as.character(unlist(lapply(q, rownames))) quantity <- unlist(lapply(strsplit(rownames(qdf), "\\.", fixed = FALSE), `[[`, 1)) - + final <- data.frame( cbind(strata, quantity, qdf) ,row.names = NULL ,check.names = FALSE ) - + final <- final[ order( final[, "strata"], final[, "quantity"] ), ] - + return(final) } diff --git a/R/get_risktable.R b/R/get_risktable.R index c28d039e..e6211972 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -30,9 +30,8 @@ #' @return return list of attributes the form the risk table i.e. #' number of patients at risk per strata #' @rdname get_risktable -#' #' @export - +#' get_risktable <- function(x, ...){ UseMethod("get_risktable") } @@ -40,7 +39,6 @@ get_risktable <- function(x, ...){ #' @rdname get_risktable #' @method get_risktable survfit #' @export - get_risktable.survfit <- function( x ,times = NULL @@ -340,5 +338,3 @@ get_risktable.tidycuminc <- function(x return(label[seq_along(statlist)]) } - - diff --git a/R/get_summary.R b/R/get_summary.R index c5a16a89..365372c4 100644 --- a/R/get_summary.R +++ b/R/get_summary.R @@ -10,14 +10,13 @@ #' @param ... other arguments passed on to the method #' #' @rdname get_summary -#' #' @export - +#' get_summary <- function(x, ...){ UseMethod("get_summary", x) } -#' @examples +#' @examples #' #' survfit_object <- survival::survfit(data = adtte, survival::Surv(AVAL, 1-CNSR) ~ TRTP) #' get_summary(survfit_object) @@ -27,7 +26,7 @@ get_summary <- function(x, ...){ #' @rdname get_summary #' @method get_summary survfit #' @export - +#' get_summary.survfit <- function(x, statlist = c("strata", "records", "events", "median", "LCL", "UCL", "CI"), ...) { diff --git a/R/get_tableone.R b/R/get_tableone.R index c5b1d97f..f8443027 100644 --- a/R/get_tableone.R +++ b/R/get_tableone.R @@ -18,7 +18,7 @@ #' #' @note All columns in the table will be summarized. If only some columns shall be used, please select only those #' variables prior to creating the summary table by using dplyr::select() - +#' #' @examples #' #' # Example using the ovarian data set @@ -67,9 +67,8 @@ #' visR::get_tableone(strata = "TRTA", overall = FALSE) #' #' @rdname get_tableone -#' #' @export - +#' get_tableone <- function(data, strata = NULL, overall=TRUE, summary_function = summarize_short){ UseMethod("get_tableone") } diff --git a/R/render.R b/R/render.R index 2cbd11d7..7645614c 100644 --- a/R/render.R +++ b/R/render.R @@ -32,7 +32,6 @@ render <- function(data, #' @inheritParams render -#' @rdname render #' @export #' @method render tableone #' @@ -125,7 +124,6 @@ render.tableone <- function( } #' @inheritParams render -#' @rdname render #' @export #' #' @method render risktable @@ -203,7 +201,6 @@ render.risktable <- function( #' @inheritParams render #' -#' @rdname render #' @method render data.frame #' @export render.data.frame <- function( @@ -325,7 +322,6 @@ render_datatable <- function(data, title, download_format, source_cap){ #' @inheritParams render_datatable #' -#' @rdname render_datatable #' @method render_datatable tableone #' render_datatable.tableone <- function(data, title, download_format, source_cap) { @@ -361,7 +357,6 @@ render_datatable.tableone <- function(data, title, download_format, source_cap) #' @inheritParams render_datatable #' -#' @rdname render_datatable #' @method render_datatable data.frame #' render_datatable.data.frame <- function(data, title, download_format, source_cap) { @@ -436,7 +431,6 @@ get_gt <- function(data, numcols){ #' @inheritParams get_gt #' -#' @rdname get_gt #' @method get_gt tableone #' get_gt.tableone <- function(data, numcols) { @@ -454,7 +448,6 @@ get_gt.tableone <- function(data, numcols) { #' @inheritParams get_gt #' -#' @rdname get_gt #' @method get_gt data.frame #' get_gt.data.frame <- function(data, numcols) { diff --git a/R/utils_pipe.R b/R/utils_pipe.R index 34787401..a680da0b 100644 --- a/R/utils_pipe.R +++ b/R/utils_pipe.R @@ -1,19 +1,15 @@ #' @title Find the "lhs" in the pipeline -#' #' @description This function finds the left-hand sided symbol in a magrittr pipe and returns it as a character. -#' #' @return Left-hand sided symbol as string in the magrittr pipe. -#' #' @references \url{https://github.com/tidyverse/magrittr/issues/115#issuecomment-173894787} #' -#' @export -#' #' @examples #' blah <- function(x) the_lhs() #' adtte %>% #' blah() - +#' @export +#' the_lhs <- function() { parents <- lapply(sys.frames(), parent.env) diff --git a/R/utils_table.R b/R/utils_table.R index 0db6da10..9d4433b0 100644 --- a/R/utils_table.R +++ b/R/utils_table.R @@ -71,7 +71,6 @@ summarize_long.default <- function(x){ #' #' @param x a vector to be summarized #' @return A summarized less detailed version of the input. -#' @export summarize_short <- function(x) UseMethod("summarize_short") #' Create variable summary for factors @@ -137,4 +136,4 @@ summarize_short.default <- function(x){ `Missing (%)` = paste0(format(sum(is.na(x))), " (", format(100 * sum(is.na(x))/length(x), trim=TRUE), "%)") ) list(dat) -} \ No newline at end of file +} diff --git a/R/utils_visr.R b/R/utils_visr.R index 4e85da35..c059d8fe 100644 --- a/R/utils_visr.R +++ b/R/utils_visr.R @@ -28,9 +28,9 @@ #' align = "none", #' nrow=2) #' } +#' #' @export - - +#' align_plots <- function(pltlist) { if (missing(pltlist) | is.null(pltlist)) { diff --git a/README.md b/README.md index 1b61c303..92f5c45c 100644 --- a/README.md +++ b/README.md @@ -13,7 +13,7 @@ coverage](https://codecov.io/gh/openpharma/visR/branch/develop/graph/badge.svg)] [![pkgdown](https://github.com/openpharma/visR/actions/workflows/makedocs.yml/badge.svg)](https://github.com/openpharma/visR/actions/workflows/makedocs.yml) [![CRAN status](https://www.r-pkg.org/badges/version/visR)](https://CRAN.R-project.org/package=visR) - + The goal of visR is to enable fit-for-purpose, reusable clinical and diff --git a/inst/WORDLIST b/inst/WORDLIST index 0e9f6ab7..07f76e72 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -26,8 +26,6 @@ RGBA RRGGBB RRGGBBAA SDTM -Surv -TRTP Tarone UCL UX @@ -41,10 +39,12 @@ colours conf coxph cran +csv ctype cuminc cumsum datasource +datatable df doi dplyr diff --git a/man/align_plots.Rd b/man/align_plots.Rd index 6ab99e96..296c9431 100644 --- a/man/align_plots.Rd +++ b/man/align_plots.Rd @@ -35,6 +35,7 @@ cowplot::plot_grid(plotlist = visR::align_plots(pltlist = list(p1, p2)), align = "none", nrow=2) } + } \references{ \url{https://stackoverflow.com/questions/26159495} diff --git a/man/get_gt.Rd b/man/get_gt.Rd index 218841b6..1208e5b5 100644 --- a/man/get_gt.Rd +++ b/man/get_gt.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/render.R \name{get_gt} \alias{get_gt} -\alias{get_gt.tableone} -\alias{get_gt.data.frame} \title{Internal function Get gt object} \usage{ get_gt(data, numcols) - -\method{get_gt}{tableone}(data, numcols) - -\method{get_gt}{data.frame}(data, numcols) } \arguments{ \item{data}{input data set} diff --git a/man/get_summary.Rd b/man/get_summary.Rd index e5c33096..98bf173d 100644 --- a/man/get_summary.Rd +++ b/man/get_summary.Rd @@ -28,7 +28,10 @@ A data frame with summary measures from a \code{survfit} object \description{ S3 method for extracting descriptive statistics across strata. No default method is available at the moment. +} +\examples{ survfit_object <- survival::survfit(data = adtte, survival::Surv(AVAL, 1-CNSR) ~ TRTP) get_summary(survfit_object) + } diff --git a/man/render.Rd b/man/render.Rd index a1c42cfe..9d2e6367 100644 --- a/man/render.Rd +++ b/man/render.Rd @@ -2,9 +2,6 @@ % Please edit documentation in R/render.R \name{render} \alias{render} -\alias{render.tableone} -\alias{render.risktable} -\alias{render.data.frame} \title{Render a data.frame, risktable, or tableone object as a table} \usage{ render( @@ -16,36 +13,6 @@ render( engine = "gt", download_format = c("copy", "csv", "excel") ) - -\method{render}{tableone}( - data, - title, - datasource, - footnote = "", - output_format = "html", - engine = "gt", - download_format = NULL -) - -\method{render}{risktable}( - data, - title, - datasource, - footnote = "", - output_format = "html", - engine = "gt", - download_format = NULL -) - -\method{render}{data.frame}( - data, - title, - datasource, - footnote = "", - output_format = "html", - engine = "gt", - download_format = c("copy", "csv", "excel") -) } \arguments{ \item{data}{Input data.frame or tibble to visualize} diff --git a/man/render_datatable.Rd b/man/render_datatable.Rd index a1f126f0..d4d7fb4c 100644 --- a/man/render_datatable.Rd +++ b/man/render_datatable.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/render.R \name{render_datatable} \alias{render_datatable} -\alias{render_datatable.tableone} -\alias{render_datatable.data.frame} \title{Experimental internal function to help render a data.frame, risktable or tableone object as a datatable} \usage{ render_datatable(data, title, download_format, source_cap) - -\method{render_datatable}{tableone}(data, title, download_format, source_cap) - -\method{render_datatable}{data.frame}(data, title, download_format, source_cap) } \arguments{ \item{data}{Input data.frame or tibble to visualize}