r - 从 DT::renderDT 调用时，R 闪亮的反应值不会重新计算

问题描述

我闪亮的应用程序中的反应值在第一次计算后从 DT::renderDT 函数内部调用时不会重新计算。

这是我的代码：

#-------------------------------------------------------------------------------------------------
# ENVIRONMENT & PACKAGES
#-------------------------------------------------------------------------------------------------

# Set working directory
setwd('C:/Users/username/OneDrive/Desktop/Coding projects/Paleo Diet Planner')

# Clear workspace
rm(list = ls())

# Package/library list
pckgs <- c('shiny','shinydashboard','reactlog','DT','dplyr','stringr','mgsub')

# Install and load libraries
for(pckg in pckgs)
{
  if(!(pckg %in% rownames(installed.packages()))) install.packages(pckg)
  if(!(pckg %in% (.packages()))) library(pckg, character.only = TRUE)
}

# Remove unnecessary variables
rm(pckg,pckgs)

#-------------------------------------------------------------------------------------------------

#-------------------------------------------------------------------------------------------------
# DATA
#-------------------------------------------------------------------------------------------------

# Static Data
Recipe_Inv <- readRDS('./Data/Recipe_Inv.rds')

# Get unique tags
Recipe_Tags <- Recipe_Inv$Tags %>% stringr::str_split(., ';', simplify = T) %>%
  trimws %>% as.vector %>% unique %>% magrittr::extract(. != '') %>% magrittr::extract(order(.))

# Utility variables
Debug_Flag <- F
Log_Flag <- T
LogFile <- c()
LogFile_Path <- as.character(Sys.time()) %>% mgsub(., c('-', ' ', ':'), c('', '_', '-')) %>% paste0('./Logs/',.,'.txt')

#-------------------------------------------------------------------------------------------------

#-------------------------------------------------------------------------------------------------
# UTILITY FUNCTIONS
#-------------------------------------------------------------------------------------------------

# Function for checking if the tags chosen for filtering are present in the tag string, i.e.
# string with tags separated by semi-colon
Filter_Tags <- function(Tags, Tag_Crit){
  # Debug and log
  # if(Log_Flag) print('Utility_Function -> Filter_Tags')
  if(Debug_Flag) browser()
  
  #Extract tags from the tag string as character vector
  Tag_Ls <- trimws(stringr::str_split(Tags, ';')[[1]])
  
  # Check if the intersection (common elements) of the tag string and filter tags vector have the same length
  # Equivalent to all filter tags being present in the tag string
  length(intersect(Tag_Ls, Tag_Crit)) == length(Tag_Crit)
}

# Function to filter out, rearrange and order the tags when select drop-down field is used
ReArrange_Tags <- function(Tags, Tag_Crit){
  # Log
  # if(Log_Flag) print('Utility_Function - > ReArrange_Tags')
  
  if(is.null(Tag_Crit)){
    # If the select drop-down list is empty, leave tag string (tags delimited by semi-colon) as-is
    Tags
  }else{
    # Debug
    if(Debug_Flag) browser()
    
    # Get the tags in the tag string that were chosen in the select drop-down field
    # and order them aplhabetically
    trimws(stringr::str_split(Tags, ';')[[1]]) %>% 
      intersect(., Tag_Crit) %>% magrittr::extract(order(.)) %>%
      paste0(., collapse = ';')
  }
}

# Function for logging events in the apps in terms of UI element usage and server activity
Log_App_Activity <- function(print_txt){
  print(print_txt)
  LogFile <<- c(LogFile,print_txt)
  write.table(LogFile, LogFile_Path, sep = '\n', col.names = F, row.names = F)
}

#-------------------------------------------------------------------------------------------------

#-------------------------------------------------------------------------------------------------
# USER INTERFACE
#-------------------------------------------------------------------------------------------------

#### Separate components #### 

# Dashboard Header
db_header <- shinydashboard::dashboardHeader(
  # Dashboard title
  title = 'Paleo Diet Planner'
)

# Dashboard Sidebar
db_Sidebar <- shinydashboard::dashboardSidebar(
  #### Sidebar settings ####
  # ID of the dashboard sidebar object
  id = 'InSidebar_Menu',
  
  # Width setting
  width = 350,
  
  #### UI elements ####
  #
  shiny::selectInput(inputId = 'InSelect_RecipeTags',
                     label = 'Select Recipe Categories',
                     choices = Recipe_Tags, multiple = T),
  
  #
  shinydashboard::menuItem(text = 'Recipe List', tabName = 'tbRecipeLs',
                           icon = shiny::icon('th-list')),
  
  #
  shinydashboard::menuItem(text = 'Recipe View', tabName = 'tbRecipeView',
                           icon = shiny::icon('readme'))
)

# Dashboard Body
db_Body <- shinydashboard::dashboardBody(
  
  #
  shinydashboard::tabItems(
    #
    shinydashboard::tabItem(
      #
      tabName = 'tbRecipeLs',
      #
      DT::DTOutput(outputId = 'OutDT_RecipeList')
    ),
    
    #
    shinydashboard::tabItem(
      #
      tabName = 'tbRecipeView',
      #
      shiny::uiOutput('OutUI_RecipeURL'),
      #
      shiny::htmlOutput("OutUI_RecipeWebsite")
    )
  )
)

#### Main UI #### 
Main_UI <- dashboardPage(db_header, db_Sidebar, db_Body)

#-------------------------------------------------------------------------------------------------

#-------------------------------------------------------------------------------------------------
# SERVER
#-------------------------------------------------------------------------------------------------

# Define server logic
server <- function(input, output){
  
  # Filtered Recipe Inventory based on the select drop-down field 'InSelect_RecipeTags'
  Recipe_Inv_Flt <- shiny::reactive({
    # Debug and log
    if(Log_Flag) Log_App_Activity('shiny::reactive -> Recipe_Inv_Flt')
    if(Debug_Flag) browser()
    
    # Check if the select drop-down field 'InSelect_RecipeTags' has been used and filter appropriately
    if(is.null(input$InSelect_Recipe_Tags)){
      Recipe_Inv
    }else{
      Recipe_Inv %>% dplyr::rowwise() %>%
        dplyr::filter(Filter_Tags(Tags, input$InSelect_RecipeTags)) %>%
        dplyr::ungroup()
    }
  })
  
  # Data Table displaying the reactive values Recipe_Inv_Flt() with appropriate tags displayed
  # in the tag column, based on the tags selected in the select drop-down field 'InSelect_RecipeTags'
  output$OutDT_RecipeList <- DT::renderDT({
    # Debug and log
    if(Log_Flag) Log_App_Activity('DT::renderDT -> OutDT_RecipeList')
    if(Debug_Flag) browser()
    
    # 
    Recipe_Inv_Flt() %>% dplyr::select(Tags, Recipe_Nm) %>% dplyr::rowwise() %>%
      dplyr::mutate(Tags = ReArrange_Tags(Tags, input$InSelect_RecipeTags)) %>%
      dplyr::ungroup() %>% dplyr::arrange(Tags)
  })
  
  #
  output$OutUI_RecipeURL <- shiny::renderUI({
    # Debug and log
    if(Log_Flag) Log_App_Activity('shiny::renderUI -> OutUI_RecipeURL')
    if(Debug_Flag) browser(text = 'shiny::renderUI -> OutUI_RecipeURL')
    
    #
    choices <- Recipe_Inv_Flt() %>% .$Recipe_Nm %>% magrittr::extract(input$OutDT_RecipeList_rows_selected)
    
    #
    shiny::selectInput(inputId = 'InSelect_RecipeURL',
                       label = 'Select recipe to display',
                       choices = choices, multiple = F)
  })
  
  #
  output$OutUI_RecipeWebsite <- shiny::renderUI({
    #Debug and log
    if(Log_Flag) Log_App_Activity('shiny::renderUI -> OutUI_RecipeWebsite')
    if(Debug_Flag) browser(text = 'shiny::renderUI -> OutUI_RecipeWebsite')
    
    #
    if(!is.null(input$InSelect_RecipeURL)){
      Recipe_URL <- Recipe_Inv %>% dplyr::filter(Recipe_Nm == input$InSelect_RecipeURL) %>% .$Recipe_URL
    }else{
      Recipe_URL <- NA
    }
    
    #
    shiny::tags$iframe(src = Recipe_URL, width = "100%", height = 800)
  })
  
  # Log for UI elements
  shiny::observeEvent(input$InSelect_RecipeTags,{
    browser()
    if(Log_Flag) Log_App_Activity('shiny::selectInput -> InSelect_RecipeTags')
  })
  
  shiny::observeEvent(input$InSidebar_Menu,{
    browser()
    if(Log_Flag){
      switch(input$InSidebar_Menu,
             'tbRecipeLs' = Log_App_Activity('shinydashboard::menuIte -> tbRecipeLs'),
             'tbRecipeView' = Log_App_Activity('shinydashboard::menuIte -> tbRecipeView'))
    }
  })
  
  shiny::observeEvent(input$InSelect_RecipeURL,{
    browser()
    if(Log_Flag) Log_App_Activity('shiny::selectInput -> InSelect_RecipeURL')
  })
}

#-------------------------------------------------------------------------------------------------

#-------------------------------------------------------------------------------------------------
# RUN APPLICATION
#-------------------------------------------------------------------------------------------------

shiny::shinyApp(ui = Main_UI, server = server)

#-------------------------------------------------------------------------------------------------

这是输出sessionInfo()：

R version 3.6.2 (2019-12-12)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)

Matrix products: default

locale:
[1] LC_COLLATE=Polish_Poland.1250  LC_CTYPE=Polish_Poland.1250    LC_MONETARY=Polish_Poland.1250 LC_NUMERIC=C                  
[5] LC_TIME=Polish_Poland.1250    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] mgsub_1.7.3          stringr_1.4.0        dplyr_1.0.2          DT_0.14              reactlog_1.1.0       shinydashboard_0.7.1
[7] shiny_1.4.0         

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.5        rstudioapi_0.13   magrittr_1.5      tidyselect_1.1.0  xtable_1.8-4      R6_2.4.1          rlang_0.4.11      fastmap_1.0.1    
 [9] tools_3.6.2       ellipsis_0.3.2    crosstalk_1.1.0.1 htmltools_0.4.0   yaml_2.2.1        digest_0.6.25     tibble_2.1.3      lifecycle_1.0.0  
[17] crayon_1.3.4      purrr_0.3.3       later_1.0.0       htmlwidgets_1.5.1 vctrs_0.3.4       promises_1.1.0    glue_1.4.1        mime_0.9         
[25] stringi_1.4.6     compiler_3.6.2    pillar_1.4.3      generics_0.0.2    jsonlite_1.7.0    httpuv_1.5.2      pkgconfig_2.0.3

该Recipe_Inv变量具有以下（20 个样本行）结构：

配方_Nm	食谱网址	标签
苹果酱	https://paleoleap.com/apple-butter/	古甜点；糖果和零食；烹饪：快速准备；烹饪：慢炖锅；古自体免疫友好食谱；饮食：无蛋；饮食：无坚果；饮食：素食；古预算友好食谱；适合剩菜；古儿童友好食谱
芦笋韭菜烤鸡蛋	https://paleoleap.com/baked-eggs-asparagus-leeks/	古猪肉食谱；古鸡蛋食谱；古低碳水化合物食谱；古早餐食谱；烹饪：快速烹饪；烹饪：快速准备；饮食：无坚果；古预算友好型食谱
牛肉河粉	https://paleoleap.com/beef-pho/	古牛肉和红肉食谱；古汤食谱；古早餐食谱；古午餐食谱；古晚餐食谱；烹饪：快速准备；古自体免疫友好食谱；饮食：无蛋；饮食：低 FODMAP；饮食：坚果-自由
鸡肉腰果砂锅	https://paleoleap.com/chicken-cashew-casserole/	古鸡肉和家禽食谱；古低碳水化合物食谱；古晚餐食谱；烹饪：快速准备；饮食：无蛋
蒜香烤红薯鸡	https://paleoleap.com/chicken-garlic-roasted-sweet-potatoes/	古鸡肉和家禽食谱；古晚餐食谱；烹饪：快速烹饪；烹饪：快速准备；饮食：无蛋；饮食：无坚果；适合剩菜；古儿童友好食谱
龙蒿蟹酿魔鬼蛋	https://paleoleap.com/crab-stuffed-deviled-eggs-tarragon/	古鱼和海鲜食谱；古鸡蛋食谱；古低碳水化合物食谱；烹饪：快速烹饪；烹饪：快速准备；饮食：低 FODMAP；饮食：无坚果；适合剩菜
麋鹿牧羊人派	https://paleoleap.com/elk-shepherd-pie/	旧石器时代牛肉和红肉食谱；旧石器时代晚餐食谱；饮食：无蛋；饮食：无坚果；旧石器时代预算友好型食谱；适合剩菜；旧石器时代儿童友好型食谱
新鲜水果和羽衣甘蓝沙拉	https://paleoleap.com/fresh-fruit-and-kale-salad/	古沙拉食谱；古早餐食谱；烹饪：快速准备；饮食：无蛋；饮食：素食
大蒜烤樱桃番茄	https://paleoleap.com/garlic-roasted-cherry-tomatoes/	古边；蔬菜和开胃菜；古低碳水化合物食谱；烹饪：快速烹饪；烹饪：快速准备；饮食：无蛋；饮食：无坚果；饮食：素食；古预算友好的食谱
姜萝卜汤	https://paleoleap.com/ginger-carrot-soup/	古汤食谱；古低碳水化合物食谱；古早餐食谱；古晚餐食谱；烹饪：快速准备；古自体免疫友好食谱；饮食：无蛋；饮食：无坚果；饮食：素食；古预算友好食谱; 适合剩菜
烤菠萝鸡	https://paleoleap.com/grilled-pineapple-chicken/	古鸡肉和家禽食谱；古晚餐食谱；烹饪：快速烹饪；烹饪：快速准备；烹饪：烧烤；饮食：无蛋；饮食：无坚果；适合剩菜；古儿童友好食谱
意式鱼缸	https://paleoleap.com/italian-style-fish-bowl/	古鱼和海鲜食谱；古低碳水化合物食谱；古晚餐食谱；烹饪：快速准备；饮食：无蛋；饮食：无坚果
番茄慢炖鸡汤	https://paleoleap.com/slow-cooker-chicken-soup/	古鸡肉和家禽食谱；古汤食谱；古低碳水化合物食谱；古晚餐食谱；烹饪：快速准备；烹饪：慢炖锅；饮食：无蛋；饮食：无坚果；古预算友好食谱；好剩菜；古儿童友好食谱
枫木烧烤排骨	https://paleoleap.com/maple-barbecue-ribs/	古猪肉食谱；古晚餐食谱；烹饪：快速准备；饮食：无蛋；饮食：无坚果；适合吃剩菜；古儿童友好食谱
古蒜虾西葫芦面	https://paleoleap.com/garlic-shrimp-with-zucchini-noodle/	古鱼和海鲜食谱；古低碳水化合物食谱；古午餐食谱；古晚餐食谱；烹饪：快速烹饪；烹饪：快速准备；古自体免疫食谱；饮食：无蛋；古儿童友好食谱
南瓜饼	https://paleoleap.com/pumpkin-cookies/	古甜点；糖果和零食；烹饪：快速烹饪；烹饪：快速准备；饮食：无蛋；饮食：素食；适合剩菜；古儿童友好食谱
炒鸡肉和卷心菜	https://paleoleap.com/sauteed-chicken-cabbage/	古鸡肉和家禽食谱；古低碳水化合物食谱；古午餐食谱；古晚餐食谱；烹饪：快速准备；饮食：无蛋；饮食：无坚果；适合剩菜；古儿童友好食谱
慢炖锅黄油和坚果	https://paleoleap.com/slow-cooker-butterkin-and-nuts/	古面；蔬菜和开胃菜；烹饪：快速准备；烹饪：慢炖锅；饮食：无蛋；饮食：素食；古预算友好食谱；古儿童友好食谱
慢炖咖喱鸡	https://paleoleap.com/slow-cooker-curry-chicken/	古鸡肉和家禽食谱；古晚餐食谱；烹饪：慢炖锅；饮食：无蛋；饮食：无坚果；适合剩菜
特制红薯沙拉	https://paleoleap.com/special-sweet-potato-salad/	古沙拉食谱；烹饪：快速烹饪；烹饪：快速准备；饮食：无坚果；古预算友好的食谱；适合剩菜；古儿童友好的食谱

当我在 RStudio 中启动我的应用程序时，我的启动屏幕如下所示：

单击menuItem -> tbRecipeLs侧边栏后，DT::renderDT -> OutDT_RecipeList触发函数调用，进而触发reactive -> Recipe_Inv_Flt()变量，如Log_App_ActivityUDF 生成的输出控制台所示：

[1] "DT::renderDT -> OutDT_RecipeList"
[1] "shiny::reactive -> Recipe_Inv_Flt"

DT::DTOutput -> OutDT_RecipeList这将在仪表板主体中显示 UI 输出：

我尝试通过在下拉列表中选择标签过滤器来过滤掉列表中的食谱selectInput -> InSelect_RecipeTags，见下文：

并根据Log_App_ActivityUDF 控制台输出触发以下 UI 和服务器组件：

[1] "shiny::selectInput -> InSelect_RecipeTags"
[1] "DT::renderDT -> OutDT_RecipeList"

我的期望是，因为DT::renderDT -> OutDT_RecipeList被调用，reactive -> Recipe_Inv_Flt()变量也应该被再次调用，因为它在DT::renderDT -> OutDT_RecipeList函数内部，以及因为它的依赖关系，下拉字段发生了selectInput -> InSelect_RecipeTags变化。但是，情况似乎并非如此，因为数据表 UI 输出DT::DTOutput -> OutDT_RecipeList仍然显示所有行 (1,555)，但是它确实根据下拉列表中选择的过滤器值从标签列中删除了标签- down 字段selectInput -> InSelect_RecipeTags，由函数ReArrange_Tags内部的 UDF 调用完成。每次从函数内部调用变量时，DT::renderDT -> OutDT_RecipeList我应该怎么做才能使变量重新计算？reactive -> Recipe_Inv_Flt()DT::renderDT -> OutDT_RecipeList

标签： rshinyshinydashboardreactivedt

r - 从 DT::renderDT 调用时，R 闪亮的反应值不会重新计算

问题描述

解决方案

推荐阅读