Выбор динамического ввода в блестящем приложении

Я сделал блестящее приложение, для которого есть три меню:

  1. Данные: для загрузки данных, выбора переменной и отображения таблицы.
  2. Результаты: отображается только при нажатии кнопки «Продолжить» на вкладке «Данные». После некоторого расчета здесь будут отображаться результаты.
  3. Графики: выбор переменной из результата, полученного на вкладке «Результат», и отображение некоторого графика. Возможность выбора переменной должна быть доступна только при нажатии кнопки «Продолжить» на вкладке «Данные».

Я успешно завершил меню 1 и 2, но столкнулся с проблемой выбора результата формы переменной, полученного на вкладке «Результаты».

Вы можете получить данные Iris по этой ссылке http://en.osdn.jp/projects/sfnet_irisdss/downloads/IRIS.csv/ для загрузки.

Вот код

library(shiny)
library(shinydashboard)
library(DT)
library(shiny)

ui <- dashboardPage(
  dashboardHeader(title = "Dashboard"),
  dashboardSidebar(sidebarMenu(
    menuItem("Data", tabName = "data", icon = icon("table")),
    menuItem("Results", tabName = "results", icon = icon("tasks")),
    menuItem("Plots", tabName = "plots", icon = icon("line-chart"))

  )),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "data",
              fluidPage(
                fluidRow(
                  column(3,h3("Upload Your Data"),
                         fileInput('file1', 'Choose CSV File',
                                   accept=c('text/csv', 
                                            'text/comma-separated-values,text/plain', 
                                            '.csv')),
                         tags$hr(),
                         uiOutput('opts1')
                  ),

                  column(9,
                         uiOutput('box1')
                  )
                )
              )
      ),
      # Second tab content
      tabItem(tabName = "results",
              conditionalPanel("input.submit", 
                               fluidPage(box(title = "Results", solidHeader = TRUE, width = NULL, status = "primary",
                                             div(DT::dataTableOutput("showresults")))),
                                  tags$hr())

      ),
      # Third tab content
      tabItem(tabName = "plots",
              uiOutput('opts2')     
      )
    )
  )
)

server.R

shinyServer(function(input, output, session) {

  ## upload data

  theData <- reactive({
    infile <- input$file1        
    if(is.null(infile))
      return(NULL)        
    d <- read.csv(infile$datapath, header = T)
    d        
  })

  ## display data

  output$contents <- DT::renderDataTable({
    data1 <- theData()
    datatable(data1,
              options = list(searching = FALSE, filter = "top",
                             lengthMenu = list(c(10, 20, -1), c('10', '20', 'All')),
                             pageLength = 10)
    )
  })

  # dynamic box display
  output[["box1"]] <- renderUI({

    if(is.null(theData()))return()
    box(
      title = "Data", solidHeader = TRUE, width = NULL, status = "primary",
      div(style = 'overflow-x: scroll;', DT::dataTableOutput('contents'))
    )

  })

  ## dynamic input selection in Results tab
  output[["opts1"]] <- renderUI({

    if(is.null(theData())) return()
    fluidRow(selectInput('y', 'Y Variable', '---'),
             tags$hr(),
             actionButton("submit", "Proceed"))
  })

  # dynamic variable names
  observe({
    data<-theData()
    updateSelectInput(session, 'y', choices = names(data))
    #     updateSelectInput(session, 'yImp', yImp1)

  })

  resultOut <- eventReactive(input$submit,{
    var <-input$y
    data0 <- theData()
    yData <- data0[,match(var, colnames(data0))]
    data1 <- data0[,sapply(data0, is.numeric)]

    ## Some calculation
    dataOut <- colSums(data1*yData)
    dataOut <- dataOut[order(dataOut)]
    dataOut <- data.frame(Rank = 1:length(dataOut),
                             Variable = names(dataOut),
                             Sum = dataOut)
  })

  ## display result in result tab
  output$showresults <- DT::renderDataTable({
    dispRes <- resultOut()
    datatable(dispRes, rownames = F,
              options = list(lengthMenu = list(c(10, 20, -1), c('10', '20', 'All')),
                             pageLength = 10))
  })

  ## take input of variable in result Out in tab Plots

  output[["opts2"]] <- renderUI({

    if(!input$submit) return()
    fluidRow(selectInput('yOut', 'Y Variable', '---'),
             tags$hr(),
             actionButton("submit", "Proceed"))
  })

  # dynamic variable names
  observe({
    dataOut<-resultOut()
    yList <- dataOut$Variable
    updateSelectInput(session, 'yOut', choices = yList)
    #     updateSelectInput(session, 'yImp', yImp1)

  })

})

person Rajan    schedule 18.08.2016    source источник


Ответы (1)


Похоже, что событие наблюдения не реагирует на переменную resultOut или запускается до визуализации ввода select. Интересная проблема. Единственное решение, которое я придумал, - это отобразить полный selectInput (включая варианты выбора) в выводе [["opts2"]]. Это код:

output[["opts2"]] <- renderUI({

            if(is.null(resultOut)) return()
            dataOut <- resultOut()
            yList <- dataOut$Variable
            fluidRow(selectInput('yOut', 'Y Variable', choices = yList),
                     tags$hr(),
                     actionButton("submit1", "Proceed")
            )
    })

и удалить последнего наблюдателя.

Это обсуждение, вероятно, относится к этому. R shiny Наблюдать за работой перед загрузкой пользовательского интерфейса, и это приводит к нулевым параметрам

person Valter Beaković    schedule 18.08.2016
comment
Это действительно странно. Как уже отмечал Вальтер, это, скорее всего, связано с тем, что наблюдатель запускается до создания виджета, и его решение - определение вариантов выбора в renderUI - подходит. Другое решение - снова использовать conditionalPanel вместо renderUI. Виджет будет существовать с самого начала, и проблем с его обновлением не возникнет. - person Michal Majka; 19.08.2016