闪亮的反应式renderUI和多个相关/耦合输入

时间:2018-01-25 10:29:59

标签: r shiny reactive-programming selectize.js shinyjs

我有以下示例应用,我需要能够在不破坏应用且隐藏的情况下切换multiple_choice_1_source multiple_choice_2_type的输入当输入发生变化时,submit_request_button_uiColnamesInput。基本上,用户应该能够在点击"提交"之后修改输入。按钮和应用程序应重置为以前的状态。

我尝试过:

shinyjs() - 这只是隐藏而不是清除输入。这意味着,一旦我按下submit_request_button,对multiple_choice_2_type所做的任何更改仍然会被处理并作出反应。在实际的应用程序中,我将提交绑定到非常大的表。我想阻止获取 selected_data()重新运行并清除并隐藏前两个选项中创建的元素。

reactive - 我试图让观察者听一些从多个输入中获取依赖关系的反应式触发器。我使用user_input_rv来存储值等但由于观察者被多次触发而失败,因此当我单击提交按钮时,reactive({})中的if语句被触发两次,主要是下载每个数据集不止一次。它也失败了。

isolate - 我无法完成这项工作。我尝试了多种隔离组合但没有成功。

library(shiny)
library(tidyverse)


ui <- fluidPage(

   selectizeInput(inputId ='multiple_choice_1_source',
                  choices = c("db1","db2","db3","db4"), # like this because we want the selected to be blank on initialisation
                  label = "1. Select source",
                  multiple = FALSE,
                  size = 10,
                  width = '100%'
   )

   ,uiOutput(outputId="multiple_choice_2_type_ui")
   ,uiOutput(outputId="submit_request_button_ui")
   ,uiOutput(outputId="ColnamesInput")
)


server <- function(input, output)
{

   user_input_rv =  reactiveValues(

      source_picked             = NULL,
      last_used_source          = NULL,

      type_picked               = NULL,
      series_picked             = NULL,
      last_used_series          = NULL,

      selected_data             = NULL,
      final_selection           = NULL
   )

   observeEvent(input$multiple_choice_1_source, {

      user_input_rv$source_picked <- input$multiple_choice_1_source

      #change data loaded under type picked.
      user_input_rv$type_picked <-
         if (        input$multiple_choice_1_source == "db1"){ paste0(colnames(mtcars))
         } else if ( input$multiple_choice_1_source == "db2"){ paste0(colnames(diamonds))
         } else if ( input$multiple_choice_1_source == "db3"){ NULL
         } else if ( input$multiple_choice_1_source == "db4"){ NULL
         }

      output$multiple_choice_2_type_ui <- renderUI({

         selectizeInput( inputId = 'multiple_choice_2_type',
                         choices = paste(user_input_rv$type_picked),
                         label= "2. Select type",
                         multiple = TRUE,
                         size = 10,
                         width = '100%',
                         options = list( placeholder = 'Type',
                                         maxItems =1
                         )
         )
      })

   }) #first observeEvent for source type and data load.

   observeEvent(input$multiple_choice_2_type,{

      output$submit_request_button_ui <- renderUI({

            actionButton(
               inputId = "submit_request_button",
               label = " Get data "
         )
      })
   })#second observeEvent for submit_request_button_ui

   observeEvent(input$submit_request_button, {

      selected_data <- reactive({

         if( input$multiple_choice_1_source =="db1"){

             mtcars


         } else if ( input$multiple_choice_1_source == "db1")                 {

         diamonds


         } else if ( input$multiple_choice_1_source == "db3")      { NULL

         } else if ( input$multiple_choice_1_source == "db4"){ NULL
         }



      })

      user_input_rv$series_picked <- input$multiple_choice_2_type

      user_input_rv$selected_data <- selected_data()


            min_cols <- as.integer(1) # default 1
            max_cols <- as.integer(length(colnames(selected_data())))
            #print(max_cols)


            #this renderUI creates the right-hand side column of the app COLUMNS
            output$ColnamesInput <-  renderUI({

               lapply(min_cols:max_cols, function(z) {

                  column(width = 3,
                         offset = 0,
                            selectInput( inputId = paste0("cols","_",z),
                                         label = paste(input$multiple_choice_2_type,": ",colnames(selected_data())[z]),
                                         choices = unique(selected_data()[[z]]),
                                         multiple = TRUE
                            ) #selectizeInput

                  )

               })#lapply inner

            }) #renderUI for columns

   }) #third observeEvent for data selection and customisation

}

shinyApp(ui = ui, server = server)

1 个答案:

答案 0 :(得分:1)

