не совсем успешная версия разобраться с регулярными выражениями

81 regexSelect/Miscellaneous/shinyApp.R

@@ -1,56 +1,8 @@
 library(shiny)
-shinyApp(
-  ui = fluidPage(
-    shinyjs::useShinyjs(),
-    selectizeInput(inputId = "variable",
-                   label = "Variable:",
-                   choices = unique(diamonds$clarity),
-                   options=list(multiple=TRUE,create = TRUE)),
-    checkboxGroupInput(inputId = 'grep',label = 'regex options',
-                       choices = c('Enable'='enbl',
-                                   'Retain Searches'='ret',
-                                   'ignore.case'='ignore',
-                                   'perl'='perl','fixed'='fixed','invert'='invert'),
-                       selected = c('enbl','ignore'),
-                       inline  = TRUE),
-    plotOutput("data")
-  ),
-  server = function(input, output,session) {
-    shinyjs::hide('grep')
-    observe({
-      if(!'ret'%in%input$grep){
-        updateSelectizeInput(session=session,inputId = 'variable',choices = unique(diamonds$clarity),selected = input$variable,options = list(multiple=TRUE,create=TRUE))
-      }
-    })
-
-    observeEvent(input$variable,{
-
-      if('enbl'%in%input$grep){
-        curr_cols=switch((nchar(input$variable)==0)+1,
-                         grep(input$variable,unique(diamonds$clarity),
-                              value=TRUE,
-                              ignore.case = 'ignore'%in%input$grep,
-                              perl = 'perl'%in%input$grep,
-                              fixed='fixed'%in%input$grep,
-                              invert='invert'%in%input$grep),
-                         NULL)
-      }else{
-        curr_cols=switch((input$variable%in%unique(diamonds$clarity))+1,unique(diamonds$clarity),input$variable)
-      }
-
-
-
-      if(length(curr_cols)>0){
-        if(all(curr_cols%in%unique(diamonds$clarity))){
-          output$data <- renderPlot({
-            ggplot(diamonds[diamonds$clarity%in%curr_cols,],aes(x=table,y=carat,colour=clarity))+geom_point()
-          })
-        }}
-
-    })
-    })
-
-shinyApp(ui, server)
+library(ggplot2)
+getwd()
+source("./R/regexSelect.R")
+source("./R/regexSelectUI.R")
 
 ui <- fluidPage(
   selectInput('var','Choose Variable',

81 regexSelect/my/app.R

@@ -0,0 +1,38 @@
+library(shiny)
+library(ggplot2)
+getwd()
+source("regexSelect.R")
+source("regexSelectUI.R")
+
+ui <- fluidPage(
+  selectInput('var','Choose Variable',
+              choices = names(diamonds)[sapply(diamonds,function(x) inherits(x,c('character','factor')))],
+              selected = 'clarity'),
+  uiOutput('regexchoose'),
+  plotOutput("data")
+  )
+
+server <- function(input, output, session) {
+
+  observeEvent(input$var,{ 
+    output$regexchoose<-shiny::renderUI({
+      regexSelectUI(id = "a", label = input$var,
+                    choices = unique(diamonds[[input$var]]),
+                    # checkbox.inline =TRUE,
+                    checkbox.show=TRUE
+                    )
+    })
+  })
+
+    curr_cols<-callModule(regexSelect, "a",shiny::reactive(unique(diamonds[[input$var]])))
+
+    observeEvent(curr_cols(),{
+      cols_now<-curr_cols()
+      output$data <- shiny::renderPlot({
+        ggplot(diamonds[diamonds[[input$var]]%in%cols_now,],aes_string(x='table',y='carat',colour=input$var))+geom_point()
+      })
+  })
+
+}
+
+shinyApp(ui, server)

81 regexSelect/my/regexSelect.R

@@ -0,0 +1,74 @@
+#' @title Create a selectize list input control with regular expression capabilities
+#' @description Create a selectize list that can be used to choose a single or multiple 
+#' items from a list of values with extension for regular expression.
+#' @param input The input slot that will be used to access the value.
+#' @param output The output variable to read the list of values returned be regex query
+#' @param session The session of the shiny application
+#' @param data reactive element contains a character vector where matches are sought, 
+#' or an object which can be coerced by as.character to a character vector
+#' @return reactive character vector
+#' @examples 
+#' if(interactive()){
+#'ui <- shiny::fluidPage(
+#'regexSelectUI(id = "a", label = "Variable:",choices = names(iris)),
+#'shiny::tableOutput("data")
+#')
+#' 
+#' 
+#'ui.show <- shiny::fluidPage(
+#'regexSelectUI(id = "a", label = "Variable:",choices = names(iris),checkbox.show = TRUE),
+#'shiny::tableOutput("data")
+#')
+#'
+#'server <- function(input, output, session) {
+#'  curr_cols<-shiny::callModule(regexSelect, "a",shiny::reactive(names(iris)))
+#'  
+#'  shiny::observeEvent(curr_cols(),{
+#'  cols_now<-curr_cols()
+#'  if(length(cols_now)==0)  cols_now<-names(data())
+#'  output$data <- shiny::renderTable({iris[,cols_now , drop = FALSE]}, rownames = TRUE)
+#'  })
+#'}
+#'
+#'#do not show regex checkboxes
+#'shiny::shinyApp(ui, server)
+#'
+#'#show regex checkboxes
+#'shiny::shinyApp(ui.show, server)
+#'  }
+#' @rdname regexSelect
+#' @export 
+#' @import shiny
+#' @importFrom shinyjs hide
+regexSelect <- function(input, output, session, data) {
+
+  current_cols<-shiny::eventReactive(input$variable,{
+
+    if('enable'%in%input$grep){
+      curr_cols<-switch((nchar(input$variable)==0)+1,
+                        grep(input$variable,data(),
+                             value=TRUE,
+                             ignore.case = 'ignore.case'%in%input$grep,
+                             perl = 'perl'%in%input$grep,
+                             fixed='fixed'%in%input$grep,
+                             invert='invert'%in%input$grep),
+                        NULL)
+    }else{
+      curr_cols<-switch((input$variable%in%data())+1,data(),input$variable)
+    }
+
+    curr_cols
+  })
+
+  shiny::observe({
+    if(!'retain'%in%input$grep){
+      shiny::updateSelectizeInput(session=session,
+                           inputId = 'variable',
+                           choices = data(),
+                           selected = input$variable,
+                           options = list(multiple=TRUE,create=TRUE))
+    }
+  })
+
+  return(current_cols)
+  }

81 regexSelect/my/regexSelectUI.R

@@ -0,0 +1,88 @@
+#' @title Create UI object for a selectize list input control with regular expression capabilities
+#' @description Create UI object for a selectize list that can be used to choose a single or
+#'  multiple items from a list of values with extension for regular expression.
+#' @param id id of shiny module used in regexSelect
+#' @param label character, label of the selectize object
+#' @param choices List of values to select from. If elements of the list are named, 
+#' then that name rather than the value is displayed to the user. This can also be a 
+#' named list whose elements are (either named or unnamed) lists or vectors. If this 
+#' is the case, the outermost names will be used as the "optgroup" label for the elements 
+#' in the respective sublist. This allows you to group and label similar choices.
+#' @param checkbox.selected character, options of the checkbox to set as TRUE, see details, 
+#' Default: c("enable", "ignore.case")
+#' @param checkbox.inline boolean, render the checkbox choices inline (i.e. horizontally), 
+#' Default: TRUE
+#' @param checkbox.show boolean, show the checkbox options as part of UI output or hide them, 
+#' Default: FALSE
+#' @details checkbox.selected is used as a proxy for ellipses to pass arguments
+#'  to a grep(selectize value, selectize choices,value=TRUE,...). This makes the 
+#'  options in checkbox.selected the same as the arguments that pass to grep: ignore.case, 
+#'  perl,fixed and invert. 
+#'  
+#'  In addition there are two more arguments that the user can set 
+#'  enable which toggles the grep functionality to return it to regular selectize with options 
+#'  multiple=TRUE and create=TRUE. The other argument is retain, this lets the user control if 
+#'  the search terms are added to the selectize choices or to keep it as originally entered, 
+#'  there by converting the selectize into a search field. If checkbox.show is false the 
+#'  initial values passed through checkbox.selected will be used. 
+#' @return A list of HTML elements that can be added to a UI definition.
+#' @examples
+#' if(interactive()){
+#'ui <- shiny::fluidPage(
+#'regexSelectUI(id = "a", label = "Variable:",choices = names(iris)),
+#'shiny::tableOutput("data")
+#')
+#' 
+#' 
+#'ui.show <- shiny::fluidPage(
+#'regexSelectUI(id = "a", label = "Variable:",choices = names(iris),checkbox.show = TRUE),
+#'shiny::tableOutput("data")
+#')
+#'
+#'server <- function(input, output, session) {
+#'  curr_cols<-shiny::callModule(regexSelect, "a",shiny::reactive(names(iris)))
+#'  
+#'  shiny::observeEvent(curr_cols(),{
+#'  cols_now<-curr_cols()
+#'  if(length(cols_now)==0)  cols_now<-names(data())
+#'  output$data <- shiny::renderTable({iris[,cols_now , drop = FALSE]}, rownames = TRUE)
+#'  })
+#'}
+#'
+#'#do not show regex checkboxes
+#'shiny::shinyApp(ui, server)
+#'
+#'#show regex checkboxes
+#'shiny::shinyApp(ui.show, server)
+#'  }
+#' @rdname regexSelectUI
+#' @export 
+#' @import shiny
+#' @importFrom shinyjs useShinyjs
+regexSelectUI <- function(id, label, choices,checkbox.selected=c('enable','ignore.case'),checkbox.inline=TRUE,checkbox.show=FALSE) {
+
+  ns <- shiny::NS(id)
+
+  checkbox_group<-function(checkbox.selected,checkbox.inline){
+    shiny::checkboxGroupInput(inputId = ns('grep'),label = 'regex options',
+                              choices = c('Enable'='enable',
+                                          'Retain Searches'='retain',
+                                          'Ignore Case'='ignore.case',
+                                          'Perl'='perl',
+                                          'Fixed'='fixed',
+                                          'Invert'='invert'),
+                              selected = checkbox.selected,
+                              inline  = checkbox.inline)}
+
+  tagOut<-shiny::tagList(
+    shinyjs::useShinyjs(),
+    shiny::selectizeInput(inputId = ns("variable"),
+                          label = label,
+                          choices = choices,
+                          options=list(multiple=TRUE,create = TRUE)),
+    checkbox_group(checkbox.selected,checkbox.inline))
+
+  if(!checkbox.show) tagOut[[3]]=shinyjs::hidden(checkbox_group(checkbox.selected,checkbox.inline))
+
+  tagOut
+}