R Shiny: Front end User defined case when statements

[ZykeZero]

Hello everyone!

I apologize in advance that I have no real code to share despite just setting up a basic shiny template. I don't even know where to begin with this road block.

I need to enable my users to define an arbitrary number of conditions that will evaluate data and when evaluated will return a REJECTED status. Basically, I need to let them define a case_when in the front end so they can auto-reject data.

So the requirements to allow full functionality for a user to define conditions to a case_when they need to be able to;

1. select a column to evaluate
2. select an operator [ ==, !=, >=, <=, <, >]
3. select a value to evaluate against
4. Add as many AND and OR sections as needed.

And I have no idea how to approach this problem and after a fair amount of googling I cannot find the right key word search that returns anything useful.

Thank you in advance.

ui <- 
  dashboardPage(
    dashboardHeader(title = "user defined case_when"),
    dashboardSidebar(
      sidebarMenu(
          menuItem("mtcars", tabName = "mtcars", icon = icon("dashboard"))
      )
    ),
###### Body content
    dashboardBody(
      tabItems(
        tabItem(tabName = "mtcars",
          fluidRow(
            box(
              textOutput("textOutput")
            )
          ),
          fluidRow(
            box(width = 12,
              DT::dataTableOutput("mtcars_2_DT")
            )
          )
        )
      )
    )
  )
  

server = function(input, output, session) {
  output$textOutput <- renderText("user defined conditions here")
  
  mtcars_2 <- 
    rownames_to_column(mtcars, "cars") %>% 
    mutate(evaluation_column = NA)
    
  output$mtcars_2_DT <- DT::renderDataTable({
    mtcars_2
  })
}
  
shinyApp(ui, server)

[nirgrahamuk]

library(shiny)
library(shinydashboard)
library(rlang)
library(DT)
library(tidyverse)
ui <- 
  dashboardPage(
    dashboardHeader(title = "user defined case_when"),
    dashboardSidebar(
      sidebarMenu(
        menuItem("mtcars", tabName = "mtcars", icon = icon("dashboard"))
      )
    ),
    ###### Body content
    dashboardBody(
      tabItems(
        tabItem(tabName = "mtcars",
                fluidRow(
                  box(
                    div(actionButton("sub_in","Action"),
                        textInput("textInput","enter condition here")),
                    
                    textOutput("textOutput")
                  )
                ),
                fluidRow(
                  box(width = 12,
                      DT::dataTableOutput("mtcars_2_DT")
                  )
                )
        )
      )
    )
  )


server = function(input, output, session) {
  output$textOutput <- renderText({
    expr_to_use()
  })
  
  expr_to_use <- eventReactive(input$sub_in,
                {
                 if(isTruthy(input$textInput))
                   input$textInput
                  else 
                    NULL
                })
  
  mtcars_2 <- reactive({
    # a default for if the attempted expression is invalid
    result <- rownames_to_column(mtcars, "cars") 
    #use try to try the expression and not error out the app if it fails
    #select = FALSE will still print a log of the error to the console
    try(result <- {
      rownames_to_column(mtcars, "cars") %>%
        mutate(evaluation_column = eval(parse_expr(!!expr_to_use())))
    }, silent = FALSE)

   result
  })
  output$mtcars_2_DT <- DT::renderDataTable({
    mtcars_2()
  })
}

shinyApp(ui, server)