以下是我从中移除reactive expression并使用本地变量selected_data的代码。

  observeEvent(input$submit_request_button, {

    # selected_data <- reactive({

      # browser()
    selected_data <- NULL

      if( input$multiple_choice_1_source =="db1"){

        selected_data <- mtcars


      } else if ( input$multiple_choice_1_source == "db1")                 {

        selected_data <- diamonds


      } else if ( input$multiple_choice_1_source == "db3")      { selected_data <- NULL

      } else if ( input$multiple_choice_1_source == "db4"){selected_data <-   NULL
      }



    # })

    user_input_rv$series_picked <- isolate(input$multiple_choice_2_type)

    user_input_rv$selected_data <- selected_data


    min_cols <- as.integer(1) # default 1
    max_cols <- as.integer(length(colnames(selected_data)))
    #print(max_cols)


    #this renderUI creates the right-hand side column of the app COLUMNS
    output$ColnamesInput <-  renderUI({

      lapply(min_cols:max_cols, function(z) {

        column(width = 3,
               offset = 0,
               selectInput( inputId = paste0("cols","_",z),
                            label = paste(isolate(input$multiple_choice_2_type),": ",colnames(selected_data)[z]),
                            choices = unique(selected_data[[z]]),
                            multiple = TRUE
               ) #selectizeInput

        )

      })#lapply inner

    }) #renderUI for columns

  }) #third observeEvent for data selection and customisation

现在,当您更改选择输入选项时,ColnamesInput不会被触发。只有在您单击“提交”按钮后才会触发它。

<强> [编辑]:

可能不是最好的方法,但我认为我能够达到你想要的效果。此外,我已经冒昧地使用已在服务器中定义的reactiveValue。看看下面修改过的服务器代码:

server <- function(input, output)
{
  user_input_rv =  reactiveValues(

    source_picked             = NULL,
    last_used_source          = NULL,

    type_picked               = NULL,
    series_picked             = NULL,
    last_used_series          = NULL,

    selected_data             = NULL,
    final_selection           = NULL
  )



  observeEvent(input$multiple_choice_1_source, {


    user_input_rv$source_picked <- input$multiple_choice_1_source

    ###Start: To check if the source changed#########
    if(!is.null(user_input_rv$last_used_source))
    {
      if(user_input_rv$last_used_source != user_input_rv$source_picked)
      {
        shinyjs::hide("ColnamesInput")
        user_input_rv$last_used_source = user_input_rv$source_picked
      }
    }else
    {
      user_input_rv$last_used_source = user_input_rv$source_picked
    }
    ###End: To check if the source changed#########


    #change data loaded under type picked.
    user_input_rv$type_picked <-
      if (        input$multiple_choice_1_source == "db1"){ paste0(colnames(mtcars))
      } else if ( input$multiple_choice_1_source == "db2"){ paste0(colnames(diamonds))
      } else if ( input$multiple_choice_1_source == "db3"){ NULL
      } else if ( input$multiple_choice_1_source == "db4"){ NULL
      }

    output$multiple_choice_2_type_ui <- renderUI({

      selectizeInput( inputId = 'multiple_choice_2_type',
                      choices = paste(user_input_rv$type_picked),
                      label= "2. Select type",
                      multiple = TRUE,
                      size = 10,
                      width = '100%',
                      options = list( placeholder = 'Type',
                                      maxItems =1
                      )
      )
    })

  }) #first observeEvent for source type and data load.

  observeEvent(input$multiple_choice_2_type,{


    ###Start: To check if the series changed######### 
    user_input_rv$series_picked <- input$multiple_choice_2_type

    if(!is.null(user_input_rv$last_used_series))
    {
      if(user_input_rv$last_used_series != user_input_rv$series_picked)
      {
        shinyjs::hide("ColnamesInput")
        user_input_rv$last_used_series = user_input_rv$series_picked
      }
    }else
    {
      user_input_rv$last_used_series = user_input_rv$series_picked
    }
    ###End: To check if the series changed#########

    output$submit_request_button_ui <- renderUI({

      actionButton(
        inputId = "submit_request_button",
        label = " Get data "
      )
    })
  })#second observeEvent for submit_request_button_ui

  observeEvent(input$submit_request_button, {

    # selected_data <- reactive({

      # browser()
    shinyjs::show("ColnamesInput")
    selected_data <- NULL

      if( input$multiple_choice_1_source =="db1"){

        selected_data <- mtcars


      } else if ( input$multiple_choice_1_source == "db1")                 {

        selected_data <- diamonds


      } else if ( input$multiple_choice_1_source == "db3")      { selected_data <- NULL

      } else if ( input$multiple_choice_1_source == "db4"){selected_data <-   NULL
      }



    # })

    user_input_rv$series_picked <- isolate(input$multiple_choice_2_type)

    user_input_rv$selected_data <- selected_data


    min_cols <- as.integer(1) # default 1
    max_cols <- as.integer(length(colnames(selected_data)))
    #print(max_cols)


    #this renderUI creates the right-hand side column of the app COLUMNS
    output$ColnamesInput <-  renderUI({

      lapply(min_cols:max_cols, function(z) {

        column(width = 3,
               offset = 0,
               selectInput( inputId = paste0("cols","_",z),
                            label = paste(isolate(input$multiple_choice_2_type),": ",colnames(selected_data)[z]),
                            choices = unique(selected_data[[z]]),
                            multiple = TRUE
               ) #selectizeInput

        )

      })#lapply inner

    }) #renderUI for columns

  }) #third observeEvent for data selection and customisation

}

希望它有所帮助!