mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
Merge branch 'dynamic-plots'
This commit is contained in:
commit
dbf819c55a
34 changed files with 1158 additions and 613 deletions
|
|
@ -1,6 +1,6 @@
|
|||
Package: FreesearchR
|
||||
Title: Easy data analysis for clinicians
|
||||
Version: 26.4.2
|
||||
Version: 26.6.1
|
||||
Authors@R: c(
|
||||
person("Andreas Gammelgaard", "Damsbo",email="agdamsbo@clin.au.dk", role = c("aut", "cre"),
|
||||
comment = c(ORCID = "0000-0002-7559-1154")),
|
||||
|
|
@ -118,6 +118,7 @@ Collate:
|
|||
'launch_FreesearchR.R'
|
||||
'missings-module.R'
|
||||
'plot-download-module.R'
|
||||
'plot-helpers.R'
|
||||
'plot_bar.R'
|
||||
'plot_box.R'
|
||||
'plot_euler.R'
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ export(append_column)
|
|||
export(append_list)
|
||||
export(apply_labels)
|
||||
export(argsstring2list)
|
||||
export(available_plots)
|
||||
export(baseline_table)
|
||||
export(class_icons)
|
||||
export(clean_common_axis)
|
||||
|
|
@ -64,6 +65,7 @@ export(format_writer)
|
|||
export(generate_colors)
|
||||
export(get_data_packages)
|
||||
export(get_fun_options)
|
||||
export(get_input_params)
|
||||
export(get_label)
|
||||
export(get_list_elements)
|
||||
export(get_plot_options)
|
||||
|
|
|
|||
4
NEWS.md
4
NEWS.md
|
|
@ -1,3 +1,7 @@
|
|||
# FreesearchR 26.6.1
|
||||
|
||||
*NEW* The visuals module has been restructured to allow for more advanced inputs, which will be added in the future. Basically a more future proof design allowing for more adjustments, while striving to keep the simplicity. Have fun!
|
||||
|
||||
# FreesearchR 26.4.2
|
||||
|
||||
Bug fixes and revised color choices.
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
app_version <- function()'26.4.2'
|
||||
app_version <- function()'26.6.1'
|
||||
|
|
|
|||
697
R/data_plots.R
697
R/data_plots.R
|
|
@ -14,12 +14,23 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
|
|||
list(
|
||||
bslib::layout_sidebar(
|
||||
sidebar = bslib::sidebar(
|
||||
shiny::actionButton(
|
||||
inputId = ns("act_plot"),
|
||||
label = i18n$t("Plot"),
|
||||
width = "100%",
|
||||
icon = phosphoricons::ph("paint-brush", weight = "bold"),
|
||||
# icon = shiny::icon("palette"),
|
||||
disabled = FALSE
|
||||
),
|
||||
shiny::helpText(
|
||||
i18n$t('Adjust plot input and settings below, then press "Plot".')
|
||||
),
|
||||
bslib::accordion(
|
||||
id = "acc_plot",
|
||||
multiple = FALSE,
|
||||
bslib::accordion_panel(
|
||||
value = "acc_pan_plot",
|
||||
title = "Create plot",
|
||||
title = i18n$t("Define plot"),
|
||||
icon = phosphoricons::ph("chart-line"),
|
||||
# icon = bsicons::bs_icon("graph-up"),
|
||||
shiny::uiOutput(outputId = ns("primary")),
|
||||
|
|
@ -30,19 +41,16 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
|
|||
),
|
||||
shiny::tags$br(),
|
||||
shiny::uiOutput(outputId = ns("type")),
|
||||
shiny::h5(i18n$t("Other variables")),
|
||||
shiny::uiOutput(outputId = ns("secondary")),
|
||||
shiny::uiOutput(outputId = ns("tertiary")),
|
||||
shiny::uiOutput(outputId = ns("color_palette")),
|
||||
shiny::br(),
|
||||
shiny::actionButton(
|
||||
inputId = ns("act_plot"),
|
||||
label = i18n$t("Plot"),
|
||||
width = "100%",
|
||||
icon = phosphoricons::ph("paint-brush",weight = "bold"),
|
||||
# icon = shiny::icon("palette"),
|
||||
disabled = FALSE
|
||||
shiny::uiOutput(outputId = ns("tertiary"))
|
||||
),
|
||||
shiny::helpText(i18n$t('Adjust settings, then press "Plot".'))
|
||||
bslib::accordion_panel(
|
||||
value = "acc_pan_params",
|
||||
title = i18n$t("Settings"),
|
||||
icon = phosphoricons::ph("gear"),
|
||||
shiny::uiOutput(outputId = ns("color_palette")),
|
||||
shiny::uiOutput(outputId = ns("basic_parameters")),
|
||||
),
|
||||
bslib::accordion_panel(
|
||||
value = "acc_pan_download",
|
||||
|
|
@ -95,14 +103,14 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
|
|||
shiny::p(
|
||||
"We have collected a few notes on visualising data and details on the options included in FreesearchR:",
|
||||
shiny::tags$a(
|
||||
href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
|
||||
href = "https://freesearchr.github.io/FreesearchR-knowledge/app/visuals.html",
|
||||
"View notes in new tab",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
)
|
||||
)
|
||||
),
|
||||
shiny::plotOutput(ns("plot"), height = "70vh"),
|
||||
shiny::plotOutput(ns("plot"), height = "65vh"),
|
||||
shiny::tags$br(),
|
||||
shiny::tags$br(),
|
||||
shiny::htmlOutput(outputId = ns("code_plot"))
|
||||
|
|
@ -119,10 +127,7 @@ data_visuals_ui <- function(id, tab_title = "Plots", ...) {
|
|||
#' @name data-plots
|
||||
#' @returns shiny server module
|
||||
#' @export
|
||||
data_visuals_server <- function(id,
|
||||
data,
|
||||
palettes,
|
||||
...) {
|
||||
data_visuals_server <- function(id, data, palettes = color_choices(), ...) {
|
||||
shiny::moduleServer(
|
||||
id = id,
|
||||
module = function(input, output, session) {
|
||||
|
|
@ -174,69 +179,99 @@ data_visuals_server <- function(id,
|
|||
plot_data <- data()[input$primary]
|
||||
}
|
||||
|
||||
plots <- possible_plots(data = plot_data)
|
||||
plots <- possible_plots(data = plot_data, source_list = available_plots())
|
||||
|
||||
plots_named <- get_plot_options(plots) |>
|
||||
plots_named <- get_input_params(plots) |>
|
||||
lapply(\(.x) {
|
||||
stats::setNames(.x$descr, .x$note)
|
||||
})
|
||||
|
||||
# plots_named <- get_plot_options(plots) |>
|
||||
# lapply(\(.x) {
|
||||
# stats::setNames(.x$descr, .x$note)
|
||||
# })
|
||||
|
||||
vectorSelectInput(
|
||||
inputId = ns("type"),
|
||||
selected = NULL,
|
||||
label = shiny::h4(i18n$t("Plot type")),
|
||||
label = shiny::h5(i18n$t("Plot type")),
|
||||
choices = Reduce(c, plots_named),
|
||||
multiple = FALSE
|
||||
)
|
||||
})
|
||||
|
||||
rv$plot.params <- shiny::reactive({
|
||||
get_plot_options(input$type) |> purrr::pluck(1)
|
||||
get_input_params(input$type) |> purrr::pluck(1)
|
||||
# get_plot_options(input$type) |> purrr::pluck(1)
|
||||
})
|
||||
|
||||
|
||||
### Include two additional variable inputs
|
||||
output$secondary <- shiny::renderUI({
|
||||
shiny::req(input$type)
|
||||
|
||||
cols <- c(rv$plot.params()[["secondary.extra"]], all_but(colnames(
|
||||
subset_types(data(), rv$plot.params()[["secondary.type"]])
|
||||
), input$primary))
|
||||
# Get the plot function name
|
||||
base_params <- rv$plot.params()[["base"]]
|
||||
|
||||
columnSelectInput(
|
||||
inputId = ns("secondary"),
|
||||
data = data,
|
||||
selected = cols[1],
|
||||
placeholder = i18n$t("Please select"),
|
||||
label = if (isTRUE(rv$plot.params()[["secondary.multi"]]))
|
||||
i18n$t("Additional variables")
|
||||
else
|
||||
i18n$t("Secondary variable"),
|
||||
multiple = rv$plot.params()[["secondary.multi"]],
|
||||
maxItems = rv$plot.params()[["secondary.max"]],
|
||||
col_subset = cols,
|
||||
none_label = i18n$t("No variable")
|
||||
filtered_params <- base_params[sapply(base_params, function(params) {
|
||||
params$id %in% "secondary"
|
||||
})][[1]]
|
||||
|
||||
filtered_params$exclude <- input$primary
|
||||
|
||||
create_input_element(
|
||||
input_id = "secondary",
|
||||
ns = ns,
|
||||
params = append_list(data(), filtered_params, "data")
|
||||
)
|
||||
|
||||
})
|
||||
|
||||
output$tertiary <- shiny::renderUI({
|
||||
shiny::req(input$type)
|
||||
columnSelectInput(
|
||||
inputId = ns("tertiary"),
|
||||
data = data,
|
||||
placeholder = i18n$t("Please select"),
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE,
|
||||
col_subset = c(
|
||||
"none",
|
||||
all_but(
|
||||
colnames(subset_types(data(), rv$plot.params()[["tertiary.type"]])),
|
||||
input$primary,
|
||||
input$secondary
|
||||
)
|
||||
),
|
||||
none_label = i18n$t("No stratification")
|
||||
# Get the plot function name
|
||||
base_params <- rv$plot.params()[["base"]]
|
||||
|
||||
filtered_params <- base_params[sapply(base_params, function(params) {
|
||||
params$id %in% "tertiary"
|
||||
})][[1]]
|
||||
|
||||
filtered_params$exclude <- c(input$primary, input$secondary)
|
||||
|
||||
create_input_element(
|
||||
input_id = "tertiary",
|
||||
ns = ns,
|
||||
params = append_list(data(), filtered_params, "data")
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
### Generating additional parameter inputs if any specified
|
||||
output$basic_parameters <- renderUI({
|
||||
req(input$type, rv$plot.params)
|
||||
|
||||
# Get the plot function name
|
||||
base_params <- rv$plot.params()[["base"]]
|
||||
|
||||
filtered_params <- base_params[sapply(base_params, function(params) {
|
||||
!params$id %in% c("secondary", "tertiary")
|
||||
})]
|
||||
|
||||
|
||||
# Create UI elements for base parameters
|
||||
base_inputs <- lapply(filtered_params, function(params) {
|
||||
input_id <- paste0("base_", params$id)
|
||||
params$id <- NULL
|
||||
if (params$type %in% "select_variables") {
|
||||
params$data <- data()
|
||||
}
|
||||
|
||||
create_input_element(params, ns, input_id)
|
||||
})
|
||||
tagList(base_inputs)
|
||||
|
||||
})
|
||||
|
||||
### Color option
|
||||
output$color_palette <- shiny::renderUI({
|
||||
# shiny::req(input$type)
|
||||
|
|
@ -251,18 +286,48 @@ data_visuals_server <- function(id,
|
|||
shiny::observeEvent(input$act_plot, {
|
||||
if (NROW(data()) > 0) {
|
||||
tryCatch({
|
||||
# Get all input values with prefixes
|
||||
base_inputs <- reactiveValuesToList(input)[grep("^base_", names(reactiveValuesToList(input)))]
|
||||
# advanced_inputs <- reactiveValuesToList(input)[grep("^advanced_", names(reactiveValuesToList(input)))]
|
||||
|
||||
# Remove the prefix from names
|
||||
names(base_inputs) <- gsub("^base_", "", names(base_inputs))
|
||||
# names(advanced_inputs) <- gsub("^advanced_", "", names(advanced_inputs))
|
||||
|
||||
base_inputs <- c(base_inputs,
|
||||
list(color.palette = input$color_palette))
|
||||
|
||||
# If any of the specified parameters are NULL/missing, the settings
|
||||
# accordion/panel was never opened, and they can be ignored, as
|
||||
# default settings will the be used.
|
||||
if (any(sapply(base_inputs, is.null))) {
|
||||
dynamic_params <- list()
|
||||
} else {
|
||||
dynamic_params <- base_inputs
|
||||
}
|
||||
|
||||
# Build parameters for plotting function
|
||||
parameters <- list(
|
||||
type = rv$plot.params()[["fun"]],
|
||||
pri = input$primary,
|
||||
sec = input$secondary,
|
||||
ter = input$tertiary,
|
||||
color.palette = input$color_palette
|
||||
ter = input$tertiary
|
||||
)
|
||||
|
||||
parameters <- modifyList(parameters, dynamic_params)
|
||||
|
||||
## If the dictionary holds additional arguments to pass to the
|
||||
## plotting function, these are included
|
||||
if (!is.null(rv$plot.params()[["fun.args"]])) {
|
||||
parameters <- modifyList(parameters, rv$plot.params()[["fun.args"]])
|
||||
default_params <- rv$plot.params()[["fun.args"]]
|
||||
|
||||
## Ensure not to overwrite user defined parameters are overwritten
|
||||
## This allows to define default parameters.
|
||||
##
|
||||
## This will create a strange edge case, where the plot looks in
|
||||
## one way, when plotted initially, but may change, when the settings
|
||||
## accordion is opened. Problem for future me. Really mostly an edge case.
|
||||
parameters <- modifyList(parameters, default_params[!names(default_params) %in% names(parameters)])
|
||||
}
|
||||
|
||||
shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."),
|
||||
|
|
@ -298,7 +363,25 @@ data_visuals_server <- function(id,
|
|||
if (!is.null(rv$plot)) {
|
||||
rv$plot
|
||||
} else {
|
||||
return(NULL)
|
||||
# Create a placeholder plot with instructions using ggplot2
|
||||
ggplot2::ggplot() +
|
||||
ggplot2::annotate(
|
||||
"text",
|
||||
x = 0.5,
|
||||
y = 0.5,
|
||||
label = i18n$t("Select variables and plot type,\nthen click 'Plot' to generate visualization"),
|
||||
size = 5,
|
||||
color = "gray50",
|
||||
lineheight = 0.8
|
||||
) +
|
||||
ggplot2::xlim(0, 1) +
|
||||
ggplot2::ylim(0, 1) +
|
||||
ggplot2::theme_void() +
|
||||
ggplot2::theme(
|
||||
panel.background = ggplot2::element_rect(fill = "white"),
|
||||
plot.background = ggplot2::element_rect(fill = "white")
|
||||
)
|
||||
# return(NULL)
|
||||
}
|
||||
})
|
||||
|
||||
|
|
@ -342,503 +425,3 @@ data_visuals_server <- function(id,
|
|||
}
|
||||
)
|
||||
}
|
||||
|
||||
#' Select all from vector but
|
||||
#'
|
||||
#' @param data vector
|
||||
#' @param ... exclude
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' all_but(1:10, c(2, 3), 11, 5)
|
||||
all_but <- function(data, ...) {
|
||||
data[!data %in% c(...)]
|
||||
}
|
||||
|
||||
#' Easily subset by data type function
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param types desired types
|
||||
#' @param type.fun function to get type. Default is outcome_type
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' default_parsing(mtcars) |> subset_types("ordinal")
|
||||
#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
|
||||
#' #' default_parsing(mtcars) |> subset_types("factor",class)
|
||||
subset_types <- function(data, types, type.fun = data_type) {
|
||||
data[sapply(data, type.fun) %in% types]
|
||||
}
|
||||
|
||||
|
||||
#' Implemented functions
|
||||
#'
|
||||
#' @description
|
||||
#' Library of supported functions. The list name and "descr" element should be
|
||||
#' unique for each element on list.
|
||||
#'
|
||||
#' - descr: Plot description
|
||||
#'
|
||||
#' - primary.type: Primary variable data type (continuous, dichotomous or ordinal)
|
||||
#'
|
||||
#' - secondary.type: Secondary variable data type (continuous, dichotomous or ordinal)
|
||||
#'
|
||||
#' - secondary.extra: "none" or NULL to have option to choose none.
|
||||
#'
|
||||
#' - tertiary.type: Tertiary variable data type (continuous, dichotomous or ordinal)
|
||||
#'
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' supported_plots() |> str()
|
||||
supported_plots <- function() {
|
||||
list(
|
||||
plot_bar_rel = list(
|
||||
fun = "plot_bar",
|
||||
fun.args = list(style = "fill"),
|
||||
descr = i18n$t("Stacked relative barplot"),
|
||||
note = i18n$t(
|
||||
"Create relative stacked barplots to show the distribution of categorical levels"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_bar_abs = list(
|
||||
fun = "plot_bar",
|
||||
fun.args = list(style = "dodge"),
|
||||
descr = i18n$t("Side-by-side barplot"),
|
||||
note = i18n$t(
|
||||
"Create side-by-side barplot to show the distribution of categorical levels"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_hbars = list(
|
||||
fun = "plot_hbars",
|
||||
descr = i18n$t("Stacked horizontal bars"),
|
||||
note = i18n$t(
|
||||
"A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_violin = list(
|
||||
fun = "plot_violin",
|
||||
descr = i18n$t("Violin plot"),
|
||||
note = i18n$t(
|
||||
"A modern alternative to the classic boxplot to visualise data distribution"
|
||||
),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = "none",
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
),
|
||||
# plot_ridge = list(
|
||||
# descr = "Ridge plot",
|
||||
# note = "An alternative option to visualise data distribution",
|
||||
# primary.type = "continuous",
|
||||
# secondary.type = c("dichotomous" ,"categorical"),
|
||||
# tertiary.type = c("dichotomous" ,"categorical"),
|
||||
# secondary.extra = NULL
|
||||
# ),
|
||||
plot_sankey = list(
|
||||
fun = "plot_sankey",
|
||||
descr = i18n$t("Sankey plot"),
|
||||
note = i18n$t("A way of visualising change between groups"),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = NULL,
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
),
|
||||
plot_scatter = list(
|
||||
fun = "plot_scatter",
|
||||
descr = i18n$t("Scatter plot"),
|
||||
note = i18n$t("A classic way of showing the association between to variables"),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
secondary.type = c("datatime", "continuous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_box = list(
|
||||
fun = "plot_box",
|
||||
descr = i18n$t("Box plot"),
|
||||
note = i18n$t("A classic way to plot data distribution by groups"),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_euler = list(
|
||||
fun = "plot_euler",
|
||||
descr = i18n$t("Euler diagram"),
|
||||
note = i18n$t(
|
||||
"Generate area-proportional Euler diagrams to display set relationships"
|
||||
),
|
||||
primary.type = c("dichotomous"),
|
||||
secondary.type = c("dichotomous"),
|
||||
secondary.multi = TRUE,
|
||||
secondary.max = 4,
|
||||
tertiary.type = c("dichotomous"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_euler = list(
|
||||
fun = "plot_likert",
|
||||
descr = i18n$t("Likert diagram"),
|
||||
note = i18n$t(
|
||||
"Plot survey results"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = TRUE,
|
||||
secondary.extra = NULL,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = NULL
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Get possible regression models
|
||||
#'
|
||||
#' @param data data
|
||||
#'
|
||||
#' @returns character vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::pull("cyl") |>
|
||||
#' possible_plots()
|
||||
#'
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::select("mpg") |>
|
||||
#' possible_plots()
|
||||
possible_plots <- function(data) {
|
||||
# browser()
|
||||
# data <- if (is.reactive(data)) data() else data
|
||||
if (is.data.frame(data)) {
|
||||
data <- data[[1]]
|
||||
}
|
||||
|
||||
type <- data_type(data)
|
||||
|
||||
if (type == "unknown") {
|
||||
out <- type
|
||||
} else {
|
||||
out <- supported_plots() |>
|
||||
lapply(\(.x) {
|
||||
if (type %in% .x$primary.type) {
|
||||
.x$descr
|
||||
}
|
||||
}) |>
|
||||
unlist()
|
||||
}
|
||||
unname(out)
|
||||
}
|
||||
|
||||
#' Get the function options based on the selected function description
|
||||
#'
|
||||
#' @param data vector
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' ls <- mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::pull(mpg) |>
|
||||
#' possible_plots() |>
|
||||
#' (\(.x){
|
||||
#' .x[[1]]
|
||||
#' })() |>
|
||||
#' get_plot_options()
|
||||
get_plot_options <- function(data) {
|
||||
descrs <- supported_plots() |>
|
||||
lapply(\(.x) {
|
||||
.x$descr
|
||||
}) |>
|
||||
unlist()
|
||||
supported_plots() |>
|
||||
(\(.x) {
|
||||
.x[match(data, descrs)]
|
||||
})()
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Wrapper to create plot based on provided type
|
||||
#'
|
||||
#' @param data data.frame
|
||||
#' @param pri primary variable
|
||||
#' @param sec secondary variable
|
||||
#' @param ter tertiary variable
|
||||
#' @param type plot type (derived from possible_plots() and matches custom function)
|
||||
#' @param color.palette choose color palette. See \code{\link{plot_colors}} for support.
|
||||
#' @param ... ignored for now
|
||||
#'
|
||||
#' @name data-plots
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
|
||||
create_plot <- function(data,
|
||||
type,
|
||||
pri,
|
||||
sec,
|
||||
ter = NULL,
|
||||
color.palette = "viridis",
|
||||
...) {
|
||||
if (!is.null(sec)) {
|
||||
if (!any(sec %in% names(data))) {
|
||||
sec <- NULL
|
||||
}
|
||||
}
|
||||
|
||||
if (!is.null(ter)) {
|
||||
if (!ter %in% names(data)) {
|
||||
ter <- NULL
|
||||
}
|
||||
}
|
||||
|
||||
parameters <- list(
|
||||
pri = pri,
|
||||
sec = sec,
|
||||
ter = ter,
|
||||
color.palette = color.palette,
|
||||
...
|
||||
)
|
||||
|
||||
out <- do.call(type, modifyList(parameters, list(data = data)))
|
||||
|
||||
code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
|
||||
|
||||
attr(out, "code") <- code
|
||||
out
|
||||
}
|
||||
|
||||
#' Print label, and if missing print variable name for plots
|
||||
#'
|
||||
#' @param data vector or data frame
|
||||
#' @param var variable name. Optional.
|
||||
#'
|
||||
#' @returns character string
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> get_label(var = "mpg")
|
||||
#' mtcars |> get_label()
|
||||
#' mtcars$mpg |> get_label()
|
||||
#' gtsummary::trial |> get_label(var = "trt")
|
||||
#' gtsummary::trial$trt |> get_label()
|
||||
#' 1:10 |> get_label()
|
||||
get_label <- function(data, var = NULL) {
|
||||
# data <- if (is.reactive(data)) data() else data
|
||||
if (!is.null(var) & is.data.frame(data)) {
|
||||
data <- data[[var]]
|
||||
}
|
||||
out <- REDCapCAST::get_attr(data = data, attr = "label")
|
||||
if (is.na(out)) {
|
||||
if (is.null(var)) {
|
||||
out <- deparse(substitute(data))
|
||||
} else {
|
||||
if (is.symbol(var)) {
|
||||
out <- gsub('\"', "", deparse(substitute(var)))
|
||||
} else {
|
||||
out <- var
|
||||
}
|
||||
}
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Line breaking at given number of characters for nicely plotting labels
|
||||
#'
|
||||
#' @param data string
|
||||
#' @param lineLength maximum line length
|
||||
#' @param fixed flag to force split at exactly the value given in lineLength.
|
||||
#' Default is FALSE, only splitting at spaces.
|
||||
#'
|
||||
#' @returns character string
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' "Lorem ipsum... you know the routine" |> line_break()
|
||||
#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
|
||||
line_break <- function(data,
|
||||
lineLength = 20,
|
||||
force = FALSE) {
|
||||
if (isTRUE(force)) {
|
||||
## This eats some letters when splitting a sentence... ??
|
||||
gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"),
|
||||
"\\1\n",
|
||||
data)
|
||||
} else {
|
||||
paste(strwrap(data, lineLength), collapse = "\n")
|
||||
}
|
||||
## https://stackoverflow.com/a/29847221
|
||||
}
|
||||
|
||||
|
||||
#' Wrapping
|
||||
#'
|
||||
#' @param data list of ggplot2 objects
|
||||
#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
|
||||
#' @param title panel title
|
||||
#' @param guides passed to patchwork::wrap_plots()
|
||||
#' @param axes passed to patchwork::wrap_plots()
|
||||
#' @param axis_titles passed to patchwork::wrap_plots()
|
||||
#' @param ... passed to patchwork::wrap_plots()
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
wrap_plot_list <- function(data,
|
||||
tag_levels = NULL,
|
||||
title = NULL,
|
||||
axis.font.family = NULL,
|
||||
guides = "collect",
|
||||
axes = "collect",
|
||||
axis_titles = "collect",
|
||||
y.axis.percentage = FALSE,
|
||||
...) {
|
||||
if (ggplot2::is_ggplot(data[[1]])) {
|
||||
if (length(data) > 1) {
|
||||
out <- data |>
|
||||
(\(.x) {
|
||||
if (rlang::is_named(.x)) {
|
||||
purrr::imap(.x, \(.y, .i) {
|
||||
.y + ggplot2::ggtitle(.i)
|
||||
})
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
align_axes(percentage=y.axis.percentage) |>
|
||||
patchwork::wrap_plots(guides = guides,
|
||||
axes = axes,
|
||||
axis_titles = axis_titles,
|
||||
...)
|
||||
if (!is.null(tag_levels)) {
|
||||
out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
|
||||
}
|
||||
if (!is.null(title)) {
|
||||
out <- out +
|
||||
patchwork::plot_annotation(
|
||||
title = title,
|
||||
theme = ggplot2::theme(plot.title = ggplot2::element_text(size = 25))
|
||||
)
|
||||
}
|
||||
} else {
|
||||
out <- data[[1]]
|
||||
}
|
||||
} else {
|
||||
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
|
||||
}
|
||||
|
||||
if (!is.null(axis.font.family)) {
|
||||
if (inherits(x = out, what = "patchwork")) {
|
||||
out <- out &
|
||||
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
|
||||
} else {
|
||||
out <- out +
|
||||
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
|
||||
}
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Aligns axes between plots
|
||||
#'
|
||||
#' @param ... ggplot2 objects or list of ggplot2 objects
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
align_axes <- function(...,
|
||||
x.axis = TRUE,
|
||||
y.axis = TRUE,
|
||||
percentage = FALSE) {
|
||||
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
|
||||
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
|
||||
if (ggplot2::is_ggplot(..1)) {
|
||||
## Assumes list of ggplots
|
||||
p <- list(...)
|
||||
} else if (is.list(..1)) {
|
||||
## Assumes list with list of ggplots
|
||||
p <- ..1
|
||||
} else {
|
||||
cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
|
||||
}
|
||||
|
||||
yr <- clean_common_axis(p, "y")
|
||||
|
||||
xr <- clean_common_axis(p, "x")
|
||||
|
||||
suppressWarnings({
|
||||
p_out <- purrr::map(p, \(.x) {
|
||||
out <- .x
|
||||
if (isTRUE(x.axis)) {
|
||||
out <- out + ggplot2::xlim(xr)
|
||||
}
|
||||
if (isTRUE(y.axis)) {
|
||||
out <- out + ggplot2::ylim(yr)
|
||||
}
|
||||
out
|
||||
})
|
||||
})
|
||||
|
||||
if(isTRUE(percentage)){
|
||||
lapply(p_out,\(.x){
|
||||
.x+
|
||||
ggplot2::scale_y_continuous(labels = scales::percent)
|
||||
})
|
||||
} else {
|
||||
p_out
|
||||
}
|
||||
}
|
||||
|
||||
#' Extract and clean axis ranges
|
||||
#'
|
||||
#' @param p plot
|
||||
#' @param axis axis. x or y.
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
clean_common_axis <- function(p, axis) {
|
||||
purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
|
||||
unlist() |>
|
||||
(\(.x) {
|
||||
if (is.numeric(.x)) {
|
||||
range(.x)
|
||||
} else {
|
||||
as.character(.x)
|
||||
}
|
||||
})() |>
|
||||
unique()
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
hosted_version <- function()'v26.4.2-260410'
|
||||
hosted_version <- function()'v26.6.1'
|
||||
|
|
|
|||
878
R/plot-helpers.R
Normal file
878
R/plot-helpers.R
Normal file
|
|
@ -0,0 +1,878 @@
|
|||
#' Implemented functions
|
||||
#'
|
||||
#' @description
|
||||
#' Library of supported functions. The list name and "descr" element should be
|
||||
#' unique for each element on list.
|
||||
#'
|
||||
#' - fun: the plotting function
|
||||
#'
|
||||
#' - fun.args: default parameters for the plotting function
|
||||
#'
|
||||
#' - descr: Plot description
|
||||
#'
|
||||
#' - note: Short note/description of the function for displaying in ui and docs
|
||||
#'
|
||||
#' - primary.type: Primary variable data type (see [data_type])
|
||||
#'
|
||||
#' - base: holds a list of parameters for plot input fields generation
|
||||
#' Secondary and tertiary variable input fields are mandatory.
|
||||
#'
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' available_plots() |> str()
|
||||
available_plots <- function() {
|
||||
list(
|
||||
plot_bar_rel = list(
|
||||
fun = "plot_bar",
|
||||
fun.args = list(style = "fill"),
|
||||
descr = i18n$t("Stacked relative barplot"),
|
||||
note = i18n$t(
|
||||
"Create relative stacked barplots to show the distribution of categorical levels"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = FALSE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Additional variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_bar_abs = list(
|
||||
fun = "plot_bar",
|
||||
fun.args = list(style = "dodge"),
|
||||
descr = i18n$t("Side-by-side barplot"),
|
||||
note = i18n$t(
|
||||
"Create side-by-side barplot to show the distribution of categorical levels"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = TRUE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_hbars = list(
|
||||
fun = "plot_hbars",
|
||||
descr = i18n$t("Stacked horizontal bars"),
|
||||
note = i18n$t(
|
||||
"A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = TRUE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "reverse",
|
||||
type = "select_input",
|
||||
label = i18n$t("Reverse colors"),
|
||||
choices = c(yes = TRUE, no = FALSE)
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_violin = list(
|
||||
fun = "plot_violin",
|
||||
descr = i18n$t("Violin plot"),
|
||||
note = i18n$t(
|
||||
"A modern alternative to the classic boxplot to visualise data distribution"
|
||||
),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = TRUE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_sankey = list(
|
||||
fun = "plot_sankey",
|
||||
descr = i18n$t("Sankey plot"),
|
||||
note = i18n$t("A way of visualising change between groups"),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = FALSE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_scatter = list(
|
||||
fun = "plot_scatter",
|
||||
descr = i18n$t("Scatter plot"),
|
||||
note = i18n$t("A classic way of showing the association between to variables"),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("datatime", "continuous", "categorical"),
|
||||
allow_none = FALSE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_box = list(
|
||||
fun = "plot_box",
|
||||
descr = i18n$t("Box plot"),
|
||||
note = i18n$t("A classic way to plot data distribution by groups"),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = TRUE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = FALSE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_euler = list(
|
||||
fun = "plot_euler",
|
||||
descr = i18n$t("Euler diagram"),
|
||||
note = i18n$t(
|
||||
"Generate area-proportional Euler diagrams to display set relationships"
|
||||
),
|
||||
primary.type = c("dichotomous"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous"),
|
||||
allow_none = FALSE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Secondary variable"),
|
||||
multiple = TRUE,
|
||||
maxItems = 4
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
),
|
||||
plot_likert = list(
|
||||
fun = "plot_likert",
|
||||
descr = i18n$t("Likert diagram"),
|
||||
note = i18n$t("Plot survey results"),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
### Input definitions ###
|
||||
base = list(
|
||||
list(
|
||||
id = "secondary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
allow_none = TRUE,
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Additional variables"),
|
||||
multiple = TRUE
|
||||
),
|
||||
list(
|
||||
id = "tertiary",
|
||||
type = "select_variables",
|
||||
var_types = c("dichotomous", "categorical"),
|
||||
# inputId = "sec",
|
||||
label = i18n$t("Grouping variable"),
|
||||
multiple = FALSE
|
||||
)
|
||||
),
|
||||
advanced = list()
|
||||
#########
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
# Helper function to create input elements dynamically
|
||||
create_input_element <- function(params, ns, input_id) {
|
||||
# Add the namespaced inputId to the arguments
|
||||
params$inputId <- ns(input_id)
|
||||
|
||||
# Map input types to Shiny functions
|
||||
input_function <- switch(
|
||||
params$type,
|
||||
"numeric_input" = shiny::numericInput,
|
||||
"select_input" = shiny::selectInput,
|
||||
"checkbox_input" = shiny::checkboxInput,
|
||||
"slider_input" = shiny::sliderInput,
|
||||
"text_input" = shiny::textInput,
|
||||
"select_variables" = selectPlotVariables
|
||||
)
|
||||
|
||||
params$type <- NULL
|
||||
params$id <- NULL
|
||||
|
||||
|
||||
# Call the function with all arguments
|
||||
do.call(input_function, params)
|
||||
}
|
||||
|
||||
#' Wrapper for columnSelectInput
|
||||
#'
|
||||
selectPlotVariables <- function(data,
|
||||
exclude = NULL,
|
||||
allow_none = TRUE,
|
||||
var_types,
|
||||
...) {
|
||||
datar <- if (is.reactive(data)) {
|
||||
data
|
||||
} else {
|
||||
reactive(data)
|
||||
}
|
||||
|
||||
cols <- all_but(colnames(subset_types(datar(), var_types)), exclude)
|
||||
|
||||
if (isTRUE(allow_none)) {
|
||||
cols <- c("none", cols)
|
||||
}
|
||||
|
||||
params <- list(...)
|
||||
|
||||
params$none_label <- i18n$t("No variable")
|
||||
params$col_subset <- cols
|
||||
|
||||
rlang::exec(columnSelectInput, !!!append_list(datar(), params, "data"))
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Select all from vector but
|
||||
#'
|
||||
#' @param data vector
|
||||
#' @param ... exclude
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' all_but(1:10, c(2, 3), 11, 5)
|
||||
all_but <- function(data, ...) {
|
||||
data[!data %in% c(...)]
|
||||
}
|
||||
|
||||
#' Easily subset by data type function
|
||||
#'
|
||||
#' @param data data
|
||||
#' @param types desired types
|
||||
#' @param type.fun function to get type. Default is outcome_type
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' default_parsing(mtcars) |> subset_types("ordinal")
|
||||
#' default_parsing(mtcars) |> subset_types(c("dichotomous", "categorical"))
|
||||
#' #' default_parsing(mtcars) |> subset_types("factor",class)
|
||||
subset_types <- function(data, types, type.fun = data_type) {
|
||||
data[sapply(data, type.fun) %in% types]
|
||||
}
|
||||
|
||||
|
||||
#' Implemented functions
|
||||
#'
|
||||
#' @description
|
||||
#' Library of supported functions. The list name and "descr" element should be
|
||||
#' unique for each element on list.
|
||||
#'
|
||||
#' - descr: Plot description
|
||||
#'
|
||||
#' - primary.type: Primary variable data type (continuous, dichotomous or ordinal)
|
||||
#'
|
||||
#' - secondary.type: Secondary variable data type (continuous, dichotomous or ordinal)
|
||||
#'
|
||||
#' - secondary.extra: "none" or NULL to have option to choose none.
|
||||
#'
|
||||
#' - tertiary.type: Tertiary variable data type (continuous, dichotomous or ordinal)
|
||||
#'
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' supported_plots() |> str()
|
||||
supported_plots <- function() {
|
||||
list(
|
||||
plot_bar_rel = list(
|
||||
fun = "plot_bar",
|
||||
fun.args = list(style = "fill"),
|
||||
descr = i18n$t("Stacked relative barplot"),
|
||||
note = i18n$t(
|
||||
"Create relative stacked barplots to show the distribution of categorical levels"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_bar_abs = list(
|
||||
fun = "plot_bar",
|
||||
fun.args = list(style = "dodge"),
|
||||
descr = i18n$t("Side-by-side barplot"),
|
||||
note = i18n$t(
|
||||
"Create side-by-side barplot to show the distribution of categorical levels"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_hbars = list(
|
||||
fun = "plot_hbars",
|
||||
descr = i18n$t("Stacked horizontal bars"),
|
||||
note = i18n$t(
|
||||
"A classical way of visualising the distribution of an ordinal scale like the modified Ranking Scale and known as Grotta bars"
|
||||
),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_violin = list(
|
||||
fun = "plot_violin",
|
||||
descr = i18n$t("Violin plot"),
|
||||
note = i18n$t(
|
||||
"A modern alternative to the classic boxplot to visualise data distribution"
|
||||
),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = "none",
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
),
|
||||
# plot_ridge = list(
|
||||
# descr = "Ridge plot",
|
||||
# note = "An alternative option to visualise data distribution",
|
||||
# primary.type = "continuous",
|
||||
# secondary.type = c("dichotomous" ,"categorical"),
|
||||
# tertiary.type = c("dichotomous" ,"categorical"),
|
||||
# secondary.extra = NULL
|
||||
# ),
|
||||
plot_sankey = list(
|
||||
fun = "plot_sankey",
|
||||
descr = i18n$t("Sankey plot"),
|
||||
note = i18n$t("A way of visualising change between groups"),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
secondary.extra = NULL,
|
||||
tertiary.type = c("dichotomous", "categorical")
|
||||
),
|
||||
plot_scatter = list(
|
||||
fun = "plot_scatter",
|
||||
descr = i18n$t("Scatter plot"),
|
||||
note = i18n$t("A classic way of showing the association between to variables"),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
secondary.type = c("datatime", "continuous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_box = list(
|
||||
fun = "plot_box",
|
||||
descr = i18n$t("Box plot"),
|
||||
note = i18n$t("A classic way to plot data distribution by groups"),
|
||||
primary.type = c("datatime", "continuous"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = FALSE,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = "none"
|
||||
),
|
||||
plot_euler = list(
|
||||
fun = "plot_euler",
|
||||
descr = i18n$t("Euler diagram"),
|
||||
note = i18n$t(
|
||||
"Generate area-proportional Euler diagrams to display set relationships"
|
||||
),
|
||||
primary.type = c("dichotomous"),
|
||||
secondary.type = c("dichotomous"),
|
||||
secondary.multi = TRUE,
|
||||
secondary.max = 4,
|
||||
tertiary.type = c("dichotomous"),
|
||||
secondary.extra = NULL
|
||||
),
|
||||
plot_likert = list(
|
||||
fun = "plot_likert",
|
||||
descr = i18n$t("Likert diagram"),
|
||||
note = i18n$t("Plot survey results"),
|
||||
primary.type = c("dichotomous", "categorical"),
|
||||
secondary.type = c("dichotomous", "categorical"),
|
||||
secondary.multi = TRUE,
|
||||
secondary.extra = NULL,
|
||||
tertiary.type = c("dichotomous", "categorical"),
|
||||
secondary.extra = NULL
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' Get possible regression models
|
||||
#'
|
||||
#' @param data data
|
||||
#'
|
||||
#' @returns character vector
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::pull("cyl") |>
|
||||
#' possible_plots()
|
||||
#'
|
||||
#' mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::select("mpg") |>
|
||||
#' possible_plots()
|
||||
possible_plots <- function(data, source_list = supported_plots()) {
|
||||
# browser()
|
||||
# data <- if (is.reactive(data)) data() else data
|
||||
if (is.data.frame(data)) {
|
||||
data <- data[[1]]
|
||||
}
|
||||
|
||||
type <- data_type(data)
|
||||
|
||||
if (type == "unknown") {
|
||||
out <- type
|
||||
} else {
|
||||
out <- source_list |>
|
||||
lapply(\(.x) {
|
||||
if (type %in% .x$primary.type) {
|
||||
.x$descr
|
||||
}
|
||||
}) |>
|
||||
unlist()
|
||||
}
|
||||
unname(out)
|
||||
}
|
||||
|
||||
#' Get the function options based on the selected function description
|
||||
#'
|
||||
#' @param data vector
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' ls <- mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::pull(mpg) |>
|
||||
#' possible_plots() |>
|
||||
#' (\(.x){
|
||||
#' .x[[1]]
|
||||
#' })() |>
|
||||
#' get_plot_options()
|
||||
get_plot_options <- function(data) {
|
||||
descrs <- supported_plots() |>
|
||||
lapply(\(.x) {
|
||||
.x$descr
|
||||
}) |>
|
||||
unlist()
|
||||
supported_plots() |>
|
||||
(\(.x) {
|
||||
.x[match(data, descrs)]
|
||||
})()
|
||||
}
|
||||
|
||||
#' Get the function parameters based on the selected function description
|
||||
#'
|
||||
#' @param data vector
|
||||
#'
|
||||
#' @returns list
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' ls <- mtcars |>
|
||||
#' default_parsing() |>
|
||||
#' dplyr::pull(mpg) |>
|
||||
#' possible_plots() |>
|
||||
#' (\(.x){
|
||||
#' .x[[1]]
|
||||
#' })() |>
|
||||
#' get_input_params()
|
||||
get_input_params <- function(data) {
|
||||
descr <- available_plots() |>
|
||||
lapply(\(.x) {
|
||||
.x$descr
|
||||
}) |>
|
||||
unlist()
|
||||
available_plots() |>
|
||||
(\(.x) {
|
||||
.x[match(data, descr)]
|
||||
})()
|
||||
}
|
||||
|
||||
|
||||
#' Wrapper to create plot based on provided type
|
||||
#'
|
||||
#' @param data data.frame
|
||||
#' @param pri primary variable
|
||||
#' @param sec secondary variable
|
||||
#' @param ter tertiary variable
|
||||
#' @param type plot type (derived from possible_plots() and matches custom function)
|
||||
#' @param color.palette choose color palette. See \code{\link{plot_colors}} for support.
|
||||
#' @param ... ignored for now
|
||||
#'
|
||||
#' @name data-plots
|
||||
#'
|
||||
#' @returns ggplot2 object
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' create_plot(mtcars, "plot_violin", "mpg", "cyl") |> attributes()
|
||||
create_plot <- function(data,
|
||||
type,
|
||||
pri,
|
||||
sec,
|
||||
ter = NULL,
|
||||
color.palette = "viridis",
|
||||
...) {
|
||||
if (!is.null(sec)) {
|
||||
if (!any(sec %in% names(data))) {
|
||||
sec <- NULL
|
||||
}
|
||||
}
|
||||
|
||||
if (!is.null(ter)) {
|
||||
if (!ter %in% names(data)) {
|
||||
ter <- NULL
|
||||
}
|
||||
}
|
||||
|
||||
parameters <- list(
|
||||
pri = pri,
|
||||
sec = sec,
|
||||
ter = ter,
|
||||
color.palette = color.palette,
|
||||
...
|
||||
)
|
||||
|
||||
out <- do.call(type, modifyList(parameters, list(data = data)))
|
||||
|
||||
code <- rlang::call2(type, !!!parameters, .ns = "FreesearchR")
|
||||
|
||||
attr(out, "code") <- code
|
||||
out
|
||||
}
|
||||
|
||||
#' Print label, and if missing print variable name for plots
|
||||
#'
|
||||
#' @param data vector or data frame
|
||||
#' @param var variable name. Optional.
|
||||
#'
|
||||
#' @returns character string
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' mtcars |> get_label(var = "mpg")
|
||||
#' mtcars |> get_label()
|
||||
#' mtcars$mpg |> get_label()
|
||||
#' gtsummary::trial |> get_label(var = "trt")
|
||||
#' gtsummary::trial$trt |> get_label()
|
||||
#' 1:10 |> get_label()
|
||||
get_label <- function(data, var = NULL) {
|
||||
# data <- if (is.reactive(data)) data() else data
|
||||
if (!is.null(var) & is.data.frame(data)) {
|
||||
data <- data[[var]]
|
||||
}
|
||||
out <- REDCapCAST::get_attr(data = data, attr = "label")
|
||||
if (is.na(out)) {
|
||||
if (is.null(var)) {
|
||||
out <- deparse(substitute(data))
|
||||
} else {
|
||||
if (is.symbol(var)) {
|
||||
out <- gsub('\"', "", deparse(substitute(var)))
|
||||
} else {
|
||||
out <- var
|
||||
}
|
||||
}
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Line breaking at given number of characters for nicely plotting labels
|
||||
#'
|
||||
#' @param data string
|
||||
#' @param lineLength maximum line length
|
||||
#' @param fixed flag to force split at exactly the value given in lineLength.
|
||||
#' Default is FALSE, only splitting at spaces.
|
||||
#'
|
||||
#' @returns character string
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' "Lorem ipsum... you know the routine" |> line_break()
|
||||
#' paste(sample(letters[1:10], 100, TRUE), collapse = "") |> line_break(force = TRUE)
|
||||
line_break <- function(data,
|
||||
lineLength = 20,
|
||||
force = FALSE) {
|
||||
if (isTRUE(force)) {
|
||||
## This eats some letters when splitting a sentence... ??
|
||||
gsub(paste0("(.{1,", lineLength, "})(\\s|[[:alnum:]])"),
|
||||
"\\1\n",
|
||||
data)
|
||||
} else {
|
||||
paste(strwrap(data, lineLength), collapse = "\n")
|
||||
}
|
||||
## https://stackoverflow.com/a/29847221
|
||||
}
|
||||
|
||||
|
||||
#' Wrapping
|
||||
#'
|
||||
#' @param data list of ggplot2 objects
|
||||
#' @param tag_levels passed to patchwork::plot_annotation if given. Default is NULL
|
||||
#' @param title panel title
|
||||
#' @param guides passed to patchwork::wrap_plots()
|
||||
#' @param axes passed to patchwork::wrap_plots()
|
||||
#' @param axis_titles passed to patchwork::wrap_plots()
|
||||
#' @param ... passed to patchwork::wrap_plots()
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
wrap_plot_list <- function(data,
|
||||
tag_levels = NULL,
|
||||
title = NULL,
|
||||
axis.font.family = NULL,
|
||||
guides = "collect",
|
||||
axes = "collect",
|
||||
axis_titles = "collect",
|
||||
y.axis.percentage = FALSE,
|
||||
...) {
|
||||
if (ggplot2::is_ggplot(data[[1]])) {
|
||||
if (length(data) > 1) {
|
||||
out <- data |>
|
||||
(\(.x) {
|
||||
if (rlang::is_named(.x)) {
|
||||
purrr::imap(.x, \(.y, .i) {
|
||||
.y + ggplot2::ggtitle(.i)
|
||||
})
|
||||
} else {
|
||||
.x
|
||||
}
|
||||
})() |>
|
||||
align_axes(percentage = y.axis.percentage) |>
|
||||
patchwork::wrap_plots(guides = guides,
|
||||
axes = axes,
|
||||
axis_titles = axis_titles,
|
||||
...)
|
||||
if (!is.null(tag_levels)) {
|
||||
out <- out + patchwork::plot_annotation(tag_levels = tag_levels)
|
||||
}
|
||||
if (!is.null(title)) {
|
||||
out <- out +
|
||||
patchwork::plot_annotation(
|
||||
title = title,
|
||||
theme = ggplot2::theme(plot.title = ggplot2::element_text(size = 25))
|
||||
)
|
||||
}
|
||||
} else {
|
||||
out <- data[[1]]
|
||||
}
|
||||
} else {
|
||||
cli::cli_abort("Can only wrap lists of {.cls ggplot} objects")
|
||||
}
|
||||
|
||||
if (!is.null(axis.font.family)) {
|
||||
if (inherits(x = out, what = "patchwork")) {
|
||||
out <- out &
|
||||
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
|
||||
} else {
|
||||
out <- out +
|
||||
ggplot2::theme(axis.text = ggplot2::element_text(family = axis.font.family))
|
||||
}
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
|
||||
|
||||
#' Aligns axes between plots
|
||||
#'
|
||||
#' @param ... ggplot2 objects or list of ggplot2 objects
|
||||
#'
|
||||
#' @returns list of ggplot2 objects
|
||||
#' @export
|
||||
#'
|
||||
align_axes <- function(...,
|
||||
x.axis = TRUE,
|
||||
y.axis = TRUE,
|
||||
percentage = FALSE) {
|
||||
# https://stackoverflow.com/questions/62818776/get-axis-limits-from-ggplot-object
|
||||
# https://github.com/thomasp85/patchwork/blob/main/R/plot_multipage.R#L150
|
||||
if (ggplot2::is_ggplot(..1)) {
|
||||
## Assumes list of ggplots
|
||||
p <- list(...)
|
||||
} else if (is.list(..1)) {
|
||||
## Assumes list with list of ggplots
|
||||
p <- ..1
|
||||
} else {
|
||||
cli::cli_abort("Can only align {.cls ggplot} objects or a list of them")
|
||||
}
|
||||
|
||||
yr <- clean_common_axis(p, "y")
|
||||
|
||||
xr <- clean_common_axis(p, "x")
|
||||
|
||||
suppressWarnings({
|
||||
p_out <- purrr::map(p, \(.x) {
|
||||
out <- .x
|
||||
if (isTRUE(x.axis)) {
|
||||
out <- out + ggplot2::xlim(xr)
|
||||
}
|
||||
if (isTRUE(y.axis)) {
|
||||
out <- out + ggplot2::ylim(yr)
|
||||
}
|
||||
out
|
||||
})
|
||||
})
|
||||
|
||||
if (isTRUE(percentage)) {
|
||||
lapply(p_out, \(.x) {
|
||||
.x +
|
||||
ggplot2::scale_y_continuous(labels = scales::percent)
|
||||
})
|
||||
} else {
|
||||
p_out
|
||||
}
|
||||
}
|
||||
|
||||
#' Extract and clean axis ranges
|
||||
#'
|
||||
#' @param p plot
|
||||
#' @param axis axis. x or y.
|
||||
#'
|
||||
#' @returns vector
|
||||
#' @export
|
||||
#'
|
||||
clean_common_axis <- function(p, axis) {
|
||||
purrr::map(p, ~ ggplot2::layer_scales(.x)[[axis]]$get_limits()) |>
|
||||
unlist() |>
|
||||
(\(.x) {
|
||||
if (is.numeric(.x)) {
|
||||
range(.x)
|
||||
} else {
|
||||
as.character(.x)
|
||||
}
|
||||
})() |>
|
||||
unique()
|
||||
}
|
||||
|
|
@ -39,14 +39,14 @@ plot_bar <- function(data,
|
|||
sec = sec,
|
||||
style = style,
|
||||
max_level = max_level,
|
||||
color.palette = color.palette
|
||||
color.palette = color.palette,
|
||||
...
|
||||
)
|
||||
})
|
||||
|
||||
wrap_plot_list(out,
|
||||
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
|
||||
y.axis.percentage = TRUE,
|
||||
...)
|
||||
y.axis.percentage = TRUE)
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -32,11 +32,11 @@ plot_box <- function(data, pri, sec, ter = NULL,color.palette="viridis",...) {
|
|||
data = .ds,
|
||||
pri = pri,
|
||||
sec = sec,
|
||||
color.palette=color.palette
|
||||
color.palette=color.palette, ...
|
||||
)
|
||||
})
|
||||
|
||||
wrap_plot_list(out,title=glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),...)
|
||||
wrap_plot_list(out,title=glue::glue(i18n$t("Grouped by {get_label(data,ter)}")))
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -131,7 +131,7 @@ plot_euler <- function(data, pri, sec, ter = NULL, seed = 2103,color.palette="vi
|
|||
#' D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
|
||||
#' ) |> plot_euler_single()
|
||||
#' mtcars[c("vs", "am")] |> plot_euler_single("magma")
|
||||
plot_euler_single <- function(data,color.palette="viridis") {
|
||||
plot_euler_single <- function(data,color.palette="viridis", ...) {
|
||||
|
||||
data |>
|
||||
ggeulerr(shape = "circle") +
|
||||
|
|
|
|||
|
|
@ -15,13 +15,15 @@ plot_hbars <- function(data,
|
|||
pri,
|
||||
sec,
|
||||
ter = NULL,
|
||||
color.palette = "viridis") {
|
||||
color.palette = "viridis",
|
||||
...) {
|
||||
vertical_stacked_bars(
|
||||
data = data,
|
||||
score = pri,
|
||||
group = sec,
|
||||
strata = ter,
|
||||
color.palette = color.palette
|
||||
color.palette = color.palette,
|
||||
...
|
||||
)
|
||||
}
|
||||
|
||||
|
|
@ -74,7 +76,7 @@ vertical_stacked_bars <- function(data,
|
|||
|
||||
colors <- generate_colors(n = nrow(df.table), palette = color.palette)
|
||||
## Colors are reversed by default as that usually gives the best result
|
||||
if (isTRUE(reverse)) {
|
||||
if (isTRUE(reverse) | reverse=="TRUE") {
|
||||
colors <- rev(colors)
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -15,7 +15,8 @@ plot_likert <- function(data,
|
|||
pri,
|
||||
sec = NULL,
|
||||
ter = NULL,
|
||||
color.palette = "viridis") {
|
||||
color.palette = "viridis",
|
||||
...) {
|
||||
if (!is.null(ter)) {
|
||||
ds <- split(data, data[ter])
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -95,7 +95,8 @@ plot_sankey <- function(data,
|
|||
default.color = "#2986cc",
|
||||
box.color = "#1E4B66",
|
||||
na.color = "grey80",
|
||||
missing.level = "Missing") {
|
||||
missing.level = "Missing",
|
||||
...) {
|
||||
if (!is.null(ter)) {
|
||||
ds <- split(data, data[ter])
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
#' @examples
|
||||
#' mtcars |> plot_scatter(pri = "mpg", sec = "wt")
|
||||
#' mtcars |> plot_scatter(pri = "mpg", sec = "wt",ter="carb")
|
||||
plot_scatter <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
|
||||
plot_scatter <- function(data, pri, sec, ter = NULL, color.palette="viridis", ...) {
|
||||
if (is.null(ter)) {
|
||||
rempsyc::nice_scatter(
|
||||
data = data,
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
#' @examples
|
||||
#' mtcars |> plot_violin(pri = "mpg", sec = "cyl")
|
||||
#' mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear", color.palette="Blues")
|
||||
plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
|
||||
plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis", ...) {
|
||||
if (!is.null(ter)) {
|
||||
ds <- split(data, data[ter])
|
||||
} else {
|
||||
|
|
@ -23,7 +23,8 @@ plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
|
|||
group = sec,
|
||||
response = pri,
|
||||
xtitle = get_label(data, var = sec),
|
||||
ytitle = get_label(data, var = pri)
|
||||
ytitle = get_label(data, var = pri),
|
||||
...
|
||||
)+
|
||||
scale_fill_generate(palette=color.palette)
|
||||
})
|
||||
|
|
|
|||
|
|
@ -247,7 +247,7 @@ ui_elements <- function(selection) {
|
|||
"Read more on how ",
|
||||
tags$a(
|
||||
"data types",
|
||||
href = "https://agdamsbo.github.io/FreesearchR/articles/data-types.html",
|
||||
href = "https://freesearchr.github.io/FreesearchR-knowledge/app/data_types.html",
|
||||
target = "_blank",
|
||||
rel = "noopener noreferrer"
|
||||
),
|
||||
|
|
@ -694,7 +694,7 @@ ui_elements <- function(selection) {
|
|||
"docs" = bslib::nav_item(
|
||||
# shiny::img(shiny::icon("book")),
|
||||
shiny::tags$a(
|
||||
href = "https://agdamsbo.github.io/FreesearchR/",
|
||||
href = "https://freesearchr.github.io/FreesearchR-knowledge/",
|
||||
"Docs",
|
||||
shiny::icon("arrow-up-right-from-square"),
|
||||
target = "_blank",
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ visuals_demo_app <- function() {
|
|||
)
|
||||
)
|
||||
server <- function(input, output, session) {
|
||||
pl <- data_visuals_server("visuals", data = shiny::reactive(default_parsing(mtcars)))
|
||||
pl <- data_visuals_server("visuals", data = shiny::reactive(default_parsing(mtcars)),palettes = color_choices())
|
||||
}
|
||||
shiny::shinyApp(ui, server)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -89,7 +89,6 @@
|
|||
"and","og"
|
||||
"from each pair","fra hvert par"
|
||||
"Plot","Tegn"
|
||||
"Adjust settings, then press ""Plot"".","Juster indstillingerne og tryk så ""Tegn""."
|
||||
"Plot height (mm)","Højde af grafik (mm)"
|
||||
"Plot width (mm)","Bredde af grafik (mm)"
|
||||
"File format","File format"
|
||||
|
|
@ -97,12 +96,7 @@
|
|||
"Select variable","Vælg variabel"
|
||||
"Response variable","Svarvariable"
|
||||
"Plot type","Type af grafik"
|
||||
"Please select","Vælg"
|
||||
"Additional variables","Yderligere variabler"
|
||||
"Secondary variable","Sekundær variabel"
|
||||
"No variable","Ingen variabel"
|
||||
"Grouping variable","Variabel til gruppering"
|
||||
"No stratification","Ingen stratificering"
|
||||
"Drawing the plot. Hold tight for a moment..","Tegner grafikken. Spænd selen.."
|
||||
"#Plotting\n","#Tegner\n"
|
||||
"Stacked horizontal bars","Stablede horisontale søjler"
|
||||
|
|
@ -310,7 +304,6 @@
|
|||
"Sample data","Sample data"
|
||||
"Settings","Settings"
|
||||
"Create new factor","Create new factor"
|
||||
"Choose color palette","Choose color palette"
|
||||
"Optional filter logic (e.g., [gender] = 'female')","Optional filter logic (e.g., [gender] = 'female')"
|
||||
"Drop empty","Drop empty"
|
||||
"Choose variable:","Choose variable:"
|
||||
|
|
@ -320,3 +313,13 @@
|
|||
"Modify factor","Modify factor"
|
||||
"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
|
||||
"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."
|
||||
"Adjust plot input and settings below, then press ""Plot"".","Adjust plot input and settings below, then press ""Plot""."
|
||||
"Define plot","Define plot"
|
||||
"Choose color palette","Choose color palette"
|
||||
"Additional variable","Additional variable"
|
||||
"Grouping variable","Grouping variable"
|
||||
"Secondary variable","Secondary variable"
|
||||
"Reverse colors","Reverse colors"
|
||||
"Plot survey results","Plot survey results"
|
||||
"Additional variables","Additional variables"
|
||||
"Other variables","Other variables"
|
||||
|
|
|
|||
|
|
|
@ -89,7 +89,6 @@
|
|||
"and","na"
|
||||
"from each pair","kutoka kwa kila jozi"
|
||||
"Plot","Kipande cha habari"
|
||||
"Adjust settings, then press ""Plot"".","Rekebisha mipangilio, kisha bonyeza ""Plot""."
|
||||
"Plot height (mm)","Urefu wa kiwanja (mm)"
|
||||
"Plot width (mm)","Upana wa kiwanja (mm)"
|
||||
"File format","Umbizo la faili"
|
||||
|
|
@ -97,12 +96,7 @@
|
|||
"Select variable","Chagua kigezo"
|
||||
"Response variable","Kigezo cha majibu"
|
||||
"Plot type","Aina ya kiwanja"
|
||||
"Please select","Tafadhali chagua"
|
||||
"Additional variables","Vigezo vya ziada"
|
||||
"Secondary variable","Kigezo cha pili"
|
||||
"No variable","Hakuna kigezo"
|
||||
"Grouping variable","Kigezo cha kuweka katika makundi"
|
||||
"No stratification","Hakuna matabaka"
|
||||
"Drawing the plot. Hold tight for a moment..","Kuchora njama. Shikilia kwa muda.."
|
||||
"#Plotting\n","#Upangaji\n"
|
||||
"Stacked horizontal bars","Pau za mlalo zilizopangwa kwa mpangilio"
|
||||
|
|
@ -310,7 +304,6 @@
|
|||
"Sample data","Sample data"
|
||||
"Settings","Settings"
|
||||
"Create new factor","Create new factor"
|
||||
"Choose color palette","Choose color palette"
|
||||
"Optional filter logic (e.g., [gender] = 'female')","Optional filter logic (e.g., [gender] = 'female')"
|
||||
"Drop empty","Drop empty"
|
||||
"Choose variable:","Choose variable:"
|
||||
|
|
@ -320,3 +313,13 @@
|
|||
"Modify factor","Modify factor"
|
||||
"Create factor/categorical variable from other variables.","Create factor/categorical variable from other variables."
|
||||
"The data set has %s obs. in %s variables.","The data set has %s obs. in %s variables."
|
||||
"Adjust plot input and settings below, then press ""Plot"".","Adjust plot input and settings below, then press ""Plot""."
|
||||
"Define plot","Define plot"
|
||||
"Choose color palette","Choose color palette"
|
||||
"Additional variable","Additional variable"
|
||||
"Grouping variable","Grouping variable"
|
||||
"Secondary variable","Secondary variable"
|
||||
"Reverse colors","Reverse colors"
|
||||
"Plot survey results","Plot survey results"
|
||||
"Additional variables","Additional variables"
|
||||
"Other variables","Other variables"
|
||||
|
|
|
|||
|
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{align_axes}
|
||||
\alias{align_axes}
|
||||
\title{Aligns axes between plots}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{all_but}
|
||||
\alias{all_but}
|
||||
\title{Select all from vector but}
|
||||
|
|
|
|||
27
man/available_plots.Rd
Normal file
27
man/available_plots.Rd
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{available_plots}
|
||||
\alias{available_plots}
|
||||
\title{Implemented functions}
|
||||
\usage{
|
||||
available_plots()
|
||||
}
|
||||
\value{
|
||||
list
|
||||
}
|
||||
\description{
|
||||
Library of supported functions. The list name and "descr" element should be
|
||||
unique for each element on list.
|
||||
\itemize{
|
||||
\item fun: the plotting function
|
||||
\item fun.args: default parameters for the plotting function
|
||||
\item descr: Plot description
|
||||
\item note: Short note/description of the function for displaying in ui and docs
|
||||
\item primary.type: Primary variable data type (see \link{data_type})
|
||||
\item base: holds a list of parameters for plot input fields generation
|
||||
Secondary and tertiary variable input fields are mandatory.
|
||||
}
|
||||
}
|
||||
\examples{
|
||||
available_plots() |> str()
|
||||
}
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{clean_common_axis}
|
||||
\alias{clean_common_axis}
|
||||
\title{Extract and clean axis ranges}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R, R/plot_bar.R, R/plot_box.R,
|
||||
% R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R, R/plot_sankey.R,
|
||||
% R/plot_scatter.R, R/plot_violin.R
|
||||
% Please edit documentation in R/data_plots.R, R/plot-helpers.R, R/plot_bar.R,
|
||||
% R/plot_box.R, R/plot_hbar.R, R/plot_likert.R, R/plot_ridge.R,
|
||||
% R/plot_sankey.R, R/plot_scatter.R, R/plot_violin.R
|
||||
\name{data-plots}
|
||||
\alias{data-plots}
|
||||
\alias{data_visuals_ui}
|
||||
|
|
@ -22,7 +22,7 @@
|
|||
\usage{
|
||||
data_visuals_ui(id, tab_title = "Plots", ...)
|
||||
|
||||
data_visuals_server(id, data, palettes, ...)
|
||||
data_visuals_server(id, data, palettes = color_choices(), ...)
|
||||
|
||||
create_plot(data, type, pri, sec, ter = NULL, color.palette = "viridis", ...)
|
||||
|
||||
|
|
@ -50,9 +50,9 @@ plot_box(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
|
|||
|
||||
plot_box_single(data, pri, sec = NULL, seed = 2103, color.palette = "viridis")
|
||||
|
||||
plot_hbars(data, pri, sec, ter = NULL, color.palette = "viridis")
|
||||
plot_hbars(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
|
||||
|
||||
plot_likert(data, pri, sec = NULL, ter = NULL, color.palette = "viridis")
|
||||
plot_likert(data, pri, sec = NULL, ter = NULL, color.palette = "viridis", ...)
|
||||
|
||||
plot_ridge(data, x, y, z = NULL, color.palette = "viridis", ...)
|
||||
|
||||
|
|
@ -69,12 +69,13 @@ plot_sankey(
|
|||
default.color = "#2986cc",
|
||||
box.color = "#1E4B66",
|
||||
na.color = "grey80",
|
||||
missing.level = "Missing"
|
||||
missing.level = "Missing",
|
||||
...
|
||||
)
|
||||
|
||||
plot_scatter(data, pri, sec, ter = NULL, color.palette = "viridis")
|
||||
plot_scatter(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
|
||||
|
||||
plot_violin(data, pri, sec, ter = NULL, color.palette = "viridis")
|
||||
plot_violin(data, pri, sec, ter = NULL, color.palette = "viridis", ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{id}{Module id. (Use 'ns("id")')}
|
||||
|
|
|
|||
27
man/get_input_params.Rd
Normal file
27
man/get_input_params.Rd
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{get_input_params}
|
||||
\alias{get_input_params}
|
||||
\title{Get the function parameters based on the selected function description}
|
||||
\usage{
|
||||
get_input_params(data)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{vector}
|
||||
}
|
||||
\value{
|
||||
list
|
||||
}
|
||||
\description{
|
||||
Get the function parameters based on the selected function description
|
||||
}
|
||||
\examples{
|
||||
ls <- mtcars |>
|
||||
default_parsing() |>
|
||||
dplyr::pull(mpg) |>
|
||||
possible_plots() |>
|
||||
(\(.x){
|
||||
.x[[1]]
|
||||
})() |>
|
||||
get_input_params()
|
||||
}
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{get_label}
|
||||
\alias{get_label}
|
||||
\title{Print label, and if missing print variable name for plots}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{get_plot_options}
|
||||
\alias{get_plot_options}
|
||||
\title{Get the function options based on the selected function description}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{line_break}
|
||||
\alias{line_break}
|
||||
\title{Line breaking at given number of characters for nicely plotting labels}
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
\alias{plot_euler_single}
|
||||
\title{Easily plot single euler diagrams}
|
||||
\usage{
|
||||
plot_euler_single(data, color.palette = "viridis")
|
||||
plot_euler_single(data, color.palette = "viridis", ...)
|
||||
}
|
||||
\value{
|
||||
ggplot2 object
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{possible_plots}
|
||||
\alias{possible_plots}
|
||||
\title{Get possible regression models}
|
||||
\usage{
|
||||
possible_plots(data)
|
||||
possible_plots(data, source_list = supported_plots())
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{data}
|
||||
|
|
|
|||
11
man/selectPlotVariables.Rd
Normal file
11
man/selectPlotVariables.Rd
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{selectPlotVariables}
|
||||
\alias{selectPlotVariables}
|
||||
\title{Wrapper for columnSelectInput}
|
||||
\usage{
|
||||
selectPlotVariables(data, exclude = NULL, allow_none = TRUE, var_types, ...)
|
||||
}
|
||||
\description{
|
||||
Wrapper for columnSelectInput
|
||||
}
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{subset_types}
|
||||
\alias{subset_types}
|
||||
\title{Easily subset by data type function}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{supported_plots}
|
||||
\alias{supported_plots}
|
||||
\title{Implemented functions}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/data_plots.R
|
||||
% Please edit documentation in R/plot-helpers.R
|
||||
\name{wrap_plot_list}
|
||||
\alias{wrap_plot_list}
|
||||
\title{Wrapping}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue