如何根据用户输入更改 table 上特定单元格的值? R闪亮

How to change the values of a specific cell on a table based off user inputs? R Shiny

我有以下闪亮的应用程序。我的目标是让用户 select 他们希望更改的列和行并用新文本替换它。

我正在尝试使用 dplyr 并将此问题用作资源。

虽然出于某种原因在我闪亮的应用程序中我无法让它工作?

列输入标识列,然后行号标识要更改的行。然后最后一个输入是您可以输入新值的地方。

这是我想要的输出的屏幕截图

代码


library(shiny)
library(gt)

ui <- fluidPage(# App title ----
                titlePanel("Hello Shiny!"),
                
                # Sidebar layout with input and output definitions ----
                sidebarLayout(
                  # Sidebar panel for inputs ----
                  sidebarPanel(
                    uiOutput("colControls"),
                    numericInput(
                      "AnnotateNum1",
                      label = "Select Row Numbers to Annotate",
                      min = 0,
                      max = 1000000,
                      value = 1
                    ),
                    textInput("AnnotateText1", label = "Enter Annotation Number", value = "")
                    
                  ),
                  
                  # Main panel for displaying outputs ----
                  mainPanel(# Display Graph
                    gt_output("gt_table"))
                  
                ))
)


server <- function(input, output) {
  
  
  data <- reactive({
    d <- gt::gtcars %>% head(10)
    d
  })
  
  # Choose Column to change
  output$colControls <- renderUI({
    selectInput(
      inputId = "cols",
      "Filter Columns",
      choices = data() %>% colnames(),
      multiple = TRUE
    )
  })
  
  
  # new_data <- reactive({
  #   if (is.null(input$cols)) {
  #     data()
  #   } else {
  #     data() %>%
  #       mutate(input$cols = ifelse(
  #         row_number() == {input$AnnotateNum1},
  #         {input$AnnotateText},
  #         input$cols
  #       )) }
  #   
  # })
  # 
  # 
  output$gt_table <- render_gt({
    z <- #new_data() %>% 
      data()
      gt()
    z
  })
  
}

由于列名是字符串,因此您需要在 dplyr -

中使用一些 non-standard 评估
library(shiny)
library(gt)

ui <- fluidPage(# App title ----
                titlePanel("Hello Shiny!"),
                
                # Sidebar layout with input and output definitions ----
                sidebarLayout(
                  # Sidebar panel for inputs ----
                  sidebarPanel(
                    uiOutput("colControls"),
                    numericInput(
                      "AnnotateNum1",
                      label = "Select Row Numbers to Annotate",
                      min = 0,
                      max = 1000000,
                      value = 1
                    ),
                    textInput("AnnotateText1", label = "Enter Annotation Number", value = "")
                    
                  ),
                  
                  # Main panel for displaying outputs ----
                  mainPanel(# Display Graph
                    gt_output("gt_table"))
                  
                ))
)


server <- function(input, output) {
  
  
  data <- reactive({
    d <- gt::gtcars %>% head(10)
    d
  })
  
  # Choose Column to change
  output$colControls <- renderUI({
    selectInput(
      inputId = "cols",
      "Filter Columns",
      choices = data() %>% colnames(),
      multiple = TRUE
    )
  })
  
  
  new_data <- reactive({
    if (is.null(input$cols) || input$AnnotateText1 == "") {
      data()
    } else {
      data() %>%
        mutate(!!input$cols := ifelse(
          row_number() == input$AnnotateNum1,
          input$AnnotateText1,
          .data[[input$cols]]
        )) }

  })


  output$gt_table <- render_gt({
    z <- new_data() %>% 
    gt()
    z
  })
  
}

shinyApp(ui, server)