具有数字输入交互性问题的Rshiny数据表

wfsdck30 于 2023-02-01 发布在其他

关注(0)|答案(1)|浏览(113)

我想用numericInput在RShiny中创建一个表，这样用户提供的值就可以立即使用。我遵循了HERE代码，但是当变量（汽车型号）改变时，它会停止打印新值。在用户改变输入之前，它一直工作正常。
下面是代码：

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

ui <- fluidPage(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),
  title = 'selectInput or numericInput column in a table',
  sidebarLayout(
    sidebarPanel(
      selectizeInput(inputId = "cars", label = "Car model", choices = rownames(mtcars), selected = rownames(mtcars)[1:6], multiple = T )
    ),
    mainPanel(
      DT::dataTableOutput('carTable'),
      verbatimTextOutput('price')
    )
  )
  
)

server <- function(input, output, session) {
  
  
  rvar <- reactiveValues(
    DF = mtcars
  )
  observeEvent(input$cars,{
    for (i in 1:nrow(rvar$DF)) {
      rvar$DF$price[i] <- as.character(numericInput(paste0("price", i), "", 0, width = "100px"))
    }
    rvar$data <- rvar$DF[rownames(mtcars) %in% input$cars, ] %>% select(-price)
  })
  
  output$carTable = DT::renderDT({
    data <-  rvar$DF[rownames(mtcars) %in% input$cars, ] %>% mutate(carmodel = input$cars) %>% relocate(carmodel)
    datatable(
      data, escape = FALSE, selection = 'none',
      options = list(
        dom = 't', 
        paging = FALSE, 
        ordering = FALSE,
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
      ),
      rownames = FALSE
    )
  }, server = FALSE)
  
  output$price = renderPrint({
    str(sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]))
  })
  
  
  
  observe({
    updatedPrice <- sapply(1:nrow(rvar$DF), function(i) input[[paste0("price", i)]]) %>% Reduce(c,.)
    if(is.null(updatedPrice) | length(updatedPrice) !=  nrow(rvar$data)){
      updatedPrice <- 0
    }
    isolate({
      rvar$data$price <- updatedPrice
    })
    
    print(sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]) %>% Reduce(c,.))
    print(rvar$data)
  })
  
  observeEvent(input$cars, {
    session$sendCustomMessage("unbindDT", "carTable")
  })
  
}

shinyApp(ui, server)

r

来源：https://stackoverflow.com/questions/75277970/r-shiny-datatable-with-numericinput-interactivity-issue

1条答案

按热度按时间

nhhxz33t1#

是这样的。我试了好几次我都不记得问题出在哪了...

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

ui <- fluidPage(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
            var $table = $('#'+id).find('table');
            if($table.length > 0){
              Shiny.unbindAll($table.DataTable().table().node());
            }
      })")
  )),
  title = "selectInput or numericInput column in a table",
  sidebarLayout(
    sidebarPanel(
      selectizeInput(
        inputId = "cars", label = "Car model", 
        choices = rownames(mtcars), selected = rownames(mtcars)[1:6], 
        multiple = TRUE
      )
    ),
    mainPanel(
      DTOutput("carTable"),
      verbatimTextOutput("price")
    )
  )
)

server <- function(input, output, session) {
  
  rvar <- reactiveValues(
    DF = mtcars
  )
  
  observeEvent(input$cars, {
    rvar$DF <- rvar$DF[rownames(mtcars) %in% input$cars, ]
    for(i in 1:nrow(rvar$DF)) {
      rvar$DF$price[i] <- 
        as.character(numericInput(paste0("price", i), "", 0, width = "100px"))
    }
    rvar$data <- rvar$DF %>% select(-price)
    rvar$DTdata <- rvar$DF %>%
      mutate(carmodel = input$cars) %>%
      relocate(carmodel)
    session$sendCustomMessage("unbindDT", "carTable")
  })
  
  output$carTable <- renderDT({
    data <- rvar$DTdata
    datatable(
      data,
      escape = FALSE, selection = "none",
      options = list(
        dom = "t",
        paging = FALSE,
        ordering = FALSE,
        preDrawCallback = 
          JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = 
          JS('function() { Shiny.bindAll(this.api().table().node()); }')
      ),
      rownames = FALSE
    )
  },
  server = FALSE
  )
  
  output$price <- renderPrint({
    str(sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]))
  })
  
  observe({
    updatedPrice <- 
      sapply(1:nrow(rvar$DF), function(i) input[[paste0("price", i)]]) %>% 
      Reduce(c, .)
    if(is.null(updatedPrice) || length(updatedPrice) != nrow(rvar$data)) {
      updatedPrice <- 0
    }
    isolate({
      rvar$data$price <- updatedPrice
    })
    
    print(
      sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]) %>% 
        Reduce(c, .)
    )
    print(rvar$data)
  })
  
}

shinyApp(ui, server)

赞(0）回复(0）举报 2023-02-01

我来回答

具有数字输入交互性问题的Rshiny数据表

1条答案

相关问题

热门标签

最新问答