更新值后,请在闪亮的应用中保留多项更改

时间:2018-08-23 17:01:57

标签: r shiny

我有一个闪亮的应用程序,其中有两个表。如您所见,用户使用右边的数据表和那里的小部件,以便在左边的rhandsontable中显示结果。该应用程序可以按预期运行,除了每次我通过selectInput()“标签”选择一个不同的测试的事实都会丢失之前所做的所有更改之前,并且左侧的rhandsontable会“重新启动”。我使用this来保留修改后的名称,但是我需要对整个应用程序应用类似的逻辑。

应用的逻辑:

用户通过使用selectInput()“ Label”选择测试之一。这是主要操作,然后他可以修改其名称,例如将Test 1更改为TestA。然后,用户可以通过numericInput()“ Tests中的项目”在Test中添加项目。这些是总项目。正如您将看到的,“测试中的项目”的数目与hot3表中“测试”中“可用”列的数目相同。通过“选择项目”,他可以选择要在hot5表中显示的特定项目。然后,用户可以单击hot5表以选择特定项目,并且针对该特定测试,hot3表中“ Sel”列下的选定项目(或行)数将显示。 “选择的项目”仅显示在“选择项目”中选择的项目数。请注意,对该表进行的每次修改都不依赖于其他小部件。例如,这意味着不必更改标签名称。

library(shiny)
library(DT)
library(rhandsontable)
library(tidyverse)

ui <- navbarPage(
  "Application",
  tabPanel("Booklets",
           sidebarLayout(
             sidebarPanel(
               uiOutput("tex2"),
               rHandsontableOutput("hot3")
             ),
             mainPanel(
               fluidRow(
                 wellPanel(
                   fluidRow(
                     column(4,
                            DT::dataTableOutput("hot5")       
                     ),
                     column(4,
                            fluidRow(
                              uiOutput("book3"),
                              uiOutput("book6")

                            ),
                            fluidRow(
                              uiOutput("book1"),
                              uiOutput("book10"),
                              uiOutput("book11")
                            )
                     )
                   ))
               )
             )
           )
  )
  )
#server
server <- function(input, output, session) {

  output$tex2<-renderUI({
    numericInput("text2", "#tests", value = 1, min=1)
  })

  output$book1<-renderUI({
    numericInput("bk1", 
                 "Items in test", 
                 value = 1,
                 min = 1)
  })
  output$book3<-renderUI({

    selectInput("bk3", 
                "Label", 
                choices=(paste("Test",1:input$text2)))
  })


  output$book6<-renderUI({
    textInput("bk6", "Change to",
              value=NULL
    )
  })


  output$book10<-renderUI({
    selectizeInput(
      "bk10", "Select Items", choices =1:10000,multiple =T,selected = 1,
      options = list(maxItems = input$bk1))
  })
  output$book11<-renderUI({
    textInput("bk11", "Items chosen",
              value = nrow(rt5())
    )
  })


  rt4<-reactive({

    if(is.null(input$bk6)|input$bk6==""){
      if(is.null(input$hot5_rows_selected)|| is.na(input$hot5_rows_selected)){
        DF=data.frame(
          Sel. = rep(TRUE, input$text2),
          Test=paste(1:input$text2),
          Label=paste("Test",1:input$text2),
          Avail.=format(round(as.integer(rep.int(input$bk1,input$text2))),0),
          Sel =as.integer(rep.int(0,input$text2)),
          stringsAsFactors = FALSE)
      }
      else{
        DF=data.frame(
          Sel. = rep(TRUE, input$text2),
          Test=paste(1:input$text2),
          Label=paste("Test",1:input$text2),
          Avail.=format(round(as.integer(rep.int(input$bk1,input$text2))),0),
          Sel =as.integer(rep.int(0,input$text2)),
          stringsAsFactors = FALSE)
      }
      for(i in 1 : input$text2){
        if(DF[i,3]==input$bk3){
          DF[i,4]<-input$bk1
          DF[i,5]<-length(input$hot5_rows_selected)
        }
        else{
          DF[i,4]<-1

        }
      }

      DF
    }
    else{
      if(is.null(input$hot5_rows_selected)|| is.na(input$hot5_rows_selected)){
        DF=data.frame(
          Sel. = rep(TRUE, input$text2),
          Test=paste(1:input$text2),
          Label=paste("Test",1:input$text2),
          Avail.=format(round(as.integer(rep.int(input$bk1,input$text2))),0),
          Sel =as.integer(rep.int(0,input$text2)),
          stringsAsFactors = FALSE)
        DF[DF==input$bk3]<-input$bk6
        DF
      }
      else{
        DF=data.frame(
          Sel. = rep(TRUE, input$text2),
          Test=paste(1:input$text2),
          Label=paste("Test",1:input$text2),
          Avail.=format(round(as.integer(rep.int(input$bk1,input$text2))),0),
          Sel =as.integer(rep.int(0,input$text2)),
          stringsAsFactors = FALSE)
        DF[DF==input$bk3]<-input$bk6
        DF
      }

      for(i in 1 : input$text2){
        if(DF[i,3]==input$bk6){
          DF[i,4]<-input$bk1
          DF[i,5]<-length(input$hot5_rows_selected)
        }
        else{
          DF[i,4]<-1

        }
      }
      DF
    }

  })

  rt55<-reactive({
    DF=data.frame(
      Id=  input$bk10,
      Label=paste("Item",input$bk10),
      Pf=0,
      stringsAsFactors = FALSE
    )
  })

  rt5<-reactive({
    DF=data.frame(
      Id=  input$bk10,
      Label=paste("Item",input$bk10),
      Pf=0,
      stringsAsFactors = FALSE
    )
    cbind(id=rowSelected(), DF)
  })

  rowSelected <- reactive({
    x <- numeric(nrow(rt55()))
    x[input$hot5_rows_selected] <- 1
    x
  })

  output$hot5 <- renderDT(datatable(rt5()[,-1],
                                    selection = list(mode = "multiple",
                                                     selected = (1:nrow(rt5()[,-1]))[as.logical(rowSelected())],
                                                     target = "row"),rownames = F)
  )



  output$hot3 <-renderRHandsontable(
    rhandsontable(rt4())

  )



}

1 个答案:

答案 0 :(得分:1)

根据评论进行编辑。我认为代码可以工作,但它相当脆弱,需要相当程度的错误处理。例如,点击提交后重置条目

        private ICommand _AddItemCmd;
        public ICommand AddItemCmd
        {
            get
            {
                if (_AddItemCmd == null)
                    _AddItemCmd = new CreateCommand(AddItemToList,IsProductItemEmpty);
                return _AddItemCmd;
            }
            set
            {
                _AddItemCmd = value;
            }
        }

        public void AddItemToList(){
           //My blah blah code
        }
        public bool IsProductItemEmpty(){
           //return true
           //OR
           //return false
        }