Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

styler + spell check #414

Merged
merged 1 commit into from
Jun 21, 2022
Merged

styler + spell check #414

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 16 additions & 9 deletions R/Surv_CNSR.R
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Open in desktop
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