CODEWITHSUNDEEP
rshiny
firmo23
firmo23

Reputation: 8404

Keep multiple changes in a shiny app after updating values

I have a shiny app in which there are two tables. As you can see the user uses the right datatable and the widgets there in order to display the results in the rhandsontable on the left. The app works as expected except that the fact every time I choose a different Test by the selectInput() "Label" all the previous changes I have made are lost and the rhandsontable on the left "restarts". I used this in order to keep the modified names but I need to apply a similar logic to the whole app.

Logic of the app:

The user chooses one of the Tests by using the selectInput() "Label". This is the main operation and then he is able to modify its name, for example Test 1 to Test A. Then the user can add items in the Test by the numericInput() "Items in Test". These are the total items. As you will see the number of "Items in Test" is the same with 'Avail' column in hot3 table for the choosen Test. With "Select Items" he can choose specific items to be displayed in the hot5 table. Then the user can click on the hot5 table to select a specific item and the number of selected items (or rows) is displayed in the hot3 table under "Sel" column for this specific Test. The 'Items chosen' just displayes the number of Items selected in "Select Items". Note that every modification that happens to the table is not dependent on the other widgets. That means for example that it is not necessary to change a Label Name.

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

  )



}

Upvotes: 0

Views: 250

Answers (1)

ashleych
ashleych

Reputation: 1054

Made edits based on comments. I think the code works, but its fairly fragile and needs a fair degree of error handling. Resetting entriesafter submit is hit, for instance

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")
                            ),
                            fluidRow(actionButton("submit","submit"))
                     )
                   ))
               )
             )
           )
  )
)
#server
server <- function(input, output, session) {

  rv<-reactiveValues()

  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({
    # changed from selectize
    selectizeInput(
      "bk10", "Select Items", choices =1:10000,multiple =T,selected = 1,
      options = list(maxItems = input$bk1))#changed from
  })
  output$book11<-renderUI({
    textInput("bk11", "Items chosen",
              value = nrow(rt5())
    )
  })

  #rt4<-reactive({
  observe({
    req(input$text2)

    rv$rt4 = data.frame(
      SNo = rep(TRUE, input$text2),
      Test=paste(1:input$text2),
      Label=paste("Test",1:input$text2),
      Avail=1L,
      Sel =as.integer(rep.int(0,input$text2)),
      stringsAsFactors = FALSE)
  })

  observeEvent(input$submit,{

 # rt4 <- reactive({
    if (is.null( rv$rt4))
      return(NULL)

    if(!is.null(input$bk6) && input$bk6!=""){
      rv$rt4[ rv$rt4$Label==input$bk3, "Avail"] <- input$bk1
      rv$rt4[ rv$rt4$Label==(input$bk3), "Sel"] <- length(input$hot5_rows_selected)

      rv$rt4[ rv$rt4$Label==input$bk3, "Label"] <- input$bk6
    }
    # if(!is.null(input$hot5_rows_selected) && input$hot5_rows_selected!=""){
    #
    # }
  })

  observeEvent(input$submit,{

    updateSelectInput(session,"bk3","Label", choices=rv$rt4$Label)
  }
  )


  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({
    req(input$text2)
    rhandsontable(rv$rt4)
  })
}
shinyApp(ui,server)

Upvotes: 1

Related Questions