0

R 闪亮脚本中服务器中的 process_map() 函数创建如下图图像。我的要求是 performance() 函数有两个属性“FUN”和“units”。它们具有标准的四个值，每个值都可在下面的 PickerInput ID 的 Case4 和 Case5 下的 ui 代码中使用。目前，我正在对值进行硬编码以创建地图，你能帮我在服务器代码中使用 id 并使其动态化，这样当我在 PickerInput 中选择值时，公式会直接获取值。谢谢，请帮忙。

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)

图表图像

4

2 回答 2

1

测试这个：

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()
  })

或者你可以使用这个：

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

请享用;）

这是一个示例：

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)
于 2018-02-28T11:58:36.577 回答
0

您可以使用do.call它的名称调用函数，请参见下面的示例。您可以通过将参数添加到do.call函数的列表中来添加参数，例如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)

希望这可以帮助！

于 2018-02-28T14:06:31.440 回答