Skip to content

Commit

Permalink
styler + spell check (#414)
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddsjoberg
ddsjoberg authored Jun 21, 2022
1 parent a5bc3da commit 6adaac1
Show file tree
Hide file tree
Showing 78 changed files with 4,196 additions and 4,544 deletions.
25 changes: 16 additions & 9 deletions R/Surv_CNSR.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,33 +44,40 @@
#' @examples
#' # Use the `Surv_CNSR()` function with visR functions
#' adtte %>%
#' visR:: estimate_KM(formula = visR::Surv_CNSR() ~ SEX)
#' visR::estimate_KM(formula = visR::Surv_CNSR() ~ SEX)
#'
#' # Use the `Surv_CNSR()` function with functions from other packages as well
#' survival::survfit(visR::Surv_CNSR() ~ SEX, data = adtte)
#' survival::survreg(visR::Surv_CNSR() ~ SEX + AGE, data = adtte) %>%
#' broom::tidy()

Surv_CNSR <- function(AVAL, CNSR) {
# set default values if not passed by user -----------------------------------
if (missing(AVAL) && exists("AVAL", envir = rlang::caller_env()))
if (missing(AVAL) && exists("AVAL", envir = rlang::caller_env())) {
AVAL <- get("AVAL", envir = rlang::caller_env())
else if (missing(AVAL))
} else if (missing(AVAL)) {
stop("Default 'AVAL' value not found. Specify argument in `Surv_CNSR(AVAL=)`.")
if (missing(CNSR) && exists("CNSR", envir = rlang::caller_env()))
}
if (missing(CNSR) && exists("CNSR", envir = rlang::caller_env())) {
CNSR <- get("CNSR", envir = rlang::caller_env())
else if (missing(CNSR))
} else if (missing(CNSR)) {
stop("Default 'CNSR' value not found. Specify argument in `Surv_CNSR(CNSR=)`.")
}

# checking inputs ------------------------------------------------------------
if (!is.numeric(AVAL) || !is.numeric(CNSR))
if (!is.numeric(AVAL) || !is.numeric(CNSR)) {
stop("Expecting arguments 'AVAL' and 'CNSR' to be numeric.")
}

if (stats::na.omit(CNSR) %>% setdiff(c(0, 1)) %>% {!rlang::is_empty(.)})
if (stats::na.omit(CNSR) %>% setdiff(c(0, 1)) %>%
{
!rlang::is_empty(.)
}) {
stop("Expecting 'CNSR' argument to be binary with values `0/1`.")
}

if (any(AVAL < 0))
if (any(AVAL < 0)) {
warning("Values of 'AVAL' are less than zero, which is likely a data error.")
}

# pass args to `survival::Surv()` --------------------------------------------
survival::Surv(time = AVAL, event = 1 - CNSR, type = "right", origin = 0)
Expand Down
54 changes: 24 additions & 30 deletions R/add_CI.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@
#' library(visR)
#'
#' # Estimate KM curves by treatment group
#' survfit_object <- survival::survfit(data = adtte, survival::Surv(AVAL, 1-CNSR) ~ TRTP)
#' survfit_object <- survival::survfit(data = adtte, survival::Surv(AVAL, 1 - CNSR) ~ TRTP)
#'
#' ## plot without confidence intervals (CI)
#' p <- visR::visr(survfit_object)
Expand All @@ -42,7 +42,7 @@
#'
#' @export

add_CI <- function(gg, ...){
add_CI <- function(gg, ...) {
UseMethod("add_CI", gg)
}

Expand All @@ -53,64 +53,58 @@ add_CI <- function(gg, ...){
add_CI.ggsurvfit <- function(gg,
alpha = 0.1,
style = "ribbon",
linetype, ...){

if (! base::all(c("est.lower", "est.upper") %in% colnames(gg$data))) {

linetype, ...) {
if (!base::all(c("est.lower", "est.upper") %in% colnames(gg$data))) {
stop("Confidence limits were not part of original estimation.")

}

if ((alpha > 1) | (alpha < 0)) {

warning("Invalid `alpha` argument, must be between 0 and 1. Setting it to 0.1.")
alpha <- 0.1

}

if (! base::any(c("ribbon", "step") %in% style)) {

if (!base::any(c("ribbon", "step") %in% style)) {
warning("Invalid `style` argument. Setting `style` to `ribbon`.")
style <- "ribbon"

}

gg_gb <- ggplot2::ggplot_build(gg)
strata_colours <- unique(gg_gb$data[[1]]$colour)

if (style == "ribbon"){

if (style == "ribbon") {
if (!missing(linetype)) {

warning("Argument `linetype` not used for style ribbon.")

}

gg <- gg +
ggplot2::geom_ribbon(ggplot2::aes(ymin = est.lower,
ymax = est.upper),
na.rm = TRUE,
show.legend = FALSE) +
ggplot2::geom_ribbon(ggplot2::aes(
ymin = est.lower,
ymax = est.upper
),
na.rm = TRUE,
show.legend = FALSE
) +
ggplot2::scale_fill_manual(values = ggplot2::alpha(strata_colours, alpha))
}

if (style == "step"){

if (style == "step") {
if (missing(linetype)) {

# Set a default linetype of solid (2) if the user didn't specify any
linetype <- 2

}

gg <- gg +
ggplot2::geom_ribbon(ggplot2::aes(ymin = est.lower,
ymax = est.upper,
colour = strata),
outline.type = "both",
linetype = linetype,
show.legend = FALSE,
na.rm = TRUE) +
ggplot2::geom_ribbon(ggplot2::aes(
ymin = est.lower,
ymax = est.upper,
colour = strata
),
outline.type = "both",
linetype = linetype,
show.legend = FALSE,
na.rm = TRUE
) +
ggplot2::scale_fill_manual(values = ggplot2::alpha(strata_colours, 0))
}

Expand Down
41 changes: 14 additions & 27 deletions R/add_CNSR.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
#' library(visR)
#'
#' # Estimate KM curves by treatment group
#' survfit_object <- survival::survfit(data = adtte, survival::Surv(AVAL, 1-CNSR) ~ TRTP)
#' survfit_object <- survival::survfit(data = adtte, survival::Surv(AVAL, 1 - CNSR) ~ TRTP)
#'
#' ## plot without confidence intervals
#' p <- visR::visr(survfit_object)
Expand All @@ -37,72 +37,59 @@
#'
#' @export

add_CNSR <- function(gg, ...){
add_CNSR <- function(gg, ...) {
UseMethod("add_CNSR", gg)
}

#' @rdname add_CNSR
#' @method add_CNSR ggsurvfit
#' @export

add_CNSR.ggsurvfit <- function(gg, shape = 3, size = 2, ...){

add_CNSR.ggsurvfit <- function(gg, shape = 3, size = 2, ...) {
if (!base::is.numeric(size)) {

if (base::is.list(size)) {

# ggplot technically allows a list of the same length as the elements to
# be plotted. However, we don't sanity check this and let ggplot deal with
# it: https://github.com/openpharma/visR/wiki/Don't-do-this

} else {

warning("Invalid `size` specified. Setting it to 2.")
size <- 2

}

}

if (!base::is.numeric(shape)) {

if (base::is.list(shape)) {

# ggplot technically allows a list of the same length as the elements to
# be plotted. However, we don't sanity check this and let ggplot deal with
# it: https://github.com/openpharma/visR/wiki/Don't-do-this

} else if (base::is.character(shape)) {

if (base::nchar(shape) > 1) {

warning("Invalid `shape` specified. If specifiyng a symbol, it must be a single character. Setting it to 3.")
shape <- 3

}

} else if ((base::is.na(shape)) || (base::is.null(shape))) {

warning("Invalid `shape` specified. Setting it to 3.")
shape <- 3

}

} else if ((shape < 0) | (shape > 25)) {

warning("Invalid `shape` specified. Values between [0-25] are supported. Setting it to 3.")
shape <- 3

}

gg <- gg +
ggplot2::geom_point(data = base::subset(gg$data, n.censor >= 1),
ggplot2::aes(x = time,
y = est,
color = strata),
shape = shape,
size = size,
show.legend = FALSE)
ggplot2::geom_point(
data = base::subset(gg$data, n.censor >= 1),
ggplot2::aes(
x = time,
y = est,
color = strata
),
shape = shape,
size = size,
show.legend = FALSE
)

return(gg)
}
Expand Down
69 changes: 34 additions & 35 deletions R/add_annotation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,12 +38,12 @@
#' ## to the plot data area. Here we are plotting outside of the data area.
#' visR::visr(surv_object) %>%
#' visR::add_annotation(
#' label = "My simple comment",
#' base_family = "sans",
#' base_size = 15,
#' xmin = 210,
#' xmax = 380,
#' ymin = 1.0
#' label = "My simple comment",
#' base_family = "sans",
#' base_size = 15,
#' xmin = 210,
#' xmax = 380,
#' ymin = 1.0
#' )
#'
#'
Expand All @@ -53,8 +53,9 @@
#'
#' ## we calculate p-values for "Equality across strata"
#' lbl <- visR::get_pvalue(surv_object,
#' statlist = c("test", "pvalue"),
#' type = "All")
#' statlist = c("test", "pvalue"),
#' type = "All"
#' )
#'
#' ## display p-values
#' lbl
Expand All @@ -74,68 +75,66 @@
#'
#' @export

add_annotation <- function(
gg = NULL,
label = NULL,
base_family = "sans",
base_size = 11,
xmin = -Inf,
xmax = Inf,
ymin = -Inf,
ymax = Inf
){
add_annotation <- function(gg = NULL,
label = NULL,
base_family = "sans",
base_size = 11,
xmin = -Inf,
xmax = Inf,
ymin = -Inf,
ymax = Inf) {

# User input validation ---------------------------------------------------
# User input validation ---------------------------------------------------

if (!base::inherits(gg, "ggplot")) stop("Error in add_annotation: gg is not of class `ggplot`")
if (is.null(label)) stop("Error in add_annotation: label does not exist")
if (!base_family %in% c("sans", "serif", "mono")) stop("Error in add_annotation: Specified font not supported")
if (!base::any(unlist(lapply(as.list(c(xmin, xmax, ymin, ymax, base_size)), is.numeric)))) stop("Error in add_annotation: One of the coordinates are not numeric.")

# ggtable -----------------------------------------------------------------
# ggtable -----------------------------------------------------------------

if (base::inherits(label, "gtable")) {

gganno <- gg +
ggplot2::annotation_custom(label, xmin = xmin, ymin = ymin, xmax = xmax, ymax = ymax)


### Add individual components
components <- append(list(gg), label) # Note: The append changes the structure of the gtable object
names(components) = c("visR_plot", names(label))
components <- append(list(gg), label) # Note: The append changes the structure of the gtable object
names(components) <- c("visR_plot", names(label))
gganno[["components"]] <- components

return (gganno)

return(gganno)
} else {

### Prepare label: turn into dataframe and avoid factors + add manual bolding to avoid parsing issues with `` in colnames

df <- data.frame(lapply(label, as.character), stringsAsFactors = FALSE, check.names = FALSE) #as.character to protect leading zero in numeric
df <- data.frame(lapply(label, as.character), stringsAsFactors = FALSE, check.names = FALSE) # as.character to protect leading zero in numeric

colnames(df) <- as.vector(paste(paste0("bold(\"", colnames(df), "\")")))

### Layout of gtable: access and modify options eg tt1$colhead
## First column to left, rest rightaligned
## First column to left, rest rightaligned

core_alignment_matrix <- matrix(rep(0, nrow(df)*dim(df)[2]), nrow = nrow(df), ncol = dim(df)[2])
if (dim(core_alignment_matrix)[2] > 1) {core_alignment_matrix[,2:dim(core_alignment_matrix)[2]] <- 1}
core_alignment_matrix <- matrix(rep(0, nrow(df) * dim(df)[2]), nrow = nrow(df), ncol = dim(df)[2])
if (dim(core_alignment_matrix)[2] > 1) {
core_alignment_matrix[, 2:dim(core_alignment_matrix)[2]] <- 1
}
core_alignment_head <- rep(1, dim(core_alignment_matrix)[2])
core_alignment_head[1] <- 0

tt1 <- gridExtra::ttheme_minimal(
tt1 <- gridExtra::ttheme_minimal(
base_size = base_size,
base_family = base_family,
core=list(
fg_params=list(
core = list(
fg_params = list(
hjust = as.vector(core_alignment_matrix),
x = as.vector(core_alignment_matrix),
fontface = "plain"
)
),
colhead = list(
fg_params = list(
hjust = core_alignment_head,
hjust = core_alignment_head,
x = core_alignment_head,
fontface = 2,
parse = TRUE
Expand All @@ -155,8 +154,8 @@ add_annotation <- function(

### Add individual components

components <- append(list(gg), dfGrob) # Note: The append changes the structure of the tableGrob object
names(components) = c("visR_plot", names(dfGrob))
components <- append(list(gg), dfGrob) # Note: The append changes the structure of the tableGrob object
names(components) <- c("visR_plot", names(dfGrob))
gganno[["components"]] <- components

return(gganno)
Expand Down
Loading

0 comments on commit 6adaac1

Please sign in to comment.