mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
allows ... inputs in plot models
This commit is contained in:
parent
d1e0236437
commit
f2a522dcb6
10 changed files with 20 additions and 15 deletions
|
|
@ -1 +1 @@
|
||||||
hosted_version <- function()'v26.4.2-260410'
|
hosted_version <- function()'v26.4.2-260528'
|
||||||
|
|
|
||||||
|
|
@ -39,14 +39,14 @@ plot_bar <- function(data,
|
||||||
sec = sec,
|
sec = sec,
|
||||||
style = style,
|
style = style,
|
||||||
max_level = max_level,
|
max_level = max_level,
|
||||||
color.palette = color.palette
|
color.palette = color.palette,
|
||||||
|
...
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
|
|
||||||
wrap_plot_list(out,
|
wrap_plot_list(out,
|
||||||
title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")),
|
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,
|
data = .ds,
|
||||||
pri = pri,
|
pri = pri,
|
||||||
sec = sec,
|
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)
|
#' D = sample(c(TRUE, FALSE, FALSE, FALSE), 50, TRUE)
|
||||||
#' ) |> plot_euler_single()
|
#' ) |> plot_euler_single()
|
||||||
#' mtcars[c("vs", "am")] |> plot_euler_single("magma")
|
#' 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 |>
|
data |>
|
||||||
ggeulerr(shape = "circle") +
|
ggeulerr(shape = "circle") +
|
||||||
|
|
|
||||||
|
|
@ -15,13 +15,15 @@ plot_hbars <- function(data,
|
||||||
pri,
|
pri,
|
||||||
sec,
|
sec,
|
||||||
ter = NULL,
|
ter = NULL,
|
||||||
color.palette = "viridis") {
|
color.palette = "viridis",
|
||||||
|
...) {
|
||||||
vertical_stacked_bars(
|
vertical_stacked_bars(
|
||||||
data = data,
|
data = data,
|
||||||
score = pri,
|
score = pri,
|
||||||
group = sec,
|
group = sec,
|
||||||
strata = ter,
|
strata = ter,
|
||||||
color.palette = color.palette
|
color.palette = color.palette,
|
||||||
|
...
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,8 @@ plot_likert <- function(data,
|
||||||
pri,
|
pri,
|
||||||
sec = NULL,
|
sec = NULL,
|
||||||
ter = NULL,
|
ter = NULL,
|
||||||
color.palette = "viridis") {
|
color.palette = "viridis",
|
||||||
|
...) {
|
||||||
if (!is.null(ter)) {
|
if (!is.null(ter)) {
|
||||||
ds <- split(data, data[ter])
|
ds <- split(data, data[ter])
|
||||||
} else {
|
} else {
|
||||||
|
|
|
||||||
|
|
@ -95,7 +95,8 @@ plot_sankey <- function(data,
|
||||||
default.color = "#2986cc",
|
default.color = "#2986cc",
|
||||||
box.color = "#1E4B66",
|
box.color = "#1E4B66",
|
||||||
na.color = "grey80",
|
na.color = "grey80",
|
||||||
missing.level = "Missing") {
|
missing.level = "Missing",
|
||||||
|
...) {
|
||||||
if (!is.null(ter)) {
|
if (!is.null(ter)) {
|
||||||
ds <- split(data, data[ter])
|
ds <- split(data, data[ter])
|
||||||
} else {
|
} else {
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@
|
||||||
#' @examples
|
#' @examples
|
||||||
#' mtcars |> plot_scatter(pri = "mpg", sec = "wt")
|
#' mtcars |> plot_scatter(pri = "mpg", sec = "wt")
|
||||||
#' mtcars |> plot_scatter(pri = "mpg", sec = "wt",ter="carb")
|
#' 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)) {
|
if (is.null(ter)) {
|
||||||
rempsyc::nice_scatter(
|
rempsyc::nice_scatter(
|
||||||
data = data,
|
data = data,
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@
|
||||||
#' @examples
|
#' @examples
|
||||||
#' mtcars |> plot_violin(pri = "mpg", sec = "cyl")
|
#' mtcars |> plot_violin(pri = "mpg", sec = "cyl")
|
||||||
#' mtcars |> plot_violin(pri = "mpg", sec = "cyl", ter = "gear", color.palette="Blues")
|
#' 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)) {
|
if (!is.null(ter)) {
|
||||||
ds <- split(data, data[ter])
|
ds <- split(data, data[ter])
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -23,7 +23,8 @@ plot_violin <- function(data, pri, sec, ter = NULL, color.palette="viridis") {
|
||||||
group = sec,
|
group = sec,
|
||||||
response = pri,
|
response = pri,
|
||||||
xtitle = get_label(data, var = sec),
|
xtitle = get_label(data, var = sec),
|
||||||
ytitle = get_label(data, var = pri)
|
ytitle = get_label(data, var = pri),
|
||||||
|
...
|
||||||
)+
|
)+
|
||||||
scale_fill_generate(palette=color.palette)
|
scale_fill_generate(palette=color.palette)
|
||||||
})
|
})
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,7 @@ visuals_demo_app <- function() {
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
server <- function(input, output, session) {
|
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)
|
shiny::shinyApp(ui, server)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue