Dynamically passing selectInput values from UI to Server code in R

Question

The process_map() function in the server in the R shiny script creates the diagram image as below. My requirement is that there are two attributes "FUN" and "units" that are part of the performance() function. They have standard four values each that are available in the ui code below under PickerInput ID's Case4 and Case5. Currently, I am hard coding the value to create the map, can you help me to use the id's in the server code and make it dynamic such that when I select the value in the PickerInput, the formula fetches the value directly. Thanks and please help.

library(shiny)
library(shinydashboard)
library(bupaR)
library(processmapR)
library(lubridate)
library(dplyr)
library(edeaR)
library(shinyWidgets)
library(DiagrammeR)
ui <- dashboardPage(
dashboardHeader(title = "Diagram Plot",titleWidth = 290),
dashboardSidebar(width = 0),
dashboardBody(
tabsetPanel(type = "tab",
            tabPanel("Overview", value = 1,

                     box(
                       column(1, 
                              dropdown(
                                pickerInput(inputId = "resources", 
                                            label = "", 
                                            choices = c("Throughput Time"), 
                                            choicesOpt = list(icon = c("fa fa-bars", 
                                                                       "fa fa-bars", 
                                                                       "fa fa-safari")), 
                                            options = list(`icon-base` = "")),
                                circle = FALSE, status = "primary", icon = icon("list", lib = "glyphicon"), width = "300px"
                              ),

                              conditionalPanel(
                                condition = "input.resources == 'Throughput Time' ",


                                tags$br(),
                                tags$br(),
                                tags$br(),
                                dropdown(
                                  pickerInput(inputId = "Case4", 
                                              label = "Select the Process Time Summary Unit", 
                                              choices = c("min","max","mean","median"), options = list(`actions-box` = TRUE), 
                                              multiple = F),
                                  circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
                                ),
                                tags$br(),
                                tags$br(),
                                tags$br(),
                                dropdown(
                                  pickerInput(inputId = "Case5", 
                                              label = "Select the Process Time Unit", 
                                              choices = c("mins","hours","days","weeks"), options = list(`actions-box` = TRUE), 
                                              multiple = F, selected  = "days"),
                                  circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
                                ))),
                       title = "Process Map", 
                       status = "primary",height = "575", width = "500",
                       solidHeader = T,
                       column(10,grVizOutput("State")),
                       align = "left")


                     ),

            id= "tabselected"
            )))
  server <- function(input, output) { 
  output$State <- renderDiagrammeR(
  {

    if(input$resources == "Throughput Time")
      patients %>% process_map(performance(FUN = mean,units = "days"))
    else
    return()
    })}
  shinyApp(ui, server)

Mahdi Baghbanzadeh · Answer 1 · 2018-03-05T06:19:06.683

1

test this:

output$State <- renderDiagrammeR({

      if(input$resources == "Throughput Time")
      {
        if(input$Case4=="mean"){
        patients %>% process_map(performance(FUN = mean,units = input$Case5))}
      else if(input$case4=="min"){
        patients %>% process_map(performance(FUN = min,units = input$Case5))
      }else if(input$case4=="max"){
        patients %>% process_map(performance(FUN = max ,units = input$Case5))
      }else{
        patients %>% process_map(performance(FUN = median ,units = input$Case5))
      }

        }else
        return()
  })

or you can use this:

patients %>% 
process_map(performance(FUN = eval(parse(text=input$Case4)) ,units = input$Case5))

enjoy;)

here is a sample:

library(shiny)

ui <- fluidPage(
selectInput(inputId = "func", label = "Choose The Function", choices = c("mean", "sum", "median"))
,
textOutput("text")
)


server <- function(input, output, session) {
  main_data <- reactive({
    data.frame(a= rnorm(100), b=rnorm(100) )
  })

  output$text <- renderText({
    df <- main_data()

   apply(df,2, FUN =  eval(parse(text=input$func)) )
  })

}
shinyApp(ui = ui, server = server)

edited Mar 05 '18 at 06:19

answered Feb 28 '18 at 11:58

Mahdi Baghbanzadeh

540
1
4
10

Hi, thanks for replying, I am getting an error "argument is of length zero", please help me here, also why can't I make the FUN variable dynamic? – Adam Shaw Feb 28 '18 at 12:05
run it without shiny and test it if you have correctly computed everything (for example: patients). you can use a switch function or this way, I only know these two ways – Mahdi Baghbanzadeh Feb 28 '18 at 12:09
your solution is completely correct, but my point is to reduce the usage of if's and make it as crisp and dynamic I can using shiny input ID's, is it running fine in your system? – Adam Shaw Feb 28 '18 at 12:18
you can test the switch function(above link) to see if it change the performance of your code – Mahdi Baghbanzadeh Feb 28 '18 at 12:27
Performance is not my issue here, I want to use the input ID's in the process map function somehow? – Adam Shaw Feb 28 '18 at 12:34
We have used one of them, but It's getting interesting, cause I have been doing this type of tasks in this way for a year. I am out of office now, but tonight (local time) i will brief you on my solution – Mahdi Baghbanzadeh Feb 28 '18 at 12:49
I appreciate your assistance, at your convenience please! – Adam Shaw Feb 28 '18 at 12:51
Updated the answer – Mahdi Baghbanzadeh Mar 03 '18 at 06:47
thanks for the effort, but I somehow still am getting an error here, have you checked the code from your side?. – Adam Shaw Mar 05 '18 at 06:10
I added a simple Example of what you need, take a look at it. – Mahdi Baghbanzadeh Mar 05 '18 at 06:20

Florian · Answer 2 · 2018-02-28T14:12:01.920

0

You could use do.call to call a function from its name, see the example below. You can add arguments by adding them in the list in the do.call function, e.g. list(x,units=input$Case5).

library(shiny)

x=c(1,2,3,4,5,6,7)

ui <- fluidPage(
 selectInput('select','Select Function: ', choices=c('mean','max','min','median')),
 textOutput('text')
)

server <- function(input,output)
{
  output$text <- renderText({
    result = do.call(input$select, list(x))
    paste0('The ', input$select, ' of [', paste(x,collapse=', '),'] is ', result)
  })
}

shinyApp(ui,server)

Hope this helps!

edited Feb 28 '18 at 14:12

answered Feb 28 '18 at 14:06

Florian

24,425
4
49
80

thanks for the help, regarding your "paste0" command, if you can replace it and test this command patients %>% process_map(performance(FUN = result ,units = "days")). Also you need renderDiagrammeR and grvizOutput to call the diagram, I need help here. Thanks. – Adam Shaw Mar 05 '18 at 06:16

Dynamically passing selectInput values from UI to Server code in R

2 Answers2