diff --git a/NAMESPACE b/NAMESPACE index 186ab21a..f644c440 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,8 +18,6 @@ export(clean_sep) export(columnSelectInput) export(contrast_text) export(create_baseline) -export(create_column_server) -export(create_column_ui) export(create_log_tics) export(create_overview_datagrid) export(create_plot) @@ -47,7 +45,6 @@ export(format_writer) export(get_fun_options) export(get_label) export(get_plot_options) -export(get_var_icon) export(getfun) export(gg_theme_export) export(gg_theme_shiny) @@ -70,13 +67,11 @@ export(is_valid_token) export(launch_FreesearchR) export(limit_log) export(line_break) -export(list_allowed_operations) export(m_redcap_readServer) export(m_redcap_readUI) export(merge_expression) export(merge_long) export(missing_fraction) -export(modal_create_column) export(modal_cut_variable) export(modal_update_factor) export(modify_qmd) @@ -107,7 +102,6 @@ export(repeated_instruments) export(sankey_ready) export(selectInputIcon) export(set_column_label) -export(show_data) export(sort_by) export(specify_qmd_format) export(subset_types) @@ -123,7 +117,6 @@ export(update_variables_ui) export(vectorSelectInput) export(vertical_stacked_bars) export(wide2long) -export(winbox_create_column) export(winbox_update_factor) export(wrap_plot_list) export(write_quarto) @@ -141,7 +134,6 @@ importFrom(htmltools,css) importFrom(htmltools,tagList) importFrom(htmltools,tags) importFrom(htmltools,validateCssUnit) -importFrom(phosphoricons,ph) importFrom(rlang,"%||%") importFrom(rlang,call2) importFrom(rlang,expr) @@ -160,25 +152,20 @@ importFrom(shiny,isTruthy) importFrom(shiny,modalDialog) importFrom(shiny,moduleServer) importFrom(shiny,numericInput) -importFrom(shiny,observe) importFrom(shiny,observeEvent) importFrom(shiny,plotOutput) importFrom(shiny,reactive) importFrom(shiny,reactiveValues) importFrom(shiny,renderPlot) -importFrom(shiny,renderUI) importFrom(shiny,req) importFrom(shiny,restoreInput) importFrom(shiny,selectizeInput) importFrom(shiny,showModal) importFrom(shiny,tagList) -importFrom(shiny,textAreaInput) importFrom(shiny,textInput) importFrom(shiny,uiOutput) importFrom(shiny,updateActionButton) -importFrom(shiny,updateTextAreaInput) importFrom(shinyWidgets,WinBox) -importFrom(shinyWidgets,alert) importFrom(shinyWidgets,noUiSliderInput) importFrom(shinyWidgets,prettyCheckbox) importFrom(shinyWidgets,updateVirtualSelect) diff --git a/NEWS.md b/NEWS.md index 3dd549ca..af77b755 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,8 +6,6 @@ - *IMPROVED*: docs are updated and much more comprehensive. They will be continuously updated. -Polishing and moved hosted app to new address to fully reflect name change: [https://agdamsbo.shinyapps.io/FreesearchR/](https://agdamsbo.shinyapps.io/FreesearchR/) - # FreesearchR 25.4.2 Polished and simplified data import module including a much improved REDCap import module. diff --git a/R/app_version.R b/R/app_version.R index c99b8062..1fbe1ecb 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'v25.4.3.250424' +app_version <- function()'v25.4.3.250423' diff --git a/R/create-column-mod.R b/R/create-column-mod.R deleted file mode 100644 index f25dbdd8..00000000 --- a/R/create-column-mod.R +++ /dev/null @@ -1,443 +0,0 @@ -#' @title Create new column -#' -#' @description -#' This module allow to enter an expression to create a new column in a `data.frame`. -#' -#' -#' @param id Module's ID. -#' -#' @return A [shiny::reactive()] function returning the data. -#' -#' @note User can only use a subset of function: `r paste(list_allowed_operations(), collapse=", ")`. -#' You can add more operations using the `allowed_operations` argument, for example if you want to allow to use package lubridate, you can do: -#' ```r -#' c(list_allowed_operations(), getNamespaceExports("lubridate")) -#' ``` -#' -#' @export -#' -#' @importFrom htmltools tagList tags css -#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton -#' @importFrom phosphoricons ph -#' @importFrom shinyWidgets virtualSelectInput -#' -#' @name create-column -#' -#' @example example/create_column_module_demo.R -create_column_ui <- function(id) { - ns <- NS(id) - tagList( - # datamods:::html_dependency_datamods(), - # html_dependency_FreesearchR(), - tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") - ), - # tags$head( - # # Note the wrapping of the string in HTML() - # tags$style(HTML(" - # /* modified from esquisse for data types */ - # .btn-column-categorical { - # background-color: #EF562D; - # color: #FFFFFF; - # } - # .btn-column-continuous { - # background-color: #0C4C8A; - # color: #FFFFFF; - # } - # .btn-column-dichotomous { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-datetime { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-id { - # background-color: #848484; - # color: #FFFFFF; - # } - # .btn-column-text { - # background-color: #2E2E2E; - # color: #FFFFFF; - # }")) - # ), - fluidRow( - column( - width = 6, - textInput( - inputId = ns("new_column"), - label = i18n("New column name:"), - value = "new_column1", - width = "100%" - ) - ), - column( - width = 6, - shinyWidgets::virtualSelectInput( - inputId = ns("group_by"), - label = i18n("Group calculation by:"), - choices = NULL, - multiple = TRUE, - disableSelectAll = TRUE, - hasOptionDescription = TRUE, - width = "100%" - ) - ) - ), - textAreaInput( - inputId = ns("expression"), - label = i18n("Enter an expression to define new column:"), - value = "", - width = "100%", - rows = 6 - ), - tags$i( - class = "d-block", - phosphoricons::ph("info"), - datamods::i18n("Click on a column name to add it to the expression:") - ), - uiOutput(outputId = ns("columns")), - uiOutput(outputId = ns("feedback")), - tags$div( - style = css( - display = "grid", - gridTemplateColumns = "3fr 1fr", - columnGap = "10px", - margin = "10px 0" - ), - actionButton( - inputId = ns("compute"), - label = tagList( - phosphoricons::ph("gear"), i18n("Create column") - ), - class = "btn-outline-primary", - width = "100%" - ), - actionButton( - inputId = ns("remove"), - label = tagList( - phosphoricons::ph("trash") - ), - class = "btn-outline-danger", - width = "100%" - ) - ) - ) -} - -#' @param data_r A [shiny::reactive()] function returning a `data.frame`. -#' @param allowed_operations A `list` of allowed operations, see below for details. -#' -#' @export -#' -#' @rdname create-column -#' -#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req -#' updateTextAreaInput reactive bindEvent observe -#' @importFrom shinyWidgets alert updateVirtualSelect -create_column_server <- function(id, - data_r = reactive(NULL), - allowed_operations = list_allowed_operations()) { - moduleServer( - id, - function(input, output, session) { - ns <- session$ns - - info_alert <- shinyWidgets::alert( - status = "info", - phosphoricons::ph("question"), - datamods::i18n("Choose a name for the column to be created or modified,"), - datamods::i18n("then enter an expression before clicking on the button above to validate or on "), - phosphoricons::ph("trash"), datamods::i18n("to delete it.") - ) - - rv <- reactiveValues( - data = NULL, - feedback = info_alert - ) - - observeEvent(input$hidden, rv$feedback <- info_alert) - - bindEvent(observe({ - data <- data_r() - shinyWidgets::updateVirtualSelect( - inputId = "group_by", - choices = make_choices_with_infos(data) - ) - }), data_r(), input$hidden) - - observeEvent(data_r(), rv$data <- data_r()) - - output$feedback <- renderUI(rv$feedback) - - output$columns <- renderUI({ - data <- req(rv$data) - mapply( - label = names(data), - data = data, - FUN = btn_column, - MoreArgs = list(inputId = ns("add_column")), - SIMPLIFY = FALSE - ) - }) - - observeEvent(input$add_column, { - updateTextAreaInput( - session = session, - inputId = "expression", - value = paste0(input$expression, input$add_column) - ) - }) - - observeEvent(input$new_column, { - if (input$new_column == "") { - rv$feedback <- shinyWidgets::alert( - status = "warning", - ph("warning"), datamods::i18n("New column name cannot be empty") - ) - } - }) - - observeEvent(input$remove, { - rv$data[[input$new_column]] <- NULL - }) - observeEvent(input$compute, { - rv$feedback <- try_compute_column( - expression = input$expression, - name = input$new_column, - rv = rv, - allowed_operations = allowed_operations, - by = input$group_by - ) - }) - - return(reactive(rv$data)) - } - ) -} - -#' @export -#' -#' @rdname create-column -# @importFrom methods getGroupMembers -list_allowed_operations <- function() { - c( - "(", "c", - # getGroupMembers("Arith"), - c("+", "-", "*", "^", "%%", "%/%", "/"), - # getGroupMembers("Compare"), - c("==", ">", "<", "!=", "<=", ">="), - # getGroupMembers("Logic"), - c("&", "|"), - # getGroupMembers("Math"), - c( - "abs", "sign", "sqrt", "ceiling", "floor", "trunc", "cummax", - "cummin", "cumprod", "cumsum", "exp", "expm1", "log", "log10", - "log2", "log1p", "cos", "cosh", "sin", "sinh", "tan", "tanh", - "acos", "acosh", "asin", "asinh", "atan", "atanh", "cospi", "sinpi", - "tanpi", "gamma", "lgamma", "digamma", "trigamma" - ), - # getGroupMembers("Math2"), - c("round", "signif"), - # getGroupMembers("Summary"), - c("max", "min", "range", "prod", "sum", "any", "all"), - "pmin", "pmax", "mean", - "paste", "paste0", "substr", "nchar", "trimws", - "gsub", "sub", "grepl", "ifelse", "length", - "as.numeric", "as.character", "as.integer", "as.Date", "as.POSIXct", - "as.factor", "factor" - ) -} - - -#' @inheritParams shiny::modalDialog -#' @export -#' -#' @importFrom shiny showModal modalDialog textInput -#' @importFrom htmltools tagList -#' -#' @rdname create-column -modal_create_column <- function(id, - title = i18n("Create a new column"), - easyClose = TRUE, - size = "l", - footer = NULL) { - ns <- NS(id) - showModal(modalDialog( - title = tagList(title, datamods:::button_close_modal()), - create_column_ui(id), - tags$div( - style = "display: none;", - textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) - ), - easyClose = easyClose, - size = size, - footer = footer - )) -} - -#' @inheritParams shinyWidgets::WinBox -#' @export -#' -#' @importFrom shinyWidgets WinBox wbOptions wbControls -#' @importFrom htmltools tagList -#' @rdname create-column -winbox_create_column <- function(id, - title = i18n("Create a new column"), - options = shinyWidgets::wbOptions(), - controls = shinyWidgets::wbControls()) { - ns <- NS(id) - WinBox( - title = title, - ui = tagList( - create_column_ui(id), - tags$div( - style = "display: none;", - textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) - ) - ), - options = modifyList( - shinyWidgets::wbOptions(height = "550px", modal = TRUE), - options - ), - controls = controls, - auto_height = FALSE - ) -} - - -try_compute_column <- function(expression, - name, - rv, - allowed_operations, - by = NULL) { - parsed <- try(parse(text = expression, keep.source = FALSE), silent = TRUE) - if (inherits(parsed, "try-error")) { - return(datamods:::alert_error(attr(parsed, "condition")$message)) - } - funs <- unlist(c(extract_calls(parsed), lapply(parsed, extract_calls)), recursive = TRUE) - if (!are_allowed_operations(funs, allowed_operations)) { - return(datamods:::alert_error(datamods::i18n("Some operations are not allowed"))) - } - if (!isTruthy(by)) { - result <- try( - rlang::eval_tidy(rlang::parse_expr(expression), data = rv$data), - silent = TRUE - ) - } else { - result <- try( - { - dt <- as.data.table(rv$data) - new_col <- NULL - dt[, new_col := rlang::eval_tidy(rlang::parse_expr(expression), data = .SD), by = by] - dt$new_col - }, - silent = TRUE - ) - } - if (inherits(result, "try-error")) { - return(alert_error(attr(result, "condition")$message)) - } - adding_col <- try(rv$data[[name]] <- result, silent = TRUE) - if (inherits(adding_col, "try-error")) { - return(alert_error(attr(adding_col, "condition")$message)) - } - code <- if (!isTruthy(by)) { - rlang::call2("mutate", !!!rlang::set_names(list(rlang::parse_expr(expression)), name)) - } else { - rlang::call2( - "mutate", - !!!rlang::set_names(list(rlang::parse_expr(expression)), name), - !!!list(.by = rlang::expr(c(!!!rlang::syms(by)))) - ) - } - attr(rv$data, "code") <- Reduce( - f = function(x, y) rlang::expr(!!x %>% !!y), - x = c(attr(rv$data, "code"), code) - ) - shinyWidgets::alert( - status = "success", - ph("check"), datamods::i18n("Column added!") - ) -} - -are_allowed_operations <- function(x, allowed_operations) { - all( - x %in% allowed_operations - ) -} - - -extract_calls <- function(exp) { - if (is.call(exp)) { - return(list( - as.character(exp[[1L]]), - lapply(exp[-1L], extract_calls) - )) - } -} - -alert_error <- function(text) { - alert( - status = "danger", - ph("bug"), text - ) -} - - -btn_column <- function(label, data, inputId) { - icon <- get_var_icon(data, "class") - type <- data_type(data) - tags$button( - type = "button", - class = paste0("btn btn-column-", type), - style = css( - "--bs-btn-padding-y" = ".25rem", - "--bs-btn-padding-x" = ".5rem", - "--bs-btn-font-size" = ".75rem", - "margin-bottom" = "5px" - ), - if (!is.null(icon)) icon, - label, - onclick = sprintf( - "Shiny.setInputValue('%s', '%s', {priority: 'event'})", - inputId, label - ) - ) -} - -make_choices_with_infos <- function(data) { - lapply( - X = seq_along(data), - FUN = function(i) { - nm <- names(data)[i] - values <- data[[nm]] - icon <- get_var_icon(values, "class") - # icon <- if (inherits(values, "character")) { - # phosphoricons::ph("text-aa") - # } else if (inherits(values, "factor")) { - # phosphoricons::ph("list-bullets") - # } else if (inherits(values, c("numeric", "integer"))) { - # phosphoricons::ph("hash") - # } else if (inherits(values, c("Date"))) { - # phosphoricons::ph("calendar") - # } else if (inherits(values, c("POSIXt"))) { - # phosphoricons::ph("clock") - # } else { - # NULL - # } - description <- if (is.atomic(values)) { - paste(i18n("Unique values:"), data.table::uniqueN(values)) - } else { - "" - } - list( - label = htmltools::doRenderTags(tagList( - icon, nm - )), - value = nm, - description = description - ) - } - ) -} diff --git a/R/cut-variable-dates.R b/R/cut-variable-dates.R index d3f95eb5..e18f6150 100644 --- a/R/cut-variable-dates.R +++ b/R/cut-variable-dates.R @@ -56,7 +56,6 @@ cut_var.hms <- function(x, breaks, ...) { #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") -#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%W") cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { breaks_o <- breaks args <- list(...) @@ -127,10 +126,7 @@ cut_var.POSIXct <- cut_var.POSIXt #' @examples #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") -#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "%W") -cut_var.Date <- function(x, breaks=NULL, start.on.monday = TRUE, ...) { - args <- list(...) - +cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { if ("format" %in% names(args)){ assertthat::assert_that(is.character(args$format)) out <- forcats::as_factor(format(x,format=args$format)) @@ -341,11 +337,10 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { variable <- req(input$variable) choices <- c( - # "fixed", # "quantile" ) - if (any(c("hms","POSIXct") %in% class(data[[variable]]))) { + if ("hms" %in% class(data[[variable]])) { choices <- c(choices, "hour") } else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) { choices <- c( @@ -353,7 +348,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { "day", "weekday", "week", - # "week_only", "month", "month_only", "quarter", @@ -378,8 +372,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ) } - choices <- unique(choices) - shinyWidgets::virtualSelectInput( inputId = session$ns("method"), label = i18n("Method:"), @@ -397,7 +389,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { req(input$n_breaks, input$method) if (input$method == "fixed") { req(input$fixed_brks) - if (any(c("hms", "POSIXct") %in% class(data[[variable]]))) { + if (any(c("hms", "POSIXt") %in% class(data[[variable]]))) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = input$fixed_brks) list(var = f, brks = levels(f)) @@ -440,11 +432,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = "hour") list(var = f, brks = levels(f)) - # } else if (input$method %in% c("week_only")) { - # # As a proof of concept a single option to use "format" parameter - # # https://www.stat.berkeley.edu/~s133/dates.html - # f <- cut_var(data[[variable]], format = "%W") - # list(var = f, brks = levels(f)) } else { classInt::classIntervals( var = as.numeric(data[[variable]]), @@ -458,7 +445,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) - # plot_histogram(data = breaks_r()$var, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) }) @@ -596,13 +582,8 @@ modal_cut_variable <- function(id, #' @importFrom graphics abline axis hist par plot.new plot.window -plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color = "#112466") { - if (is.vector(data)){ - x <- data - } else { +plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { x <- data[[column]] - - } x <- as.numeric(x) op <- par(mar = rep(1.5, 4)) on.exit(par(op)) diff --git a/R/data-summary.R b/R/data-summary.R index ccb749bc..f0e6be3f 100644 --- a/R/data-summary.R +++ b/R/data-summary.R @@ -318,9 +318,9 @@ class_icons <- function(x) { shiny::icon("arrow-down-a-z") } else if (identical(x, "logical")) { shiny::icon("toggle-off") - } else if (any(c("Date", "POSIXt") %in% x)) { + } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) { shiny::icon("calendar-days") - } else if (any("POSIXct", "hms") %in% x) { + } else if ("hms" %in% x) { shiny::icon("clock") } else { shiny::icon("table") @@ -360,33 +360,3 @@ type_icons <- function(x) { } } } - -#' Easily get variable icon based on data type or class -#' -#' @param data variable or data frame -#' @param class.type "type" or "class". Default is "class" -#' -#' @returns svg icon -#' @export -#' -#' @examples -#' mtcars[1] |> get_var_icon("class") -#' default_parsing(mtcars) |> get_var_icon() -get_var_icon <- function(data,class.type=c("class","type")){ - if (is.data.frame(data)){ - lapply(data,get_var_icon) - } else { - - class.type <- match.arg(class.type) - - switch(class.type, - type = { - type_icons(data_type(data)) - }, - class = { - class(data)[1] |> class_icons() - } - ) -} - -} diff --git a/R/datagrid-infos-mod.R b/R/datagrid-infos-mod.R deleted file mode 100644 index 6958e6be..00000000 --- a/R/datagrid-infos-mod.R +++ /dev/null @@ -1,348 +0,0 @@ - -#' Display a table in a window -#' -#' @param data a data object (either a `matrix` or a `data.frame`). -#' @param title Title to be displayed in window. -#' @param show_classes Show variables classes under variables names in table header. -#' @param type Display table in a pop-up with [shinyWidgets::show_alert()], -#' in modal window with [shiny::showModal()] or in a WinBox window with [shinyWidgets::WinBox()]. -#' @param options Arguments passed to [toastui::datagrid()]. -#' @param width Width of the window, only used if `type = "popup"` or `type = "winbox"`. -#' @param ... Additional options, such as `wbOptions = wbOptions()` or `wbControls = wbControls()`. -#' -#' @note -#' If you use `type = "winbox"`, you'll need to use `shinyWidgets::html_dependency_winbox()` somewhere in your UI. -#' -#' @return No value. -#' @export -#' -#' @importFrom htmltools tags tagList css -#' @importFrom shiny showModal modalDialog -#' @importFrom utils modifyList packageVersion -#' -#' @example examples/show_data.R -show_data <- function(data, - title = NULL, - options = NULL, - show_classes = TRUE, - type = c("popup", "modal", "winbox"), - width = "65%", - ...) { # nocov start - type <- match.arg(type) - data <- as.data.frame(data) - args <- list(...) - gridTheme <- getOption("datagrid.theme") - if (length(gridTheme) < 1) { - datamods:::apply_grid_theme() - } - on.exit(toastui::reset_grid_theme()) - - if (is.null(options)) - options <- list() - - options$height <- 550 - options$minBodyHeight <- 400 - options$data <- data - options$theme <- "default" - options$colwidths <- "guess" - options$guess_colwidths_opts <- list(min_width = 90, max_width = 400, mul = 1, add = 10) - if (isTRUE(show_classes)) - options$summary <- construct_col_summary(data) - datatable <- rlang::exec(toastui::datagrid, !!!options) - datatable <- toastui::grid_columns(datatable, className = "font-monospace") - if (identical(type, "winbox")) { - stopifnot( - "You need shinyWidgets >= 0.8.4" = packageVersion("shinyWidgets") >= "0.8.4" - ) - wb_options <- if (is.null(args$wbOptions)) { - shinyWidgets::wbOptions( - height = "600px", - width = width, - modal = TRUE - ) - } else { - modifyList( - shinyWidgets::wbOptions( - height = "600px", - width = width, - modal = TRUE - ), - args$wbOptions - ) - } - wb_controls <- if (is.null(args$wbControls)) { - shinyWidgets::wbControls() - } else { - args$wbControls - } - shinyWidgets::WinBox( - title = title, - ui = datatable, - options = wb_options, - controls = wb_controls, - padding = "0 5px" - ) - } else if (identical(type, "popup")) { - shinyWidgets::show_alert( - title = NULL, - text = tags$div( - if (!is.null(title)) { - tagList( - tags$h3(title), - tags$hr() - ) - }, - style = "color: #000 !important;", - datatable - ), - closeOnClickOutside = TRUE, - showCloseButton = TRUE, - btn_labels = NA, - html = TRUE, - width = width - ) - } else { - showModal(modalDialog( - title = tagList( - datamods:::button_close_modal(), - title - ), - tags$div( - style = css(minHeight = validateCssUnit(options$height)), - toastui::renderDatagrid2(datatable) - ), - size = "xl", - footer = NULL, - easyClose = TRUE - )) - } -} # nocov end - - - -#' @importFrom htmltools tagList tags css -describe_col_char <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("text-aa"), - "character" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Unique:"), length(unique(x)) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - style = css(whiteSpace = "normal", wordBreak = "break-all"), - i18n("Most Common:"), gsub( - pattern = "'", - replacement = "\u07F4", - x = names(sort(table(x), decreasing = TRUE))[1] - ) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -fmt_p <- function(val, tot) { - paste0(round(val / tot * 100, 1), "%") -} - -describe_col_factor <- function(x, with_summary = TRUE) { - count <- sort(table(x, useNA = "always"), decreasing = TRUE) - total <- sum(count) - one <- count[!is.na(names(count))][1] - two <- count[!is.na(names(count))][2] - missing <- count[is.na(names(count))] - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("list-bullets"), - "factor" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - names(one), ":", fmt_p(one, total) - ), - tags$div( - names(two), ":", fmt_p(two, total) - ), - tags$div( - "Missing", ":", fmt_p(missing, total) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -describe_col_num <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("hash"), - "numeric" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Min:"), round(min(x, na.rm = TRUE), 2) - ), - tags$div( - i18n("Mean:"), round(mean(x, na.rm = TRUE), 2) - ), - tags$div( - i18n("Max:"), round(max(x, na.rm = TRUE), 2) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ) - ) - } - ) -} - - -describe_col_date <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("calendar"), - "date" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Min:"), min(x, na.rm = TRUE) - ), - tags$div( - i18n("Max:"), max(x, na.rm = TRUE) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -describe_col_datetime <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("clock"), - "datetime" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Min:"), min(x, na.rm = TRUE) - ), - tags$div( - i18n("Max:"), max(x, na.rm = TRUE) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - - -describe_col_other <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("clock"), - paste(class(x), collapse = ", ") - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Unique:"), length(unique(x)) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - "\u00A0" - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -construct_col_summary <- function(data) { - list( - position = "top", - height = 90, - columnContent = lapply( - X = setNames(names(data), names(data)), - FUN = function(col) { - values <- data[[col]] - content <- if (inherits(values, "character")) { - describe_col_char(values) - } else if (inherits(values, "factor")) { - describe_col_factor(values) - } else if (inherits(values, c("numeric", "integer"))) { - describe_col_num(values) - } else if (inherits(values, c("Date"))) { - describe_col_date(values) - } else if (inherits(values, c("POSIXt"))) { - describe_col_datetime(values) - } else { - describe_col_other(values) - } - list( - template = toastui::JS( - "function(value) {", - sprintf( - "return '%s';", - gsub(replacement = "", pattern = "\n", x = htmltools::doRenderTags(content)) - ), - "}" - ) - ) - } - ) - ) -} diff --git a/R/html_dependency_freesearchr.R b/R/html_dependency_freesearchr.R deleted file mode 100644 index bf46e471..00000000 --- a/R/html_dependency_freesearchr.R +++ /dev/null @@ -1,9 +0,0 @@ -html_dependency_FreesearchR <- function() { - htmltools::htmlDependency( - name = "FreesearchR", - version = packageVersion("FreesearchR"), - src = list(href = "FreesearchR", file = "assets"), - package = "FreesearchR", - stylesheet = "css/FreesearchR.css" - ) -} diff --git a/R/sysdata.rda b/R/sysdata.rda index 51dd6d09..b9989b2e 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/theme.R b/R/theme.R index d0852ada..15fc5f4b 100644 --- a/R/theme.R +++ b/R/theme.R @@ -6,23 +6,23 @@ #' @export custom_theme <- function(..., version = 5, - primary = FreesearchR_colors("primary"), - secondary = FreesearchR_colors("secondary"), + primary = "#1E4A8F", + secondary = "#FF6F61", bootswatch = "united", base_font = bslib::font_google("Montserrat"), - heading_font = bslib::font_google("Public Sans", wght = "700"), - code_font = bslib::font_google("Open Sans"), - success = FreesearchR_colors("success"), - info = FreesearchR_colors("info"), - warning = FreesearchR_colors("warning"), - danger = FreesearchR_colors("danger") + heading_font = bslib::font_google("Public Sans",wght = "700"), + code_font = bslib::font_google("Open Sans") + # success = "#1E4A8F", + # info = , + # warning = , + # danger = , # fg = "#000", # bg="#fff", # base_font = bslib::font_google("Alice"), # heading_font = bslib::font_google("Jost", wght = "800"), # heading_font = bslib::font_google("Noto Serif"), # heading_font = bslib::font_google("Alice"), -) { + ){ bslib::bs_theme( ..., "navbar-bg" = primary, @@ -32,37 +32,10 @@ custom_theme <- function(..., bootswatch = bootswatch, base_font = base_font, heading_font = heading_font, - code_font = code_font, - success=success, - info=info, - warning=warning, - danger=danger + code_font = code_font ) } -FreesearchR_colors <- function(choose = NULL) { - out <- c( - primary = "#1E4A8F", - secondary = "#FF6F61", - success = "#00C896", - warning = "#FFB100", - danger = "#FF3A2F", - extra = "#8A4FFF", - info = "#11A0EC", - bg = "#FFFFFF", - dark = "#2D2D42", - fg = "#000000" - ) - if (!is.null(choose)) { - out[choose] - } else { - out - } -} - - - - #' GGplot default theme for plotting in Shiny #' @@ -71,16 +44,16 @@ FreesearchR_colors <- function(choose = NULL) { #' @returns ggplot object #' @export #' -gg_theme_shiny <- function() { - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text = ggplot2::element_text(size = 14), - strip.text = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24), - plot.subtitle = ggplot2::element_text(size = 18) - ) +gg_theme_shiny <- function(){ + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text = ggplot2::element_text(size = 14), + strip.text = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24), + plot.subtitle = ggplot2::element_text(size = 18) + ) } @@ -91,12 +64,12 @@ gg_theme_shiny <- function() { #' @returns ggplot object #' @export #' -gg_theme_export <- function() { - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text.x = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24) - ) +gg_theme_export <- function(){ + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text.x = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24) + ) } diff --git a/README.md b/README.md index 989d2ed4..87eb19c6 100644 --- a/README.md +++ b/README.md @@ -4,12 +4,12 @@ [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.14527429.svg)](https://doi.org/10.5281/zenodo.14527429) [![rhub](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml/badge.svg)](https://github.com/agdamsbo/FreesearchR/actions/workflows/rhub.yaml) -[![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/FreesearchR/) +[![FreesearchR](https://img.shields.io/badge/Shiny-shinyapps.io-blue?style=flat&labelColor=white&logo=RStudio&logoColor=blue)](https://agdamsbo.shinyapps.io/freesearcheR/) This package is the backbone of the ***FreesearchR***, a free and open-source browser based data exploration and analysis tool intended to democratise clinical research by assisting any researcher to easily evaluate and analyse data and export publication ready results. -The ***FreesearchR***-tool is online and accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearchR/). All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out! +The ***FreesearchR***-tool is online and accessible here: [link to the app freely hosted on shinyapps.io](https://agdamsbo.shinyapps.io/FreesearcheR/). All feedback is welcome and can be shared as a GitHub issue. Any suggestions on collaboration is much welcomed. Please reach out! ## Motivation diff --git a/SESSION.md b/SESSION.md index 8620ab6f..674d463a 100644 --- a/SESSION.md +++ b/SESSION.md @@ -11,11 +11,11 @@ |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |Europe/Copenhagen | -|date |2025-04-24 | +|date |2025-04-23 | |rstudio |2024.12.1+563 Kousa Dogwood (desktop) | |pandoc |3.6.4 @ /opt/homebrew/bin/ (via rmarkdown) | |quarto |1.6.40 @ /usr/local/bin/quarto | -|FreesearchR |25.4.3.250424 | +|FreesearchR |25.4.3.250423 | -------------------------------------------------------------------------------- @@ -39,7 +39,8 @@ |cellranger |1.1.0 |2016-07-27 |CRAN (R 4.4.0) | |class |7.3-23 |2025-01-01 |CRAN (R 4.4.1) | |classInt |0.4-11 |2025-01-08 |CRAN (R 4.4.1) | -|cli |3.6.5 |2025-04-23 |CRAN (R 4.4.1) | +|cli |3.6.4 |2025-02-13 |CRAN (R 4.4.1) | +|clipr |0.8.0 |2022-02-22 |CRAN (R 4.4.1) | |colorspace |2.1-1 |2024-07-26 |CRAN (R 4.4.1) | |commonmark |1.9.5 |2025-03-17 |CRAN (R 4.4.1) | |correlation |0.8.7 |2025-03-03 |CRAN (R 4.4.1) | @@ -59,6 +60,7 @@ |easystats |0.7.4 |2025-02-06 |CRAN (R 4.4.1) | |effectsize |1.0.0 |2024-12-10 |CRAN (R 4.4.1) | |ellipsis |0.3.2 |2021-04-29 |CRAN (R 4.4.1) | +|esquisse |2.1.0 |2025-02-21 |CRAN (R 4.4.1) | |evaluate |1.0.3 |2025-01-10 |CRAN (R 4.4.1) | |farver |2.1.2 |2024-05-13 |CRAN (R 4.4.1) | |fastmap |1.2.0 |2024-05-15 |CRAN (R 4.4.1) | @@ -88,6 +90,7 @@ |lattice |0.22-7 |2025-04-02 |CRAN (R 4.4.1) | |lifecycle |1.0.4 |2023-11-07 |CRAN (R 4.4.1) | |lme4 |1.1-37 |2025-03-26 |CRAN (R 4.4.1) | +|magick |2.8.6 |NA |NA | |magrittr |2.0.3 |2022-03-30 |CRAN (R 4.4.1) | |MASS |7.3-65 |2025-02-28 |CRAN (R 4.4.1) | |Matrix |1.7-3 |2025-03-11 |CRAN (R 4.4.1) | @@ -101,6 +104,7 @@ |nloptr |2.2.1 |2025-03-17 |CRAN (R 4.4.1) | |openssl |2.3.2 |2025-02-03 |CRAN (R 4.4.1) | |openxlsx2 |1.14 |2025-03-20 |CRAN (R 4.4.1) | +|pak |0.8.0.2 |2025-04-08 |CRAN (R 4.4.1) | |parameters |0.24.2 |2025-03-04 |CRAN (R 4.4.1) | |patchwork |1.3.0 |2024-09-16 |CRAN (R 4.4.1) | |performance |0.13.0 |2025-01-15 |CRAN (R 4.4.1) | @@ -108,6 +112,7 @@ |pillar |1.10.2 |2025-04-05 |CRAN (R 4.4.1) | |pkgbuild |1.4.7 |2025-03-24 |CRAN (R 4.4.1) | |pkgconfig |2.0.3 |2019-09-22 |CRAN (R 4.4.1) | +|pkgdown |2.1.1 |2024-09-17 |CRAN (R 4.4.1) | |pkgload |1.4.0 |2024-06-28 |CRAN (R 4.4.0) | |processx |3.8.6 |2025-02-21 |CRAN (R 4.4.1) | |profvis |0.4.0 |2024-09-20 |CRAN (R 4.4.1) | @@ -116,10 +121,6 @@ |ps |1.9.1 |2025-04-12 |CRAN (R 4.4.1) | |purrr |1.0.4 |2025-02-05 |CRAN (R 4.4.1) | |quarto |1.4.4 |2024-07-20 |CRAN (R 4.4.0) | -|R.cache |0.16.0 |2022-07-21 |CRAN (R 4.4.0) | -|R.methodsS3 |1.8.2 |2022-06-13 |CRAN (R 4.4.1) | -|R.oo |1.27.0 |2024-11-01 |CRAN (R 4.4.1) | -|R.utils |2.13.0 |2025-02-24 |CRAN (R 4.4.1) | |R6 |2.6.1 |2025-02-15 |CRAN (R 4.4.1) | |rbibutils |2.3 |2024-10-04 |CRAN (R 4.4.1) | |RColorBrewer |1.1-3 |2022-04-03 |CRAN (R 4.4.1) | @@ -129,8 +130,6 @@ |readODS |2.3.2 |2025-01-13 |CRAN (R 4.4.1) | |readr |2.1.5 |2024-01-10 |CRAN (R 4.4.0) | |readxl |1.4.5 |2025-03-07 |CRAN (R 4.4.1) | -|REDCapCAST |25.3.2 |2025-03-10 |CRAN (R 4.4.1) | -|REDCapR |1.4.0 |2025-01-11 |CRAN (R 4.4.1) | |reformulas |0.4.0 |2024-11-03 |CRAN (R 4.4.1) | |remotes |2.5.0 |2024-03-17 |CRAN (R 4.4.1) | |renv |1.1.4 |2025-03-20 |CRAN (R 4.4.1) | @@ -150,7 +149,6 @@ |shinyTime |1.0.3 |2022-08-19 |CRAN (R 4.4.0) | |shinyWidgets |0.9.0 |2025-02-21 |CRAN (R 4.4.1) | |stringi |1.8.7 |2025-03-27 |CRAN (R 4.4.1) | -|styler |1.10.3 |2024-04-07 |CRAN (R 4.4.0) | |tibble |3.2.1 |2023-03-20 |CRAN (R 4.4.0) | |tidyr |1.3.1 |2024-01-24 |CRAN (R 4.4.1) | |tidyselect |1.2.1 |2024-03-11 |CRAN (R 4.4.0) | diff --git a/examples/create_column_module_demo.R b/examples/create_column_module_demo.R deleted file mode 100644 index 6c96ec48..00000000 --- a/examples/create_column_module_demo.R +++ /dev/null @@ -1,69 +0,0 @@ - -library(shiny) -library(reactable) - -ui <- fluidPage( - theme = bslib::bs_theme(version = 5L, preset = "bootstrap"), - shinyWidgets::html_dependency_winbox(), - tags$h2("Create new column"), - fluidRow( - column( - width = 4, - create_column_ui("inline"), - actionButton("modal", "Or click here to open a modal to create a column"), - tags$br(), tags$br(), - actionButton("winbox", "Or click here to open a WinBox to create a column") - ), - column( - width = 8, - reactableOutput(outputId = "table"), - verbatimTextOutput("code") - ) - ) -) - -server <- function(input, output, session) { - - rv <- reactiveValues(data = MASS::Cars93[, c(1, 3, 4, 5, 6, 10)]) - - # inline mode - data_inline_r <- create_column_server( - id = "inline", - data_r = reactive(rv$data) - ) - observeEvent(data_inline_r(), rv$data <- data_inline_r()) - - # modal window mode - observeEvent(input$modal, modal_create_column("modal")) - data_modal_r <- create_column_server( - id = "modal", - data_r = reactive(rv$data) - ) - observeEvent(data_modal_r(), rv$data <- data_modal_r()) - - # WinBox window mode - observeEvent(input$winbox, winbox_create_column("winbox")) - data_winbox_r <- create_column_server( - id = "winbox", - data_r = reactive(rv$data) - ) - observeEvent(data_winbox_r(), rv$data <- data_winbox_r()) - - # Show result - output$table <- renderReactable({ - data <- req(rv$data) - reactable( - data = data, - bordered = TRUE, - compact = TRUE, - striped = TRUE - ) - }) - - output$code <- renderPrint({ - attr(rv$data, "code") - }) -} - -if (interactive()) - shinyApp(ui, server) diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index b041778d..b3606e63 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -10,7 +10,7 @@ #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'v25.4.3.250424' +app_version <- function()'v25.4.3.250423' ######## @@ -300,455 +300,6 @@ sentence_paste <- function(data, and.str = "and") { -######## -#### Current file: /Users/au301842/FreesearchR/R//create-column-mod.R -######## - -#' @title Create new column -#' -#' @description -#' This module allow to enter an expression to create a new column in a `data.frame`. -#' -#' -#' @param id Module's ID. -#' -#' @return A [shiny::reactive()] function returning the data. -#' -#' @note User can only use a subset of function: `r paste(list_allowed_operations(), collapse=", ")`. -#' You can add more operations using the `allowed_operations` argument, for example if you want to allow to use package lubridate, you can do: -#' ```r -#' c(list_allowed_operations(), getNamespaceExports("lubridate")) -#' ``` -#' -#' @export -#' -#' @importFrom htmltools tagList tags css -#' @importFrom shiny NS textInput textAreaInput uiOutput actionButton -#' @importFrom phosphoricons ph -#' @importFrom shinyWidgets virtualSelectInput -#' -#' @name create-column -#' -#' @example example/create_column_module_demo.R -create_column_ui <- function(id) { - ns <- NS(id) - tagList( - # datamods:::html_dependency_datamods(), - # html_dependency_FreesearchR(), - tags$head( - tags$link(rel = "stylesheet", type = "text/css", href = "FreesearchR/inst/assets/css/FreesearchR.css") - ), - # tags$head( - # # Note the wrapping of the string in HTML() - # tags$style(HTML(" - # /* modified from esquisse for data types */ - # .btn-column-categorical { - # background-color: #EF562D; - # color: #FFFFFF; - # } - # .btn-column-continuous { - # background-color: #0C4C8A; - # color: #FFFFFF; - # } - # .btn-column-dichotomous { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-datetime { - # background-color: #97D5E0; - # color: #FFFFFF; - # } - # .btn-column-id { - # background-color: #848484; - # color: #FFFFFF; - # } - # .btn-column-text { - # background-color: #2E2E2E; - # color: #FFFFFF; - # }")) - # ), - fluidRow( - column( - width = 6, - textInput( - inputId = ns("new_column"), - label = i18n("New column name:"), - value = "new_column1", - width = "100%" - ) - ), - column( - width = 6, - shinyWidgets::virtualSelectInput( - inputId = ns("group_by"), - label = i18n("Group calculation by:"), - choices = NULL, - multiple = TRUE, - disableSelectAll = TRUE, - hasOptionDescription = TRUE, - width = "100%" - ) - ) - ), - textAreaInput( - inputId = ns("expression"), - label = i18n("Enter an expression to define new column:"), - value = "", - width = "100%", - rows = 6 - ), - tags$i( - class = "d-block", - phosphoricons::ph("info"), - datamods::i18n("Click on a column name to add it to the expression:") - ), - uiOutput(outputId = ns("columns")), - uiOutput(outputId = ns("feedback")), - tags$div( - style = css( - display = "grid", - gridTemplateColumns = "3fr 1fr", - columnGap = "10px", - margin = "10px 0" - ), - actionButton( - inputId = ns("compute"), - label = tagList( - phosphoricons::ph("gear"), i18n("Create column") - ), - class = "btn-outline-primary", - width = "100%" - ), - actionButton( - inputId = ns("remove"), - label = tagList( - phosphoricons::ph("trash") - ), - class = "btn-outline-danger", - width = "100%" - ) - ) - ) -} - -#' @param data_r A [shiny::reactive()] function returning a `data.frame`. -#' @param allowed_operations A `list` of allowed operations, see below for details. -#' -#' @export -#' -#' @rdname create-column -#' -#' @importFrom shiny moduleServer reactiveValues observeEvent renderUI req -#' updateTextAreaInput reactive bindEvent observe -#' @importFrom shinyWidgets alert updateVirtualSelect -create_column_server <- function(id, - data_r = reactive(NULL), - allowed_operations = list_allowed_operations()) { - moduleServer( - id, - function(input, output, session) { - ns <- session$ns - - info_alert <- shinyWidgets::alert( - status = "info", - phosphoricons::ph("question"), - datamods::i18n("Choose a name for the column to be created or modified,"), - datamods::i18n("then enter an expression before clicking on the button above to validate or on "), - phosphoricons::ph("trash"), datamods::i18n("to delete it.") - ) - - rv <- reactiveValues( - data = NULL, - feedback = info_alert - ) - - observeEvent(input$hidden, rv$feedback <- info_alert) - - bindEvent(observe({ - data <- data_r() - shinyWidgets::updateVirtualSelect( - inputId = "group_by", - choices = make_choices_with_infos(data) - ) - }), data_r(), input$hidden) - - observeEvent(data_r(), rv$data <- data_r()) - - output$feedback <- renderUI(rv$feedback) - - output$columns <- renderUI({ - data <- req(rv$data) - mapply( - label = names(data), - data = data, - FUN = btn_column, - MoreArgs = list(inputId = ns("add_column")), - SIMPLIFY = FALSE - ) - }) - - observeEvent(input$add_column, { - updateTextAreaInput( - session = session, - inputId = "expression", - value = paste0(input$expression, input$add_column) - ) - }) - - observeEvent(input$new_column, { - if (input$new_column == "") { - rv$feedback <- shinyWidgets::alert( - status = "warning", - ph("warning"), datamods::i18n("New column name cannot be empty") - ) - } - }) - - observeEvent(input$remove, { - rv$data[[input$new_column]] <- NULL - }) - observeEvent(input$compute, { - rv$feedback <- try_compute_column( - expression = input$expression, - name = input$new_column, - rv = rv, - allowed_operations = allowed_operations, - by = input$group_by - ) - }) - - return(reactive(rv$data)) - } - ) -} - -#' @export -#' -#' @rdname create-column -# @importFrom methods getGroupMembers -list_allowed_operations <- function() { - c( - "(", "c", - # getGroupMembers("Arith"), - c("+", "-", "*", "^", "%%", "%/%", "/"), - # getGroupMembers("Compare"), - c("==", ">", "<", "!=", "<=", ">="), - # getGroupMembers("Logic"), - c("&", "|"), - # getGroupMembers("Math"), - c( - "abs", "sign", "sqrt", "ceiling", "floor", "trunc", "cummax", - "cummin", "cumprod", "cumsum", "exp", "expm1", "log", "log10", - "log2", "log1p", "cos", "cosh", "sin", "sinh", "tan", "tanh", - "acos", "acosh", "asin", "asinh", "atan", "atanh", "cospi", "sinpi", - "tanpi", "gamma", "lgamma", "digamma", "trigamma" - ), - # getGroupMembers("Math2"), - c("round", "signif"), - # getGroupMembers("Summary"), - c("max", "min", "range", "prod", "sum", "any", "all"), - "pmin", "pmax", "mean", - "paste", "paste0", "substr", "nchar", "trimws", - "gsub", "sub", "grepl", "ifelse", "length", - "as.numeric", "as.character", "as.integer", "as.Date", "as.POSIXct", - "as.factor", "factor" - ) -} - - -#' @inheritParams shiny::modalDialog -#' @export -#' -#' @importFrom shiny showModal modalDialog textInput -#' @importFrom htmltools tagList -#' -#' @rdname create-column -modal_create_column <- function(id, - title = i18n("Create a new column"), - easyClose = TRUE, - size = "l", - footer = NULL) { - ns <- NS(id) - showModal(modalDialog( - title = tagList(title, datamods:::button_close_modal()), - create_column_ui(id), - tags$div( - style = "display: none;", - textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) - ), - easyClose = easyClose, - size = size, - footer = footer - )) -} - -#' @inheritParams shinyWidgets::WinBox -#' @export -#' -#' @importFrom shinyWidgets WinBox wbOptions wbControls -#' @importFrom htmltools tagList -#' @rdname create-column -winbox_create_column <- function(id, - title = i18n("Create a new column"), - options = shinyWidgets::wbOptions(), - controls = shinyWidgets::wbControls()) { - ns <- NS(id) - WinBox( - title = title, - ui = tagList( - create_column_ui(id), - tags$div( - style = "display: none;", - textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId()) - ) - ), - options = modifyList( - shinyWidgets::wbOptions(height = "550px", modal = TRUE), - options - ), - controls = controls, - auto_height = FALSE - ) -} - - -try_compute_column <- function(expression, - name, - rv, - allowed_operations, - by = NULL) { - parsed <- try(parse(text = expression, keep.source = FALSE), silent = TRUE) - if (inherits(parsed, "try-error")) { - return(datamods:::alert_error(attr(parsed, "condition")$message)) - } - funs <- unlist(c(extract_calls(parsed), lapply(parsed, extract_calls)), recursive = TRUE) - if (!are_allowed_operations(funs, allowed_operations)) { - return(datamods:::alert_error(datamods::i18n("Some operations are not allowed"))) - } - if (!isTruthy(by)) { - result <- try( - rlang::eval_tidy(rlang::parse_expr(expression), data = rv$data), - silent = TRUE - ) - } else { - result <- try( - { - dt <- as.data.table(rv$data) - new_col <- NULL - dt[, new_col := rlang::eval_tidy(rlang::parse_expr(expression), data = .SD), by = by] - dt$new_col - }, - silent = TRUE - ) - } - if (inherits(result, "try-error")) { - return(alert_error(attr(result, "condition")$message)) - } - adding_col <- try(rv$data[[name]] <- result, silent = TRUE) - if (inherits(adding_col, "try-error")) { - return(alert_error(attr(adding_col, "condition")$message)) - } - code <- if (!isTruthy(by)) { - rlang::call2("mutate", !!!rlang::set_names(list(rlang::parse_expr(expression)), name)) - } else { - rlang::call2( - "mutate", - !!!rlang::set_names(list(rlang::parse_expr(expression)), name), - !!!list(.by = rlang::expr(c(!!!rlang::syms(by)))) - ) - } - attr(rv$data, "code") <- Reduce( - f = function(x, y) rlang::expr(!!x %>% !!y), - x = c(attr(rv$data, "code"), code) - ) - shinyWidgets::alert( - status = "success", - ph("check"), datamods::i18n("Column added!") - ) -} - -are_allowed_operations <- function(x, allowed_operations) { - all( - x %in% allowed_operations - ) -} - - -extract_calls <- function(exp) { - if (is.call(exp)) { - return(list( - as.character(exp[[1L]]), - lapply(exp[-1L], extract_calls) - )) - } -} - -alert_error <- function(text) { - alert( - status = "danger", - ph("bug"), text - ) -} - - -btn_column <- function(label, data, inputId) { - icon <- get_var_icon(data, "class") - type <- data_type(data) - tags$button( - type = "button", - class = paste0("btn btn-column-", type), - style = css( - "--bs-btn-padding-y" = ".25rem", - "--bs-btn-padding-x" = ".5rem", - "--bs-btn-font-size" = ".75rem", - "margin-bottom" = "5px" - ), - if (!is.null(icon)) icon, - label, - onclick = sprintf( - "Shiny.setInputValue('%s', '%s', {priority: 'event'})", - inputId, label - ) - ) -} - -make_choices_with_infos <- function(data) { - lapply( - X = seq_along(data), - FUN = function(i) { - nm <- names(data)[i] - values <- data[[nm]] - icon <- get_var_icon(values, "class") - # icon <- if (inherits(values, "character")) { - # phosphoricons::ph("text-aa") - # } else if (inherits(values, "factor")) { - # phosphoricons::ph("list-bullets") - # } else if (inherits(values, c("numeric", "integer"))) { - # phosphoricons::ph("hash") - # } else if (inherits(values, c("Date"))) { - # phosphoricons::ph("calendar") - # } else if (inherits(values, c("POSIXt"))) { - # phosphoricons::ph("clock") - # } else { - # NULL - # } - description <- if (is.atomic(values)) { - paste(i18n("Unique values:"), data.table::uniqueN(values)) - } else { - "" - } - list( - label = htmltools::doRenderTags(tagList( - icon, nm - )), - value = nm, - description = description - ) - } - ) -} - - ######## #### Current file: /Users/au301842/FreesearchR/R//custom_SelectInput.R ######## @@ -1005,7 +556,6 @@ cut_var.hms <- function(x, breaks, ...) { #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") #' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%A-%H") -#' readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "%W") cut_var.POSIXt <- function(x, breaks, right = FALSE, include.lowest = TRUE, start.on.monday = TRUE, ...) { breaks_o <- breaks args <- list(...) @@ -1076,10 +626,7 @@ cut_var.POSIXct <- cut_var.POSIXt #' @examples #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) #' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") -#' as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "%W") -cut_var.Date <- function(x, breaks=NULL, start.on.monday = TRUE, ...) { - args <- list(...) - +cut_var.Date <- function(x, breaks, start.on.monday = TRUE, ...) { if ("format" %in% names(args)){ assertthat::assert_that(is.character(args$format)) out <- forcats::as_factor(format(x,format=args$format)) @@ -1290,11 +837,10 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { variable <- req(input$variable) choices <- c( - # "fixed", # "quantile" ) - if (any(c("hms","POSIXct") %in% class(data[[variable]]))) { + if ("hms" %in% class(data[[variable]])) { choices <- c(choices, "hour") } else if (any(c("POSIXt", "Date") %in% class(data[[variable]]))) { choices <- c( @@ -1302,7 +848,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { "day", "weekday", "week", - # "week_only", "month", "month_only", "quarter", @@ -1327,8 +872,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { ) } - choices <- unique(choices) - shinyWidgets::virtualSelectInput( inputId = session$ns("method"), label = i18n("Method:"), @@ -1346,7 +889,7 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { req(input$n_breaks, input$method) if (input$method == "fixed") { req(input$fixed_brks) - if (any(c("hms", "POSIXct") %in% class(data[[variable]]))) { + if (any(c("hms", "POSIXt") %in% class(data[[variable]]))) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = input$fixed_brks) list(var = f, brks = levels(f)) @@ -1389,11 +932,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { # cut.POSIXct <- cut.POSIXt f <- cut_var(data[[variable]], breaks = "hour") list(var = f, brks = levels(f)) - # } else if (input$method %in% c("week_only")) { - # # As a proof of concept a single option to use "format" parameter - # # https://www.stat.berkeley.edu/~s133/dates.html - # f <- cut_var(data[[variable]], format = "%W") - # list(var = f, brks = levels(f)) } else { classInt::classIntervals( var = as.numeric(data[[variable]]), @@ -1407,7 +945,6 @@ cut_variable_server <- function(id, data_r = reactive(NULL)) { data <- req(data_r()) variable <- req(input$variable) plot_histogram(data, variable, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) - # plot_histogram(data = breaks_r()$var, breaks = breaks_r()$brks, color = datamods:::get_primary_color()) }) @@ -1545,13 +1082,8 @@ modal_cut_variable <- function(id, #' @importFrom graphics abline axis hist par plot.new plot.window -plot_histogram <- function(data, column=NULL, bins = 30, breaks = NULL, color = "#112466") { - if (is.vector(data)){ - x <- data - } else { +plot_histogram <- function(data, column, bins = 30, breaks = NULL, color = "#112466") { x <- data[[column]] - - } x <- as.numeric(x) op <- par(mar = rep(1.5, 4)) on.exit(par(op)) @@ -2828,9 +2360,9 @@ class_icons <- function(x) { shiny::icon("arrow-down-a-z") } else if (identical(x, "logical")) { shiny::icon("toggle-off") - } else if (any(c("Date", "POSIXt") %in% x)) { + } else if (any(c("Date", "POSIXct", "POSIXt") %in% x)) { shiny::icon("calendar-days") - } else if (any("POSIXct", "hms") %in% x) { + } else if ("hms" %in% x) { shiny::icon("clock") } else { shiny::icon("table") @@ -2871,390 +2403,6 @@ type_icons <- function(x) { } } -#' Easily get variable icon based on data type or class -#' -#' @param data variable or data frame -#' @param class.type "type" or "class". Default is "class" -#' -#' @returns svg icon -#' @export -#' -#' @examples -#' mtcars[1] |> get_var_icon("class") -#' default_parsing(mtcars) |> get_var_icon() -get_var_icon <- function(data,class.type=c("class","type")){ - if (is.data.frame(data)){ - lapply(data,get_var_icon) - } else { - - class.type <- match.arg(class.type) - - switch(class.type, - type = { - type_icons(data_type(data)) - }, - class = { - class(data)[1] |> class_icons() - } - ) -} - -} - - -######## -#### Current file: /Users/au301842/FreesearchR/R//datagrid-infos-mod.R -######## - - -#' Display a table in a window -#' -#' @param data a data object (either a `matrix` or a `data.frame`). -#' @param title Title to be displayed in window. -#' @param show_classes Show variables classes under variables names in table header. -#' @param type Display table in a pop-up with [shinyWidgets::show_alert()], -#' in modal window with [shiny::showModal()] or in a WinBox window with [shinyWidgets::WinBox()]. -#' @param options Arguments passed to [toastui::datagrid()]. -#' @param width Width of the window, only used if `type = "popup"` or `type = "winbox"`. -#' @param ... Additional options, such as `wbOptions = wbOptions()` or `wbControls = wbControls()`. -#' -#' @note -#' If you use `type = "winbox"`, you'll need to use `shinyWidgets::html_dependency_winbox()` somewhere in your UI. -#' -#' @return No value. -#' @export -#' -#' @importFrom htmltools tags tagList css -#' @importFrom shiny showModal modalDialog -#' @importFrom utils modifyList packageVersion -#' -#' @example examples/show_data.R -show_data <- function(data, - title = NULL, - options = NULL, - show_classes = TRUE, - type = c("popup", "modal", "winbox"), - width = "65%", - ...) { # nocov start - type <- match.arg(type) - data <- as.data.frame(data) - args <- list(...) - gridTheme <- getOption("datagrid.theme") - if (length(gridTheme) < 1) { - datamods:::apply_grid_theme() - } - on.exit(toastui::reset_grid_theme()) - - if (is.null(options)) - options <- list() - - options$height <- 550 - options$minBodyHeight <- 400 - options$data <- data - options$theme <- "default" - options$colwidths <- "guess" - options$guess_colwidths_opts <- list(min_width = 90, max_width = 400, mul = 1, add = 10) - if (isTRUE(show_classes)) - options$summary <- construct_col_summary(data) - datatable <- rlang::exec(toastui::datagrid, !!!options) - datatable <- toastui::grid_columns(datatable, className = "font-monospace") - if (identical(type, "winbox")) { - stopifnot( - "You need shinyWidgets >= 0.8.4" = packageVersion("shinyWidgets") >= "0.8.4" - ) - wb_options <- if (is.null(args$wbOptions)) { - shinyWidgets::wbOptions( - height = "600px", - width = width, - modal = TRUE - ) - } else { - modifyList( - shinyWidgets::wbOptions( - height = "600px", - width = width, - modal = TRUE - ), - args$wbOptions - ) - } - wb_controls <- if (is.null(args$wbControls)) { - shinyWidgets::wbControls() - } else { - args$wbControls - } - shinyWidgets::WinBox( - title = title, - ui = datatable, - options = wb_options, - controls = wb_controls, - padding = "0 5px" - ) - } else if (identical(type, "popup")) { - shinyWidgets::show_alert( - title = NULL, - text = tags$div( - if (!is.null(title)) { - tagList( - tags$h3(title), - tags$hr() - ) - }, - style = "color: #000 !important;", - datatable - ), - closeOnClickOutside = TRUE, - showCloseButton = TRUE, - btn_labels = NA, - html = TRUE, - width = width - ) - } else { - showModal(modalDialog( - title = tagList( - datamods:::button_close_modal(), - title - ), - tags$div( - style = css(minHeight = validateCssUnit(options$height)), - toastui::renderDatagrid2(datatable) - ), - size = "xl", - footer = NULL, - easyClose = TRUE - )) - } -} # nocov end - - - -#' @importFrom htmltools tagList tags css -describe_col_char <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("text-aa"), - "character" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Unique:"), length(unique(x)) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - style = css(whiteSpace = "normal", wordBreak = "break-all"), - i18n("Most Common:"), gsub( - pattern = "'", - replacement = "\u07F4", - x = names(sort(table(x), decreasing = TRUE))[1] - ) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -fmt_p <- function(val, tot) { - paste0(round(val / tot * 100, 1), "%") -} - -describe_col_factor <- function(x, with_summary = TRUE) { - count <- sort(table(x, useNA = "always"), decreasing = TRUE) - total <- sum(count) - one <- count[!is.na(names(count))][1] - two <- count[!is.na(names(count))][2] - missing <- count[is.na(names(count))] - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("list-bullets"), - "factor" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - names(one), ":", fmt_p(one, total) - ), - tags$div( - names(two), ":", fmt_p(two, total) - ), - tags$div( - "Missing", ":", fmt_p(missing, total) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -describe_col_num <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("hash"), - "numeric" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Min:"), round(min(x, na.rm = TRUE), 2) - ), - tags$div( - i18n("Mean:"), round(mean(x, na.rm = TRUE), 2) - ), - tags$div( - i18n("Max:"), round(max(x, na.rm = TRUE), 2) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ) - ) - } - ) -} - - -describe_col_date <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("calendar"), - "date" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Min:"), min(x, na.rm = TRUE) - ), - tags$div( - i18n("Max:"), max(x, na.rm = TRUE) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -describe_col_datetime <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("clock"), - "datetime" - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Min:"), min(x, na.rm = TRUE) - ), - tags$div( - i18n("Max:"), max(x, na.rm = TRUE) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - - -describe_col_other <- function(x, with_summary = TRUE) { - tags$div( - style = css(padding = "3px 0", fontSize = "x-small"), - tags$div( - style = css(fontStyle = "italic"), - get_var_icon(x), - # phosphoricons::ph("clock"), - paste(class(x), collapse = ", ") - ), - if (with_summary) { - tagList( - tags$hr(style = css(margin = "3px 0")), - tags$div( - i18n("Unique:"), length(unique(x)) - ), - tags$div( - i18n("Missing:"), sum(is.na(x)) - ), - tags$div( - "\u00A0" - ), - tags$div( - "\u00A0" - ) - ) - } - ) -} - -construct_col_summary <- function(data) { - list( - position = "top", - height = 90, - columnContent = lapply( - X = setNames(names(data), names(data)), - FUN = function(col) { - values <- data[[col]] - content <- if (inherits(values, "character")) { - describe_col_char(values) - } else if (inherits(values, "factor")) { - describe_col_factor(values) - } else if (inherits(values, c("numeric", "integer"))) { - describe_col_num(values) - } else if (inherits(values, c("Date"))) { - describe_col_date(values) - } else if (inherits(values, c("POSIXt"))) { - describe_col_datetime(values) - } else { - describe_col_other(values) - } - list( - template = toastui::JS( - "function(value) {", - sprintf( - "return '%s';", - gsub(replacement = "", pattern = "\n", x = htmltools::doRenderTags(content)) - ), - "}" - ) - ) - } - ) - ) -} - ######## #### Current file: /Users/au301842/FreesearchR/R//helpers.R @@ -3916,21 +3064,6 @@ is_identical_to_previous <- function(data, no.name = TRUE) { } -######## -#### Current file: /Users/au301842/FreesearchR/R//html_dependency_freesearchr.R -######## - -html_dependency_FreesearchR <- function() { - htmltools::htmlDependency( - name = "FreesearchR", - version = packageVersion("FreesearchR"), - src = list(href = "FreesearchR", file = "assets"), - package = "FreesearchR", - stylesheet = "css/FreesearchR.css" - ) -} - - ######## #### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R ######## @@ -7797,23 +6930,23 @@ html_code_wrap <- function(string,lang="r"){ #' @export custom_theme <- function(..., version = 5, - primary = FreesearchR_colors("primary"), - secondary = FreesearchR_colors("secondary"), + primary = "#1E4A8F", + secondary = "#FF6F61", bootswatch = "united", base_font = bslib::font_google("Montserrat"), - heading_font = bslib::font_google("Public Sans", wght = "700"), - code_font = bslib::font_google("Open Sans"), - success = FreesearchR_colors("success"), - info = FreesearchR_colors("info"), - warning = FreesearchR_colors("warning"), - danger = FreesearchR_colors("danger") + heading_font = bslib::font_google("Public Sans",wght = "700"), + code_font = bslib::font_google("Open Sans") + # success = "#1E4A8F", + # info = , + # warning = , + # danger = , # fg = "#000", # bg="#fff", # base_font = bslib::font_google("Alice"), # heading_font = bslib::font_google("Jost", wght = "800"), # heading_font = bslib::font_google("Noto Serif"), # heading_font = bslib::font_google("Alice"), -) { + ){ bslib::bs_theme( ..., "navbar-bg" = primary, @@ -7823,37 +6956,10 @@ custom_theme <- function(..., bootswatch = bootswatch, base_font = base_font, heading_font = heading_font, - code_font = code_font, - success=success, - info=info, - warning=warning, - danger=danger + code_font = code_font ) } -FreesearchR_colors <- function(choose = NULL) { - out <- c( - primary = "#1E4A8F", - secondary = "#FF6F61", - success = "#00C896", - warning = "#FFB100", - danger = "#FF3A2F", - extra = "#8A4FFF", - info = "#11A0EC", - bg = "#FFFFFF", - dark = "#2D2D42", - fg = "#000000" - ) - if (!is.null(choose)) { - out[choose] - } else { - out - } -} - - - - #' GGplot default theme for plotting in Shiny #' @@ -7862,16 +6968,16 @@ FreesearchR_colors <- function(choose = NULL) { #' @returns ggplot object #' @export #' -gg_theme_shiny <- function() { - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text = ggplot2::element_text(size = 14), - strip.text = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24), - plot.subtitle = ggplot2::element_text(size = 18) - ) +gg_theme_shiny <- function(){ + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text = ggplot2::element_text(size = 14), + strip.text = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24), + plot.subtitle = ggplot2::element_text(size = 18) + ) } @@ -7882,14 +6988,14 @@ gg_theme_shiny <- function() { #' @returns ggplot object #' @export #' -gg_theme_export <- function() { - ggplot2::theme( - axis.title = ggplot2::element_text(size = 18), - axis.text.x = ggplot2::element_text(size = 14), - legend.title = ggplot2::element_text(size = 18), - legend.text = ggplot2::element_text(size = 14), - plot.title = ggplot2::element_text(size = 24) - ) +gg_theme_export <- function(){ + ggplot2::theme( + axis.title = ggplot2::element_text(size = 18), + axis.text.x = ggplot2::element_text(size = 14), + legend.title = ggplot2::element_text(size = 18), + legend.text = ggplot2::element_text(size = 14), + plot.title = ggplot2::element_text(size = 24) + ) } @@ -9368,8 +8474,7 @@ ui_elements <- list( update_variables_ui("modal_variables"), shiny::tags$br(), shiny::tags$br(), - shiny::tags$h4("Advanced data manipulation"), - shiny::tags$p("Below options allow more advanced varaible manipulations."), + tags$h4("Advanced data manipulation"), shiny::tags$br(), shiny::tags$br(), shiny::fluidRow( @@ -9382,7 +8487,6 @@ ui_elements <- list( ), shiny::tags$br(), shiny::helpText("Reorder the levels of factor/categorical variables."), - shiny::tags$br(), shiny::tags$br() ), shiny::column( @@ -9394,7 +8498,6 @@ ui_elements <- list( ), shiny::tags$br(), shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."), - shiny::tags$br(), shiny::tags$br() ), shiny::column( @@ -9406,10 +8509,10 @@ ui_elements <- list( ), shiny::tags$br(), shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")), - shiny::tags$br(), shiny::tags$br() ) ), + shiny::tags$br(), tags$h4("Compare modified data to original"), shiny::tags$br(), shiny::tags$p( @@ -9636,7 +8739,7 @@ ui_elements <- list( shiny::tagList( lapply( paste0("code_", c( - "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable" + "import", "data", "variables", "filter", "table1", "univariable", "multivariable" )), \(.x)shiny::htmlOutput(outputId = .x) ) @@ -9681,9 +8784,15 @@ dark <- custom_theme( ui <- bslib::page_fixed( prismDependencies, prismRDependency, - shiny::tags$head( - includeHTML(("www/umami-app.html")), - tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), + shiny::tags$head(includeHTML(("www/umami-app.html"))), + shiny::tags$style( + type = "text/css", + # add the name of the tab you want to use as title in data-value + shiny::HTML( + ".container-fluid > .nav > li > + a[data-value='FreesearchR'] {font-size: 28px}" + ) + ), title = "FreesearchR", theme = light, shiny::useBusyIndicators(), @@ -9722,7 +8831,7 @@ library(readr) library(MASS) library(stats) library(gt) -# library(openxlsx2) +library(openxlsx2) library(haven) library(readODS) require(shiny) @@ -9735,16 +8844,16 @@ library(broom) library(broom.helpers) # library(REDCapCAST) library(easystats) -# library(esquisse) +library(esquisse) library(patchwork) library(DHARMa) library(apexcharter) library(toastui) library(datamods) +library(data.table) library(IDEAFilter) library(shinyWidgets) library(DT) -library(data.table) library(gtsummary) # library(FreesearchR) @@ -9752,8 +8861,7 @@ library(gtsummary) data(starwars) data(mtcars) -mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") -mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars))) +mtcars <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") data(trial) @@ -9910,11 +9018,8 @@ server <- function(input, output, session) { rv$data_original <- temp_data |> default_parsing() - rv$code$import <- rv$code$import |> - expression_string(assign.str = "df <-") - - rv$code$format <- list( - "df", + rv$code$import_print <- list( + rv$code$import, rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") ) |> @@ -10039,13 +9144,13 @@ server <- function(input, output, session) { shiny::observeEvent( input$modal_column, - modal_create_column( + datamods::modal_create_column( id = "modal_column", - footer = shiny::markdown("This window is aimed at advanced users and require some *R*-experience!"), + footer = "This window is aimed at advanced users and require some R-experience!", title = "Create new variables" ) ) - data_modal_r <- create_column_server( + data_modal_r <- datamods::create_column_server( id = "modal_column", data_r = reactive(rv$data) ) @@ -10168,7 +9273,7 @@ server <- function(input, output, session) { ) observeEvent(input$modal_browse, { - show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") + datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") }) output$original_str <- renderPrint({ @@ -10199,11 +9304,7 @@ server <- function(input, output, session) { # }) output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import\n", rv$code$import)) - }) - - output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import formatting\n", rv$code$format)) + prismCodeBlock(paste0("#Data import\n", rv$code$import_print)) }) output$code_data <- shiny::renderUI({ diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf deleted file mode 100644 index 7d73d94f..00000000 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/FreesearchR.dcf +++ /dev/null @@ -1,10 +0,0 @@ -name: FreesearchR -title: -username: agdamsbo -account: agdamsbo -server: shinyapps.io -hostUrl: https://api.shinyapps.io/v1 -appId: 14600805 -bundleId: 10170173 -url: https://agdamsbo.shinyapps.io/FreesearchR/ -version: 1 diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index dd1b9615..f5bbfb79 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 13611288 -bundleId: 10164589 +bundleId: 10164419 url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index c16cba09..8f977371 100644 --- a/inst/apps/FreesearchR/server.R +++ b/inst/apps/FreesearchR/server.R @@ -2,7 +2,7 @@ library(readr) library(MASS) library(stats) library(gt) -# library(openxlsx2) +library(openxlsx2) library(haven) library(readODS) require(shiny) @@ -15,16 +15,16 @@ library(broom) library(broom.helpers) # library(REDCapCAST) library(easystats) -# library(esquisse) +library(esquisse) library(patchwork) library(DHARMa) library(apexcharter) library(toastui) library(datamods) +library(data.table) library(IDEAFilter) library(shinyWidgets) library(DT) -library(data.table) library(gtsummary) # library(FreesearchR) @@ -32,8 +32,7 @@ library(gtsummary) data(starwars) data(mtcars) -mtcars_date <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") -mtcars_date$date <- as.Date(sample(seq_len(365),nrow(mtcars))) +mtcars <- mtcars |> append_column(as.Date(sample(1:365, nrow(mtcars))), "rand_dates") data(trial) @@ -190,11 +189,8 @@ server <- function(input, output, session) { rv$data_original <- temp_data |> default_parsing() - rv$code$import <- rv$code$import |> - expression_string(assign.str = "df <-") - - rv$code$format <- list( - "df", + rv$code$import_print <- list( + rv$code$import, rlang::expr(dplyr::select(dplyr::all_of(!!input$import_var))), rlang::call2(.fn = "default_parsing", .ns = "FreesearchR") ) |> @@ -319,13 +315,13 @@ server <- function(input, output, session) { shiny::observeEvent( input$modal_column, - modal_create_column( + datamods::modal_create_column( id = "modal_column", - footer = shiny::markdown("This window is aimed at advanced users and require some *R*-experience!"), + footer = "This window is aimed at advanced users and require some R-experience!", title = "Create new variables" ) ) - data_modal_r <- create_column_server( + data_modal_r <- datamods::create_column_server( id = "modal_column", data_r = reactive(rv$data) ) @@ -448,7 +444,7 @@ server <- function(input, output, session) { ) observeEvent(input$modal_browse, { - show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") + datamods::show_data(REDCapCAST::fct_drop(rv$data_filtered), title = "Uploaded data overview", type = "modal") }) output$original_str <- renderPrint({ @@ -479,11 +475,7 @@ server <- function(input, output, session) { # }) output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import\n", rv$code$import)) - }) - - output$code_import <- shiny::renderUI({ - prismCodeBlock(paste0("#Data import formatting\n", rv$code$format)) + prismCodeBlock(paste0("#Data import\n", rv$code$import_print)) }) output$code_data <- shiny::renderUI({ diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 4dc60a57..8dac4454 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -197,8 +197,7 @@ ui_elements <- list( update_variables_ui("modal_variables"), shiny::tags$br(), shiny::tags$br(), - shiny::tags$h4("Advanced data manipulation"), - shiny::tags$p("Below options allow more advanced varaible manipulations."), + tags$h4("Advanced data manipulation"), shiny::tags$br(), shiny::tags$br(), shiny::fluidRow( @@ -211,7 +210,6 @@ ui_elements <- list( ), shiny::tags$br(), shiny::helpText("Reorder the levels of factor/categorical variables."), - shiny::tags$br(), shiny::tags$br() ), shiny::column( @@ -223,7 +221,6 @@ ui_elements <- list( ), shiny::tags$br(), shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."), - shiny::tags$br(), shiny::tags$br() ), shiny::column( @@ -235,10 +232,10 @@ ui_elements <- list( ), shiny::tags$br(), shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")), - shiny::tags$br(), shiny::tags$br() ) ), + shiny::tags$br(), tags$h4("Compare modified data to original"), shiny::tags$br(), shiny::tags$p( @@ -465,7 +462,7 @@ ui_elements <- list( shiny::tagList( lapply( paste0("code_", c( - "import", "format", "data", "variables", "filter", "table1", "univariable", "multivariable" + "import", "data", "variables", "filter", "table1", "univariable", "multivariable" )), \(.x)shiny::htmlOutput(outputId = .x) ) @@ -510,9 +507,15 @@ dark <- custom_theme( ui <- bslib::page_fixed( prismDependencies, prismRDependency, - shiny::tags$head( - includeHTML(("www/umami-app.html")), - tags$link(rel = "stylesheet", type = "text/css", href = "style.css")), + shiny::tags$head(includeHTML(("www/umami-app.html"))), + shiny::tags$style( + type = "text/css", + # add the name of the tab you want to use as title in data-value + shiny::HTML( + ".container-fluid > .nav > li > + a[data-value='FreesearchR'] {font-size: 28px}" + ) + ), title = "FreesearchR", theme = light, shiny::useBusyIndicators(), diff --git a/inst/apps/FreesearchR/www/references.bib b/inst/apps/FreesearchR/www/references.bib index ab4b8b80..ca20ec82 100644 --- a/inst/apps/FreesearchR/www/references.bib +++ b/inst/apps/FreesearchR/www/references.bib @@ -1,11 +1,24 @@ @book{andreasgammelgaarddamsbo2025, - title = {agdamsbo/FreesearchR: FreesearchR 25.4.3}, - author = {Damsbo, Andreas Gammelgaard}, + title = {agdamsbo/freesearcheR: freesearcheR 25.3.1}, + author = {Andreas Gammelgaard Damsbo, }, year = {2025}, - month = {04}, - date = {2025-04-24}, + month = {03}, + date = {2025-03-06}, publisher = {Zenodo}, doi = {10.5281/ZENODO.14527429}, url = {https://zenodo.org/doi/10.5281/zenodo.14527429} } + +@article{Aam2020, + title = {Post-stroke Cognitive Impairment{\textemdash}Impact of Follow-Up Time and Stroke Subtype on Severity and Cognitive Profile: The Nor-COAST Study}, + author = {Aam, Stina and Einstad, Marte Stine and Munthe-Kaas, Ragnhild and Lydersen, Stian and Ihle-Hansen, Hege and Knapskog, Anne Brita and {Ellekjær}, Hanne and Seljeseth, Yngve and Saltvedt, Ingvild}, + year = {2020}, + date = {2020}, + journal = {Frontiers in Neurology}, + pages = {1--10}, + volume = {11}, + number = {July}, + doi = {10.3389/fneur.2020.00699}, + note = {Citation Key: Aam2020} +} diff --git a/inst/apps/FreesearchR/www/style.css b/inst/apps/FreesearchR/www/style.css deleted file mode 100644 index f84cc325..00000000 --- a/inst/apps/FreesearchR/www/style.css +++ /dev/null @@ -1,124 +0,0 @@ - -/*! - * Copyright (c) 2025 FreesearchR - * - * FreesearchR, CSS styles - * https://github.com/agdamsbo/FreesearchR - * - * @version 0.0.1 - */ - -.container-fluid > .nav > li > - a[data-value='FreesearchR'] {font-size: 28px} - -/* from datamods */ -.show-block { - display: block !important; -} -.show-inline { - display: inline !important; -} -.hidden { - display: none !important; -} -.invisible { - visibility: hidden; -} - -.container-rule { - position: relative; - text-align: center; - height: 25px; - margin-bottom: 5px; -} - -.horizontal-rule { - position: absolute; - top: 11px; - right: 0; - left: 0; - background-color: #d0cfcf; - height: 1px; - z-index: 100; - margin: 0; - border: none; -} - -.label-rule { - background: #FFF; - opacity: 1; - z-index: 101; - background-color: #FFF; - position: relative; - padding: 0 10px 0 10px; -} - -.datamods-table-container { - overflow: auto; - word-break: keep-all; - white-space: nowrap; -} - -.datamods-table-container > .table { - margin-bottom: 0 !important; -} - -.datamods-file-import { - display: grid; - grid-template-columns: auto 50px; - grid-column-gap: 10px; -} - -.datamods-dt-nowrap { - word-break: keep-all; - white-space: nowrap; -} - - - -/* validation */ -.datamods-validation-results { - display: grid; - grid-template-columns: repeat(3, 1fr); - grid-template-rows: 1fr; - height: 50px; - line-height: 50px; - font-size: large; -} - -.datamods-validation-summary { - font-weight: bold; - text-align: center; -} - -.datamods-validation-item { - font-size: larger; -} - - - -/* modified from esquisse for data types */ -.btn-column-categorical { - background-color: #00C896; - color: #FFFFFF; -} -.btn-column-continuous { - background-color: #FFB100; - color: #FFFFFF; -} -.btn-column-dichotomous { - background-color: #8A4FFF; - color: #FFFFFF; -} -.btn-column-datetime { - background-color: #11A0EC; - color: #FFFFFF; -} -.btn-column-id { - background-color: #848484; - color: #FFFFFF; -} -.btn-column-text { - background-color: #2E2E2E; - color: #FFFFFF; -} diff --git a/inst/assets/css/FreesearchR.css b/inst/assets/css/FreesearchR.css deleted file mode 100644 index f84cc325..00000000 --- a/inst/assets/css/FreesearchR.css +++ /dev/null @@ -1,124 +0,0 @@ - -/*! - * Copyright (c) 2025 FreesearchR - * - * FreesearchR, CSS styles - * https://github.com/agdamsbo/FreesearchR - * - * @version 0.0.1 - */ - -.container-fluid > .nav > li > - a[data-value='FreesearchR'] {font-size: 28px} - -/* from datamods */ -.show-block { - display: block !important; -} -.show-inline { - display: inline !important; -} -.hidden { - display: none !important; -} -.invisible { - visibility: hidden; -} - -.container-rule { - position: relative; - text-align: center; - height: 25px; - margin-bottom: 5px; -} - -.horizontal-rule { - position: absolute; - top: 11px; - right: 0; - left: 0; - background-color: #d0cfcf; - height: 1px; - z-index: 100; - margin: 0; - border: none; -} - -.label-rule { - background: #FFF; - opacity: 1; - z-index: 101; - background-color: #FFF; - position: relative; - padding: 0 10px 0 10px; -} - -.datamods-table-container { - overflow: auto; - word-break: keep-all; - white-space: nowrap; -} - -.datamods-table-container > .table { - margin-bottom: 0 !important; -} - -.datamods-file-import { - display: grid; - grid-template-columns: auto 50px; - grid-column-gap: 10px; -} - -.datamods-dt-nowrap { - word-break: keep-all; - white-space: nowrap; -} - - - -/* validation */ -.datamods-validation-results { - display: grid; - grid-template-columns: repeat(3, 1fr); - grid-template-rows: 1fr; - height: 50px; - line-height: 50px; - font-size: large; -} - -.datamods-validation-summary { - font-weight: bold; - text-align: center; -} - -.datamods-validation-item { - font-size: larger; -} - - - -/* modified from esquisse for data types */ -.btn-column-categorical { - background-color: #00C896; - color: #FFFFFF; -} -.btn-column-continuous { - background-color: #FFB100; - color: #FFFFFF; -} -.btn-column-dichotomous { - background-color: #8A4FFF; - color: #FFFFFF; -} -.btn-column-datetime { - background-color: #11A0EC; - color: #FFFFFF; -} -.btn-column-id { - background-color: #848484; - color: #FFFFFF; -} -.btn-column-text { - background-color: #2E2E2E; - color: #FFFFFF; -} diff --git a/man/create-column.Rd b/man/create-column.Rd deleted file mode 100644 index 452cb3d4..00000000 --- a/man/create-column.Rd +++ /dev/null @@ -1,76 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create-column-mod.R -\name{create-column} -\alias{create-column} -\alias{create_column_ui} -\alias{create_column_server} -\alias{list_allowed_operations} -\alias{modal_create_column} -\alias{winbox_create_column} -\title{Create new column} -\usage{ -create_column_ui(id) - -create_column_server( - id, - data_r = reactive(NULL), - allowed_operations = list_allowed_operations() -) - -list_allowed_operations() - -modal_create_column( - id, - title = i18n("Create a new column"), - easyClose = TRUE, - size = "l", - footer = NULL -) - -winbox_create_column( - id, - title = i18n("Create a new column"), - options = shinyWidgets::wbOptions(), - controls = shinyWidgets::wbControls() -) -} -\arguments{ -\item{id}{Module's ID.} - -\item{data_r}{A \code{\link[shiny:reactive]{shiny::reactive()}} function returning a \code{data.frame}.} - -\item{allowed_operations}{A \code{list} of allowed operations, see below for details.} - -\item{title}{An optional title for the dialog.} - -\item{easyClose}{If \code{TRUE}, the modal dialog can be dismissed by -clicking outside the dialog box, or be pressing the Escape key. If -\code{FALSE} (the default), the modal dialog can't be dismissed in those -ways; instead it must be dismissed by clicking on a \code{modalButton()}, or -from a call to \code{\link[shiny:removeModal]{removeModal()}} on the server.} - -\item{size}{One of \code{"s"} for small, \code{"m"} (the default) for medium, -\code{"l"} for large, or \code{"xl"} for extra large. Note that \code{"xl"} only -works with Bootstrap 4 and above (to opt-in to Bootstrap 4+, -pass \code{\link[bslib:bs_theme]{bslib::bs_theme()}} to the \code{theme} argument of a page container -like \code{\link[shiny:fluidPage]{fluidPage()}}).} - -\item{footer}{UI for footer. Use \code{NULL} for no footer.} - -\item{options}{List of options, see \code{\link[shinyWidgets:wbOptions]{wbOptions()}}.} - -\item{controls}{List of controls, see \code{\link[shinyWidgets:wbControls]{wbControls()}}.} -} -\value{ -A \code{\link[shiny:reactive]{shiny::reactive()}} function returning the data. -} -\description{ -This module allow to enter an expression to create a new column in a \code{data.frame}. -} -\note{ -User can only use a subset of function: (, c, +, -, *, ^, \%\%, \%/\%, /, ==, >, <, !=, <=, >=, &, |, abs, sign, sqrt, ceiling, floor, trunc, cummax, cummin, cumprod, cumsum, exp, expm1, log, log10, log2, log1p, cos, cosh, sin, sinh, tan, tanh, acos, acosh, asin, asinh, atan, atanh, cospi, sinpi, tanpi, gamma, lgamma, digamma, trigamma, round, signif, max, min, range, prod, sum, any, all, pmin, pmax, mean, paste, paste0, substr, nchar, trimws, gsub, sub, grepl, ifelse, length, as.numeric, as.character, as.integer, as.Date, as.POSIXct, as.factor, factor. -You can add more operations using the \code{allowed_operations} argument, for example if you want to allow to use package lubridate, you can do: - -\if{html}{\out{
}}\preformatted{c(list_allowed_operations(), getNamespaceExports("lubridate")) -}\if{html}{\out{
}} -} diff --git a/man/cut_var.Rd b/man/cut_var.Rd index c3226a6a..e753ccd5 100644 --- a/man/cut_var.Rd +++ b/man/cut_var.Rd @@ -33,7 +33,7 @@ cut_var(x, ...) ... ) -\method{cut_var}{Date}(x, breaks = NULL, start.on.monday = TRUE, ...) +\method{cut_var}{Date}(x, breaks, start.on.monday = TRUE, ...) } \arguments{ \item{x}{an object inheriting from class "POSIXct"} @@ -58,8 +58,6 @@ readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-0 readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "month_only") readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "\%A-\%H") -readr::parse_datetime(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks=NULL,format = "\%W") as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(2) as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(breaks = "weekday") -as.Date(c("1992-02-01 01:00:20", "1992-02-06 03:00:20", "1992-05-01 01:20:20", "1992-09-01 08:20:20", "1999-02-01 21:20:20", "1992-12-01 03:02:20")) |> cut_var(format = "\%W") } diff --git a/man/get_var_icon.Rd b/man/get_var_icon.Rd deleted file mode 100644 index c299ccfd..00000000 --- a/man/get_var_icon.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data-summary.R -\name{get_var_icon} -\alias{get_var_icon} -\title{Easily get variable icon based on data type or class} -\usage{ -get_var_icon(data, class.type = c("class", "type")) -} -\arguments{ -\item{data}{variable or data frame} - -\item{class.type}{"type" or "class". Default is "class"} -} -\value{ -svg icon -} -\description{ -Easily get variable icon based on data type or class -} -\examples{ -mtcars[1] |> get_var_icon("class") -default_parsing(mtcars) |> get_var_icon() -} diff --git a/man/show_data.Rd b/man/show_data.Rd deleted file mode 100644 index de11852b..00000000 --- a/man/show_data.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/datagrid-infos-mod.R -\name{show_data} -\alias{show_data} -\title{Display a table in a window} -\usage{ -show_data( - data, - title = NULL, - options = NULL, - show_classes = TRUE, - type = c("popup", "modal", "winbox"), - width = "65\%", - ... -) -} -\arguments{ -\item{data}{a data object (either a \code{matrix} or a \code{data.frame}).} - -\item{title}{Title to be displayed in window.} - -\item{options}{Arguments passed to \code{\link[toastui:datagrid]{toastui::datagrid()}}.} - -\item{show_classes}{Show variables classes under variables names in table header.} - -\item{type}{Display table in a pop-up with \code{\link[shinyWidgets:sweetalert]{shinyWidgets::show_alert()}}, -in modal window with \code{\link[shiny:showModal]{shiny::showModal()}} or in a WinBox window with \code{\link[shinyWidgets:WinBox]{shinyWidgets::WinBox()}}.} - -\item{width}{Width of the window, only used if \code{type = "popup"} or \code{type = "winbox"}.} - -\item{...}{Additional options, such as \code{wbOptions = wbOptions()} or \code{wbControls = wbControls()}.} -} -\value{ -No value. -} -\description{ -Display a table in a window -} -\note{ -If you use \code{type = "winbox"}, you'll need to use \code{shinyWidgets::html_dependency_winbox()} somewhere in your UI. -} diff --git a/renv.lock b/renv.lock index 5e58e951..1a386741 100644 --- a/renv.lock +++ b/renv.lock @@ -1792,7 +1792,7 @@ }, "cli": { "Package": "cli", - "Version": "3.6.5", + "Version": "3.6.4", "Source": "Repository", "Title": "Helpers for Developing Command Line Interfaces", "Authors@R": "c( person(\"Gábor\", \"Csárdi\", , \"gabor@posit.co\", role = c(\"aut\", \"cre\")), person(\"Hadley\", \"Wickham\", role = \"ctb\"), person(\"Kirill\", \"Müller\", role = \"ctb\"), person(\"Salim\", \"Brüggemann\", , \"salim-b@pm.me\", role = \"ctb\", comment = c(ORCID = \"0000-0002-5329-5987\")), person(\"Posit Software, PBC\", role = c(\"cph\", \"fnd\")) )", diff --git a/umami-page.html b/umami-page.html index 1270d512..57eeb5a2 100644 --- a/umami-page.html +++ b/umami-page.html @@ -1 +1 @@ - +