mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
data type icons in summary - more tests
This commit is contained in:
parent
652a8ca1b7
commit
50d35c0c85
15 changed files with 406 additions and 2493 deletions
|
|
@ -1 +1 @@
|
|||
app_version <- function()'Version: 25.4.3.250414_1342'
|
||||
app_version <- function()'Version: 25.4.3.250415_1539'
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ create_baseline <- function(data, ..., by.var, add.p = FALSE, add.overall = FALS
|
|||
}
|
||||
}
|
||||
|
||||
gtsummary::theme_gtsummary_journal(journal = theme)
|
||||
suppressMessages(gtsummary::theme_gtsummary_journal(journal = theme))
|
||||
|
||||
args <- list(...)
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ cut_var <- function(x, ...) {
|
|||
#' @export
|
||||
#' @name cut_var
|
||||
cut_var.default <- function(x, ...) {
|
||||
base::cut.default(x, ...)
|
||||
base::cut(x, ...)
|
||||
}
|
||||
|
||||
#' @name cut_var
|
||||
|
|
@ -581,36 +581,6 @@ modal_cut_variable <- function(id,
|
|||
}
|
||||
|
||||
|
||||
#' @inheritParams shinyWidgets::WinBox
|
||||
#' @export
|
||||
#'
|
||||
#' @importFrom shinyWidgets WinBox wbOptions wbControls
|
||||
#' @importFrom htmltools tagList
|
||||
#' @rdname cut-variable
|
||||
winbox_cut_variable <- function(id,
|
||||
title = i18n("Convert Numeric to Factor"),
|
||||
options = shinyWidgets::wbOptions(),
|
||||
controls = shinyWidgets::wbControls()) {
|
||||
ns <- NS(id)
|
||||
WinBox(
|
||||
title = title,
|
||||
ui = tagList(
|
||||
cut_variable_ui(id),
|
||||
tags$div(
|
||||
style = "display: none;",
|
||||
textInput(inputId = ns("hidden"), label = NULL, value = genId())
|
||||
)
|
||||
),
|
||||
options = modifyList(
|
||||
shinyWidgets::wbOptions(height = "750px", modal = TRUE),
|
||||
options
|
||||
),
|
||||
controls = controls,
|
||||
auto_height = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @importFrom graphics abline axis hist par plot.new plot.window
|
||||
plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") {
|
||||
x <- data[[column]]
|
||||
|
|
@ -627,3 +597,4 @@ plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112
|
|||
abline(v = breaks, col = "#FFFFFF", lty = 1, lwd = 1.5)
|
||||
abline(v = breaks, col = "#2E2E2E", lty = 2, lwd = 1.5)
|
||||
}
|
||||
|
||||
|
|
|
|||
101
R/data-summary.R
101
R/data-summary.R
|
|
@ -155,8 +155,8 @@ overview_vars <- function(data) {
|
|||
data <- as.data.frame(data)
|
||||
|
||||
dplyr::tibble(
|
||||
class = get_classes(data),
|
||||
type = data_type(data),
|
||||
icon = data_type(data),
|
||||
type = icon,
|
||||
name = names(data),
|
||||
n_missing = unname(colSums(is.na(data))),
|
||||
p_complete = 1 - n_missing / nrow(data),
|
||||
|
|
@ -188,7 +188,7 @@ create_overview_datagrid <- function(data,...) {
|
|||
|
||||
std_names <- c(
|
||||
"Name" = "name",
|
||||
"Class" = "class",
|
||||
"Icon" = "icon",
|
||||
"Type" = "type",
|
||||
"Missings" = "n_missing",
|
||||
"Complete" = "p_complete",
|
||||
|
|
@ -226,7 +226,7 @@ create_overview_datagrid <- function(data,...) {
|
|||
|
||||
grid <- toastui::grid_columns(
|
||||
grid = grid,
|
||||
columns = "class",
|
||||
columns = "icon",
|
||||
header = " ",
|
||||
align = "center",sortable = FALSE,
|
||||
width = 40
|
||||
|
|
@ -234,7 +234,8 @@ create_overview_datagrid <- function(data,...) {
|
|||
|
||||
grid <- add_class_icon(
|
||||
grid = grid,
|
||||
column = "class"
|
||||
column = "icon",
|
||||
fun = type_icons
|
||||
)
|
||||
|
||||
grid <- toastui::grid_format(
|
||||
|
|
@ -271,32 +272,14 @@ create_overview_datagrid <- function(data,...) {
|
|||
#' overview_vars() |>
|
||||
#' toastui::datagrid() |>
|
||||
#' add_class_icon()
|
||||
add_class_icon <- function(grid, column = "class") {
|
||||
add_class_icon <- function(grid, column = "class", fun=class_icons) {
|
||||
out <- toastui::grid_format(
|
||||
grid = grid,
|
||||
column = column,
|
||||
formatter = function(value) {
|
||||
lapply(
|
||||
X = value,
|
||||
FUN = function(x) {
|
||||
if (identical(x, "numeric")) {
|
||||
shiny::icon("calculator")
|
||||
} else if (identical(x, "factor")) {
|
||||
shiny::icon("chart-simple")
|
||||
} else if (identical(x, "integer")) {
|
||||
shiny::icon("arrow-down-1-9")
|
||||
} else if (identical(x, "character")) {
|
||||
shiny::icon("arrow-down-a-z")
|
||||
} else if (identical(x, "logical")) {
|
||||
shiny::icon("toggle-off")
|
||||
} else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) {
|
||||
shiny::icon("calendar-days")
|
||||
} else if ("hms" %in% x) {
|
||||
shiny::icon("clock")
|
||||
} else {
|
||||
shiny::icon("table")
|
||||
}
|
||||
}
|
||||
FUN = fun
|
||||
)
|
||||
}
|
||||
)
|
||||
|
|
@ -308,3 +291,71 @@ add_class_icon <- function(grid, column = "class") {
|
|||
width = 60
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' Get data class icons
|
||||
#'
|
||||
#' @param x character vector of data classes
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' "numeric" |> class_icons()
|
||||
#' default_parsing(mtcars) |> sapply(class) |> class_icons()
|
||||
class_icons <- function(x) {
|
||||
if (length(x)>1){
|
||||
sapply(x,class_icons)
|
||||
} else {
|
||||
if (identical(x, "numeric")) {
|
||||
shiny::icon("calculator")
|
||||
} else if (identical(x, "factor")) {
|
||||
shiny::icon("chart-simple")
|
||||
} else if (identical(x, "integer")) {
|
||||
shiny::icon("arrow-down-1-9")
|
||||
} else if (identical(x, "character")) {
|
||||
shiny::icon("arrow-down-a-z")
|
||||
} else if (identical(x, "logical")) {
|
||||
shiny::icon("toggle-off")
|
||||
} else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) {
|
||||
shiny::icon("calendar-days")
|
||||
} else if ("hms" %in% x) {
|
||||
shiny::icon("clock")
|
||||
} else {
|
||||
shiny::icon("table")
|
||||
}}
|
||||
}
|
||||
|
||||
#' Get data type icons
|
||||
#'
|
||||
#' @param x character vector of data classes
|
||||
#'
|
||||
#' @returns
|
||||
#' @export
|
||||
#'
|
||||
#' @examples
|
||||
#' "ordinal" |> type_icons()
|
||||
#' default_parsing(mtcars) |> sapply(data_type) |> type_icons()
|
||||
type_icons <- function(x) {
|
||||
if (length(x)>1){
|
||||
sapply(x,class_icons)
|
||||
} else {
|
||||
if (identical(x, "continuous")) {
|
||||
shiny::icon("calculator")
|
||||
} else if (identical(x, "categorical")) {
|
||||
shiny::icon("chart-simple")
|
||||
} else if (identical(x, "ordinal")) {
|
||||
shiny::icon("arrow-down-1-9")
|
||||
} else if (identical(x, "text")) {
|
||||
shiny::icon("arrow-down-a-z")
|
||||
} else if (identical(x, "dichotomous")) {
|
||||
shiny::icon("toggle-off")
|
||||
} else if (identical(x,"datetime")) {
|
||||
shiny::icon("calendar-days")
|
||||
} else if (identical(x,"id")) {
|
||||
shiny::icon("id-card")
|
||||
} else {
|
||||
shiny::icon("table")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -357,7 +357,7 @@ data_description <- function(data, data_text = "Data") {
|
|||
p_complete <- n_complete / n
|
||||
|
||||
sprintf(
|
||||
i18n("%s has %s observations and %s variables, with %s (%s%%) complete cases."),
|
||||
"%s has %s observations and %s variables, with %s (%s%%) complete cases.",
|
||||
data_text,
|
||||
n,
|
||||
n_var,
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue