r-闪亮筛选应用程序-用户筛选/突变/修改

Question

我正在创建一个Shiny屏蔽应用程序，该应用程序允许用户在预定的数据帧上键入R命令，如filter和mutate。

就我个人而言，我认为最方便用户使用的方法是有一个包含筛选参数的空白数据帧列，用户可以在其中使用mtcars数据集作为示例输入filter(mpg >= 21)或mutate(cyl_sq = cyl^2)等命令。

显示预期功能的简单应用程序：

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
# Header ------------------------------------------------
header <- dashboardHeader(title = "Example Screening")
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar()
# Body ------------------------------------------------
body <-
dashboardBody(
fluidRow(
column(6,h3("Screening Parameters")),
column(6,h3("Filtered/Modified Results"))),
fluidRow(
column(6,DT::dataTableOutput("screening_params")),
column(6,DT::dataTableOutput("filtered_results")))
)
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(
header,
sidebar,
body
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
output$screening_params <- renderDataTable({
tibble(params = c("filter(mpg >= 21)",
"mutate(cyl_sq = cyl^2)",
rep_len(NA_character_,8))) %>%
DT::datatable(rownames = F,
editable = T)
})
output$filtered_results <- renderDataTable({
mtcars %>%
# input$screening_params
DT::datatable()
})
})) 

我愿意使用DT或rhandsontable，或者其他人能想到的任何替代方案。不幸的是，您似乎无法在DT中获取经过编辑的表值，但希望它能提供一个很好的例子来说明我所追求的。

我尝试了我能想到的quoures和映射函数的每一种组合，但都无济于事。

有人有什么想法吗？

Answer 1

这是一种略有不同的方法，但您可能会发现它很有用。我使用sqldf作为SQL查询引擎，用户可以在给定的数据集上使用特殊的SQL查询来操作数据。如果这不是你想要的，我至少希望它能给你一些关于如何使用dplyr语法的提示。

如果您仍然选择dplyr选项，并且您有一个包含所请求操作的字符串，则可以使用反应式方法getDataset来评估从用户那里收到的表达式，操作您的数据集。然后在renderDataTable方法中调用getDataset，就像我在附加代码中所做的那样。

计算字符串表达式的示例：

eval(parse(text="res <- mtcars %>% filter(mpg < 20)"))

对于SQL选项：

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)
library(sqldf)
# Header ------------------------------------------------
header <- dashboardHeader(title = "Example Screening")
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar(collapsed = TRUE)
# Body ------------------------------------------------
body <-
dashboardBody(
fluidRow(
#column(6,h3("Screening Parameters")),
column(6,h3("Filtered/Modified Results"))),
fluidRow(
textInput("sql","SQL Query",value = "SELECT * FROM dataset"),
DT::dataTableOutput(("filtered_results"))
)
)
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(
header,
sidebar,
body
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
## A new function to load data and perform the SQL query on it
getDataset <- reactive({
query <- input$sql
dataset <- mtcars
sqldf::sqldf(query)
})
output$filtered_results <- renderDataTable({
getDataset() %>%
DT::datatable()
})
})) 

Answer 2

感谢Omri374与我交流想法。

满足要求的简单应用程序：

library(shinydashboard)
library(DT)
library(dplyr)
library(rhandsontable)
# Header ------------------------------------------------
header <- dashboardHeader(title = "Example Screening")
# Sidebar ------------------------------------------------
sidebar <- dashboardSidebar()
# Body ------------------------------------------------
body <-
dashboardBody(
fluidRow(
column(6,h3("Screening Parameters")),
column(6,h3("Filtered/Modified Results"))),
fluidRow(
column(6, rHandsontableOutput("hot")),
column(6, dataTableOutput("filtered_results")))
)
# APP ------------------------------------------------
shinyApp(ui <- dashboardPage(
header,
sidebar,
body
),
# Server ----------------------------------------------------------
shinyServer(function(input,output){
output$hot <- renderRHandsontable({
tibble(params = c("filter(mpg >= 21)",
"filter(cyl == 4)",
"mutate(cyl_sq = cyl^2)",
"select(cyl,mpg,drat)",
rep_len(NA_character_,6))) %>%
rhandsontable() %>%
hot_cols(colWidths = 500)
})
output$filtered_results <- renderDataTable({

df <- mtcars
params <- input$hot %>%
hot_to_r() %>%
filter(!is.na(params),params != "") %>%
mutate(params = ifelse(row_number() == max(row_number()),
params,
paste0(params," %>% "))) %>%
pull(params) %>%
str_c(collapse = "")

if(length(params)>=1){
eval(parse(text = paste0("filt_df <- df %>%",params)))
} else {
filt_df <- df
}
filt_df %>%
datatable()

})
}))