R Shiny Code 在运行时执行多次

Question

我有下面的代码，它允许用户上传 Excel，重命名列，然后围绕热门术语进行一些快速分析等（第一列必须命名为“评论”）。

发生的情况是，当我上传文件 > 重命名我的第一列 > 然后单击快速分析时，它会运行代码 4 次，因此它会不断刷新。我删除了那里的其他 3 张桌子以使其更容易。我想我需要在某个地方使用isolate()，但我不确定。

   # Toy Example.

library(needs)
needs(
  shiny,
  ggplot2,
  tidyverse,
  shinydashboard,
  DT,
  shinycssloaders,
  plotly,
  shinyjs,
  dashboardthemes,
  reactable,
  quanteda
)



## app.R ##
library(shiny)
library(shinydashboard)

convertMenuItem <- function(mi, tabName) {
  mi$children[[1]]$attribs['data-toggle'] = "tab"
  mi$children[[1]]$attribs['data-value'] = tabName
  mi
}

header = dashboardHeader()

sidebar = dashboardSidebar(
  width = 300,

  sidebarMenu(
    id = 'panelsbar',
    convertMenuItem(tabName = 'home', menuItem(
      'Home', tabName = 'home', icon = icon('home')
    )),
    convertMenuItem(
      tabName = 'data',
      menuItem(
        'Data Input',
        tabName = 'data',
        fileInput(
          "file",
          "Upload CSV files",
          multiple = TRUE,
          accept = ("text/comma")
        ),
        uiOutput('textColumn'),
        actionButton('go', 'Run')
      )
    ),
    convertMenuItem(
      tabName = 'variables',
      menuItem('Variable Renaming', tabName = 'variable',
               uiOutput("renamer"))
    ),
    convertMenuItem(tabName = 'quickAnalysis',
                    menuItem('Quick Analysis',
                             tabName = 'quickAnalysis'))
    
    
  )
)


body <- dashboardBody(
  shinyDashboardThemes('grey_light'),
  tabItems(
    tabItem(tabName = 'home'),
    tabItem(tabName = 'data',
            fluidRow(
              box(
                width = 12,
                title = 'Data Input',
                solidHeader = T,
                status = 'primary',
                collapsible = T,
                reactableOutput('rawData')
              )
            )),
    tabItem(tabName = 'variable',
            dataTableOutput("rename")),
    tabItem(tabName = 'quickAnalysis',
            fluidRow(
              box(
                width = 6,
                title = 'Top Terms',
                solidHeader = T,
                plotlyOutput('topTerms')
              ),
              box(
                width = 6,
                title = 'Top bigrams',
                solidHeader = T,
                dataTableOutput('topBis')
              )
            ),
            fluidRow(
              box(
                width = 6,
                title = 'Top 75 Terms',
                solidHeader = T,
                plotOutput('wordcloudTopTerms') %>%
                  withSpinner()
              ),
              box(width = 6, dataTableOutput('x1'))
            ))
    
    
  )
)



ui = shinydashboard::dashboardPage(header, sidebar, body,
                                   tags$head(tags$style(
                                     HTML(".sidebar {
                      height: 90vh; overflow-y: auto;
                    }")
                                   )))


