时间戳

首页 > 解决方案 > Shiny 应用程序中的台球桌 - 高效加载

r - Shiny 应用程序中的台球桌 - 高效加载

问题描述

使用pool 包提高将 MySQL (Maria) DB 中的多个表加载到 R Shiny 中的效率的最佳方法是什么？

目前我正在使用 for 循环。我应该初始化表格还是有更好的方法（应用函数）？

library(shiny)
library(DBI)
library(pool)
library(dplyr)

pool <- dbPool(
  drv      = RMariaDB::MariaDB(),
  dbname   = "db",
  host     = "localhost",
  username = "user", 
  password = "",
  port     = 3306,
  bigint   = "numeric"
)
tabFull <- dbListTables(pool)
tablesExport <- tabFull[grepl("export", tabFull)]

  for(i in 1:length(tablesExport)){
     tmp <- data.frame(tbl(pool, tablesExport[i]))
     tmp$exclDate <- tmp$uploaded_at + (365*24*60*60)  
     tmp <- filter(tmp, !(exclDate > Sys.time() & !(private %in% c(0, NA))) & excluded %in% c(0, NA)) 
     assign(tablesExport[i], select(tmp, -exclDate, -excluded, -export_time, -private)

     #assign(tablesExport[i], `[[<-`(get(tablesExport[i]), 'exclDate', value = as.POSIXct(eval(parse(text = tablesExport[i]))$uploaded_at) + (365*24*60*60)))
     #assign(tablesExport[i], filter(eval(parse(text = tablesExport[i])), !(exclDate > Sys.time() & !(private %in% c(0, NA))) & excluded %in% c(0, NA)))
     #assign(tablesExport[i], select(eval(parse(text = tablesExport[i])), -exclDate, -excluded, -export_time, -private))
  }

当涉及数据库时，reprex 很困难，所以我希望这个伪代码可以。所有代码也都在 github 上，所以如果您需要更多上下文，请参见此处的闪亮和此处的 sql。

标签： rfor-loopshinymariadbpool

解决方案

我建议您编写一个函数来完成for循环中的所有操作，并更简单地迭代表列表（至少更具可读性）。

我想我理解你在副作用中工作的动机，将每个表分配给它自己的变量，所以我会坚持下去（但无论如何提供一个替代方案）。我也会坚持你对dplyr动词的使用，并且只使用管道（为了可读性）。

library(dplyr)
func <- function(tblnm, con, envir = NULL) {
  now <- Sys.time()
  yearseconds <- (365*24*60*60)
  dat <- data.frame(tbl(con, tblnm)) %>%
    mutate(exclDate = uploaded_at + yearseconds) %>%
    filter(!(exclDate > now & !(private %in% c(0, NA))) & excluded %in% c(0, NA)) %>%
    select(-exclDate, -excluded, -export_time, -private)
  if (!is.null(envir)) assign(tblnm, dat, envir = envir)
  invisible(dat)
}

有了这个，您可以将上面的大部分内容替换为

for (i in seq_along(tablesExport)) {
  func(tablesExport[i], con = pool, envir = .GlobalEnv)
}

请注意，我明确表示要传递连接对象（您的pool）和envir您想要副作用的 onment。我这样做是为了更具声明性，并可能支持其他用途（在非全局环境中，谁知道）。

支持的一件事是在没有副作用的情况下运行，使用我在评论中提到的框架列表。然后，您可以执行以下操作，而不是for循环并将每个表分配给它自己的变量：

dat <- lapply(setNames(nm=tablesExport), func, con = pool, envir = NULL)

不是严格需要的envir=NULL，因为函数定义中的默认值是这样，但我在这里这样做是为了非常清楚：我不想要副作用。使用 this dat，您将使用dat[[ tableExports[3] ]]or （如果一个表被命名UserList）dat$UserList来访问各个表。

关于我的一些风格选择的几点说明：

  • 我尽量不使用1:length(...)；虽然它在更多时候有效，但如果length(.)is ever 0，人们希望for循环不会做任何事情，但不幸的是它看到1:0了哪个解析为c(1, 0)，而不是一个空向量。seq_along(x)is 等价于seq_len(length(x))等价于1:length(x) except whenx为空。
  • 我使用lapply(setNames(nm=tablesExports),...)的默认操作lapply是仅当对象被命名进入时才在输出中命名其元素。虽然sapply 确实直观地命名事物（它替换/解析向量/列表），但它也可以返回向量或列表，这对于纯程序化使用可能会令人沮丧。我更喜欢lapply这个原因。或者，我可以使用sapply(tableExports, func, con=pool, envir=NULL, USE.NAMES=FALSE)相同的效果。
  • 我定义now并且yearseconds主要是因为我试图抵制没有明确定义的代码中的硬编码常量。将它们命名为有意义的名称是有用且具有声明性的。（我不得不调试例如10在整个代码中的各个地方使用的模块......其中一些意味着相同的常量，一些意味着不同的东西，因此更新其中一个常量的全局搜索替换失败。）
  • 我使用invisible了带有副作用的选项；如果没有invisible, 那么func(somename,...)会将一个框架转储到控制台，这可能不是您想要的。invisible允许您获取return一个值，但如果用户没有将其显式捕获到对象中，则不要使用帧渲染来打击控制台。当用作 时somevar <- func(...)，它完全没有任何作用。
  • 最后一件事......一个更具防御性的版本func会在任意过滤之前检查这些列名的存在。然后，要么 (a) 立即失败，要么 (b) 如果该列存在，则仅在该列上过滤。虽然 (b) 仍然可以在下游代码中产生“有趣”的效果，但它仍然允许下游代码执行。

推荐阅读