mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-12-16 09:32:10 +01:00
375 lines
9.4 KiB
R
375 lines
9.4 KiB
R
string_split_ui <- function(id) {
|
|
ns <- NS(id)
|
|
tagList(
|
|
shiny::fluidRow(
|
|
# shiny::textOutput(outputId = ns("no_splits")),
|
|
column(
|
|
width = 4,
|
|
shiny::uiOutput(outputId = ns("variable"))
|
|
),
|
|
column(
|
|
width = 4,
|
|
shiny::uiOutput(outputId = ns("delim"))
|
|
),
|
|
column(
|
|
width = 4,
|
|
shiny::uiOutput(outputId = ns("direction"))
|
|
) # ,
|
|
# column(
|
|
# width = 3,
|
|
# actionButton(
|
|
# inputId = ns("split"),
|
|
# label = tagList(phosphoricons::ph("scissors"), i18n$t("Split the variable")),
|
|
# class = "btn-outline-primary float-end"
|
|
# )
|
|
# )
|
|
),
|
|
shiny::fluidRow(
|
|
column(
|
|
width = 3,
|
|
shiny::h4(i18n$t("Original data")),
|
|
shiny::tableOutput(outputId = ns("orig_data"))
|
|
# This doesn't render...
|
|
# toastui::datagridOutput2(outputId = ns("orig_data_2"))
|
|
),
|
|
column(width = 1),
|
|
column(
|
|
width = 8,
|
|
shiny::h4(i18n$t("Preview of result")),
|
|
shiny::tableOutput(outputId = ns("new_data"))
|
|
)
|
|
),
|
|
actionButton(
|
|
inputId = ns("create"),
|
|
label = tagList(phosphoricons::ph("pencil"), i18n$t("Apply split")),
|
|
class = "btn-outline-primary float-end"
|
|
),
|
|
tags$div(class = "clearfix")
|
|
)
|
|
}
|
|
|
|
|
|
|
|
string_split_server <- function(id, data_r = reactive(NULL)) {
|
|
moduleServer(
|
|
id,
|
|
function(input, output, session) {
|
|
rv <- reactiveValues(data = NULL, temp = NULL, out=NULL)
|
|
|
|
ns <- session$ns
|
|
|
|
# output$no_splits <- shiny::renderText({
|
|
# req({
|
|
# data_r()
|
|
# })
|
|
#
|
|
# if (any(is_splittable(data_r()))) {
|
|
# i18n$t("No character variables with accepted delimiters detected.")
|
|
# }
|
|
# })
|
|
|
|
shiny::observe({
|
|
req(data_r())
|
|
|
|
# if (any(is_splittable(data_r()))) {
|
|
data <- data_r()
|
|
rv$data <- data
|
|
|
|
vars_num <- vapply(data, \(.x){
|
|
is_splittable(.x)
|
|
}, logical(1))
|
|
vars_num <- names(vars_num)[vars_num]
|
|
|
|
output$variable <- shiny::renderUI(
|
|
columnSelectInput(
|
|
inputId = ns("variable"),
|
|
data = data,
|
|
label = i18n$t("Variable to split:"),
|
|
width = "100%",
|
|
col_subset = vars_num,
|
|
selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
|
|
)
|
|
)
|
|
# }
|
|
# shinyWidgets::updateVirtualSelect(
|
|
# inputId = "variable",
|
|
# choices = vars_num,
|
|
# selected = if (isTruthy(input$variable)) input$variable else vars_num[1]
|
|
# )
|
|
})
|
|
|
|
output$delim <- shiny::renderUI({
|
|
req(rv$data)
|
|
req(input$variable)
|
|
# browser()
|
|
|
|
# req({
|
|
# any(apply(data_r(),2,is_splittable))
|
|
# })
|
|
# if (any(is_splittable(data_r()))) {
|
|
data <- rv$data |>
|
|
dplyr::select(tidyselect::all_of(input$variable))
|
|
|
|
delimiters <- Reduce(c, unique(sapply(data[[1]], detect_delimiter)))
|
|
|
|
# shiny::textInput(inputId = ns("delim"), label = i18n$t("Text or character to split string by"))
|
|
shiny::selectInput(
|
|
inputId = ns("delim"), label = i18n$t("Select delimiter"),
|
|
choices = setNames(
|
|
delimiters,
|
|
glue::glue("'{delimiters}'")
|
|
), selected = 1
|
|
)
|
|
# }
|
|
})
|
|
|
|
|
|
output$direction <- shiny::renderUI({
|
|
# req({
|
|
# rv$data
|
|
# })
|
|
|
|
# if (any(is_splittable(data_r()))) {
|
|
vectorSelectInput(
|
|
inputId = ns("direction"),
|
|
label = i18n$t("Direction:"),
|
|
choices = setNames(
|
|
c(
|
|
"wide",
|
|
"long"
|
|
),
|
|
c(
|
|
i18n$t("Split string to multiple columns. Keep number of rows."),
|
|
i18n$t("Split string to multiple observations (rows) in the same column. Also ads id and instance columns")
|
|
)
|
|
),
|
|
selected = "wide",
|
|
width = "100%"
|
|
)
|
|
# }
|
|
})
|
|
|
|
observeEvent(
|
|
list(
|
|
input$variable,
|
|
input$delim,
|
|
input$direction
|
|
),
|
|
{
|
|
req(rv$data)
|
|
req(input$variable)
|
|
req(input$delim)
|
|
req(input$direction)
|
|
|
|
data <- rv$data |>
|
|
dplyr::select(tidyselect::all_of(input$variable))
|
|
# browser()
|
|
rv$temp <- separate_string(
|
|
data = data,
|
|
col = input$variable,
|
|
delim = input$delim,
|
|
direction = input$direction
|
|
)
|
|
}
|
|
)
|
|
|
|
# shiny::observeEvent(input$split, {
|
|
# show_data(rv$temp, title = i18n$t("Browse data preview"), type = "modal")
|
|
# })
|
|
|
|
## Toastui would not render the original data, so the solution was to go
|
|
## with native table rendering, which works, but doesn't please the eye
|
|
|
|
output$orig_data <- shiny::renderTable({
|
|
req(data_r())
|
|
req(input$variable)
|
|
data <- data_r() |>
|
|
dplyr::select(tidyselect::all_of(input$variable))
|
|
# browser()
|
|
head(data, 10)
|
|
})
|
|
|
|
# output$orig_data_2 <- toastui::renderDatagrid2({
|
|
# req(data_r())
|
|
# req(input$variable)
|
|
# data <- data_r() |>
|
|
# dplyr::select(tidyselect::all_of(input$variable))
|
|
# # browser()
|
|
# toastui::datagrid(head(data, 10))
|
|
# })
|
|
|
|
|
|
|
|
output$new_data <- shiny::renderTable({
|
|
shiny::req(rv$temp)
|
|
data <- rv$temp
|
|
head(data, 10)
|
|
# toastui::datagrid(
|
|
# data = head(data, 100),
|
|
# colwidths = "guess",
|
|
# theme = "default",
|
|
# bodyHeight = "auto", pagination = 10
|
|
# )
|
|
})
|
|
|
|
data_split_r <- reactive({
|
|
req(rv$temp)
|
|
|
|
data <- rv$data
|
|
|
|
parameters <- list(
|
|
col = input$variable,
|
|
delim = input$delim,
|
|
direction = input$direction
|
|
)
|
|
|
|
out <- tryCatch({
|
|
rlang::exec(separate_string, !!!modifyList(
|
|
parameters,
|
|
list(
|
|
data = data
|
|
)
|
|
))
|
|
})
|
|
# browser()
|
|
|
|
# separate_string(
|
|
# data = data,
|
|
#
|
|
# )
|
|
|
|
code <- rlang::call2(
|
|
"separate_string",
|
|
!!!parameters,
|
|
.ns = "FreesearchR"
|
|
)
|
|
attr(out, "code") <- code
|
|
out})
|
|
|
|
data_returned_r <- observeEvent(input$create, {
|
|
rv$out <- data_split_r()
|
|
})
|
|
|
|
return(reactive(rv$out))
|
|
}
|
|
)
|
|
}
|
|
|
|
|
|
modal_string_split <- function(id,
|
|
title = i18n$t("Split character string"),
|
|
easyClose = TRUE,
|
|
size = "xl",
|
|
footer = NULL) {
|
|
ns <- NS(id)
|
|
showModal(modalDialog(
|
|
title = tagList(title, datamods:::button_close_modal()),
|
|
string_split_ui(id),
|
|
tags$div(
|
|
style = "display: none;",
|
|
textInput(inputId = ns("hidden"), label = NULL, value = datamods:::genId())
|
|
),
|
|
easyClose = easyClose,
|
|
size = size,
|
|
footer = footer
|
|
))
|
|
}
|
|
|
|
|
|
### Helpers
|
|
|
|
#' Separate string wide or long
|
|
#'
|
|
#' @param data data
|
|
#' @param col column
|
|
#' @param delim delimiter
|
|
#' @param direction target direction
|
|
#'
|
|
#' @returns data.frame
|
|
#' @export
|
|
#'
|
|
separate_string <- function(data, col, delim, direction = c("wide", "long")) {
|
|
direction <- match.arg(direction)
|
|
|
|
if (direction == "long") {
|
|
out <- data |>
|
|
dplyr::mutate(id_str_split = dplyr::row_number()) |>
|
|
dplyr::group_by_at("id_str_split") |>
|
|
tidyr::separate_longer_delim(cols = tidyselect::all_of(col), delim = delim) |>
|
|
dplyr::mutate(instance_str_split = dplyr::row_number()) |>
|
|
# add_instance(by="id")
|
|
dplyr::ungroup() |>
|
|
dplyr::mutate(dplyr::across(tidyselect::matches(col), trimws))
|
|
} else if (direction == "wide") {
|
|
## Experiment of wide to long
|
|
|
|
out <- data |>
|
|
tidyr::separate_wider_delim(
|
|
cols = tidyselect::all_of(col),
|
|
delim = delim,
|
|
names_sep = "_",
|
|
too_few = "align_start"
|
|
) |>
|
|
dplyr::mutate(dplyr::across(tidyselect::starts_with(col), trimws))
|
|
}
|
|
|
|
out
|
|
}
|
|
|
|
|
|
|
|
#' Detect delimiters in string based on allowed delimiters
|
|
#'
|
|
#' @description
|
|
#' Accepts any repeat of delimiters and includes surrounding whitespace
|
|
#'
|
|
#'
|
|
#' @param text character vector
|
|
#' @param delimiters allowed delimiters
|
|
#'
|
|
#' @returns character vector
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' sapply(c("Walk - run", "Sel__Re", "what;now"), detect_delimiter)
|
|
detect_delimiter <- function(data, delimiters = c("_", "-", ";", "\n", ",")) {
|
|
# Create patterns for each delimiter with potential surrounding whitespace
|
|
patterns <- paste0("\\s*\\", delimiters, "+\\s*")
|
|
|
|
# Check each pattern
|
|
out <- sapply(patterns, \(.x){
|
|
if (grepl(.x, data)) {
|
|
# Extract the actual matched delimiter with whitespace
|
|
regmatches(data, regexpr(.x, data))
|
|
}
|
|
})
|
|
|
|
Reduce(c, out)
|
|
}
|
|
|
|
|
|
#' Determine if any variable in data frame character and contains recognized delimiters
|
|
#'
|
|
#' @param data vector or data.frame
|
|
#'
|
|
#' @returns logical
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' any(apply(mtcars, 2, is_splittable))
|
|
#' is_splittable(mtcars)
|
|
is_splittable <- function(data) {
|
|
if (is.data.frame(data)) {
|
|
return(apply(data, 2, is_splittable))
|
|
}
|
|
|
|
if (is.character(data)) {
|
|
if (length(Reduce(c, unique(sapply(data, detect_delimiter)))) > 0) {
|
|
TRUE
|
|
} else {
|
|
FALSE
|
|
}
|
|
} else {
|
|
FALSE
|
|
}
|
|
}
|