server = server <- function(input, output) {
  options(shiny.maxRequestSize = 30 * 1024 ^ 2)
  
  
  dataa <- reactive({
    req(input$file)
    read.csv(input$file$datapath)
  })
  
  
  output$contents <- renderDataTable({
    dataa()
  })
  
  
  output$rawData = renderReactable({
    reactable(
      dataa(),
      filterable = T,
      resizable = T,
      showPagination = T,
      showSortIcon = T,
      defaultPageSize = 10
    )
  })
  
  
  
  # rename variables --------------------------------------------------------
  
  
  
  output$renamer <- renderUI({
    lapply(colnames(dataa()), function(i) {
      textInput(paste0("col_", i), i, i)
    })
  })
  
  
  DataRename <- reactive({
    req(input$file)
    Data <- dataa()
    DataNew1 <- Data
    
    for (i in names(input)) {
      if (grepl(pattern = "col_", i)) {
        colnames(DataNew1)[which(colnames(DataNew1) == substr(i, 5, nchar(i)))] =
          input[[i]]
      }
      
    }
    
    return(DataNew1)
  })
  
  output$rename <- renderDataTable({
    DataRename()
  })
  
  
  
  numComments = reactive({
    sum(!is.na(df$Comments))
  })
  
  
  
  # Text analysis -----------------------------------------------------------
  x = do.call(c,
              unlist(stopwords::data_stopwords_marimo$en, recursive = F))
  x = c(stopwords(), x, 'takeda')
  x = c(x, stopwords::data_stopwords_stopwordsiso$en)
  stop_words = unique(x)
  
  corp =  reactive({
    req(DataRename())
    x = corpus(DataRename(), text_field = 'Comments')
  })
  
  
  dm = reactive({
    df = DataRename()
    corp = corp()
    
    x = corp %>%
      dfm(
        tolower = T,
        remove = stop_words,
        remove_punct = T,
        remove_symbols = T,
        remove_numbers = T
      )
  })
  
  topTerms = reactive({
    dm = dm()
    x = dm() %>%
      textstat_frequency()
  })
  getTopTerms = reactive({
    x = topTerms()
    x %>% as.data.frame() %>%
      mutate(Frequency = round((docfreq / numComments()) * 100, 1)) %>%
      select(-c(group, frequency, rank)) %>%
      rename(Count = docfreq,
             Terms = feature)
    
  })
  
  plotTerms = reactive({
    top = getTopTerms()
    top = top %>% arrange(desc(Frequency)) %>% top_n(15)
    p = plot_ly(
      data = top,
      type = 'bar',
      y = ~ Terms,
      x =  ~ Frequency,
      source = 'topterms'
    )
    p
  })
  
  output$topTerms = renderPlotly({
    plotTerms()
  })
  
  
  
  
}



shinyApp(ui, server)

Answer 1

除其他外，您的反应图有太多边。

（借用自https://shiny.rstudio.com/articles/reactivity-overview.html的符号）

首先，DataRename 依赖于dataa() 和input$file，但dataa 已经依赖于input$file。因此，每当 input$file 发生变化时，dataa 和 DataRename 都会触发。一旦dataa 触发，它就会触发DataRename 再次。如果你必须在DataRename 中有input$file，那么在此处使用isolate(input$file)。

此外，DataRename 会查看 input$ 中的所有内容，因此...只要在任何地方的任何输入中更新任何内容，就会触发 DataRename。因此，DataRename 下游的所有内容也会被触发，即使是不必要的。

dm 还具有与corp 和DataRename 的冗余依赖关系，其中corp 已经依赖于DataRename。

另一个小问题是numComments 引用df，但我找不到它在其视图中的定义位置。检查以确保您没有接触到呼叫环境并发现df 在附近闲逛。 （如果是这样，那么这个应用程序可能会在本地运行，但在部署时会失败。）

可能的修复，未经测试：

  DataRename <- reactive({
    req(isolate(input$file))
    Data <- dataa()         # okay, ...
    DataNew1 <- Data        # this is an unnecessary indirection, no gains
    inpnames <- names(isolate(input))
    for (i in inpnames) {
      if (grepl(pattern = "col_", i)) {
        colnames(DataNew1)[which(colnames(DataNew1) == substr(i, 5, nchar(i)))] =
          input[[i]]
      }
      
    }
    
    return(DataNew1)
  })

  dm = reactive({
    # df = isolate(DataRename()) # not used, can remove entirely?
    corp = corp()
    
    x = corp %>%
      dfm(
        tolower = T,
        remove = stop_words,
        remove_punct = T,
        remove_symbols = T,
        remove_numbers = T
      )
  })