【发布时间】：2021-06-01 16:57:30
【问题描述】：
我正在 R 中构建一个闪亮的应用程序，它将：i) 使用两个单选按钮来过滤数据集，ii) 绘制过滤后的数据集，以及 iii) 使用画笔点来识别异常点以进行进一步检查。
以下是我的数据集的简短版本以及闪亮的代码。基于第一个单选按钮的过滤似乎工作正常。但是，车轮会通过基于第二个无线电按钮的过滤而脱离总线。我正在尝试设置代码，以便绘制第二个单选按钮的值>=，但这没有发生，我还没有弄清楚问题所在。
这就是我认为问题所在……但我现在不知所措。
plot_subset_df <- reactive({
filter(sub_react$data, CODE == input$CODE & DAYS_DIFFERENCE <= input$DAYS_DIFFERENCE)})
虽然大部分代码是用dplyr 和DT 编写的，但我正在尝试移至基本包...所以欢迎所有解决方案。
提前感谢您的帮助。
示例数据集
sub <- read.table(text = "NUMBER DEPTH DAYS_DIFFERENCE CODE DAY MONTH YEAR INHA
1 0.81 0 BROA 16 8 1986 64.35
2 NA NA BROA 16 8 1986 64.35
1 0.67 7 BROA 4 9 1987 60.48
2 NA NA BROA 4 9 1987 60.48
1 0.67 14 BROA 29 9 1987 58.68
2 1 14 BROA 29 9 1987 58.68
1 0.96 20 BROA 21 8 1988 36.72
2 NA NA BROA 21 8 1988 36.72
1 0.96 0 BROA 15 9 1988 38.43
2 NA NA BROA 15 9 1988 38.43
1 0.76 10 BROA 24 10 1988 57.69
2 NA NA BROA 24 10 1988 57.69
1 0.76 3 BROA 9 11 1988 41.49
2 NA NA BROA 9 11 1988 41.49
1 1 14 DULB 18 8 1986 64.35
2 NA NA DULB 18 8 1986 64.35
1 0.5 30 DULB 20 7 1987 60.48
2 NA NA DULB 20 7 1987 60.48
1 0.7 10 DULB 8 10 1987 58.68
2 NA NA DULB 8 10 1987 58.68
1 2 3 DULB 24 10 1987 36.72
2 NA NA DULB 24 10 1987 36.72
1 3 0 DULB 9 11 1987 38.43
2 3.5 0 DULB 9 11 1987 38.43
1 1.5 7 DULB 25 11 1987 57.69
2 NA NA DULB 25 11 1987 57.69
1 0.6 20 DULB 11 12 1987 41.49
2 1.2 20 DULB 11 12 1987 41.49
1 3.3 25 DULB 27 12 1987 64.35
2 2.3 25 DULB 27 12 1987 64.35
1 4.2 40 DULB 13 2 1988 60.48
2 NA NA DULB 13 2 1988 60.48
1 1 50 DULB 29 2 1988 58.68
2 NA NA DULB 29 2 1988 58.68
", header = TRUE)
当前版本的代码
library(DT)
library(dplyr)
library(tidyr)
library(ggplot2)
library(shiny)
# Setup data set
sub$NUMBER = as.factor(sub$NUMBER)
# Shiny code
ui <- fluidPage(
sidebarPanel(
radioButtons("CODE", "SWMMP code",
choices = unique(sub$CODE)),
radioButtons("DAYS_DIFFERENCE", "Days difference",
choices = c("0" = 0,
"3" = 3,
"7" = 7,
"10" = 10,
"14" = 14,
"20" = 20,
"25" = 25,
"30" = 30,
"All" = 100000))
),
mainPanel(
plotOutput("plot1", brush = "plot_brush"),
DTOutput("dt_of_brushed_points"),
verbatimTextOutput("actual_data_brushed"),
verbatimTextOutput("actual_data_full")))
server <- function(input, output, session) {
# Make data set reactive values
sub_react = reactiveValues(data = sub)
# Get data for plot
plot_subset_df <- reactive({
filter(sub_react$data, CODE == input$CODE & DAYS_DIFFERENCE <= input$DAYS_DIFFERENCE)
})
# Make plot
output$plot1 <- renderPlot({
ggplot(plot_subset_df(), aes(x = DEPTH, y = INHA)) +
geom_point(aes(size = 5, color = NUMBER))+
theme(legend.position = "top",
legend.title = element_blank(),
panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))
})
# Display rows of data highlighted in plot
brushed_df <- reactive({
brushedPoints(plot_subset_df(), input$plot_brush, xvar = "DEPTH", yvar = "INHA",
allRows = FALSE)})
# Render highlighted data in plot
output$dt_of_brushed_points = renderDT(brushed_df(), selection = 'none', editable = TRUE)
# Show actual data frame to check edits are correct
output$actual_data_brushed <- renderPrint({brushed_df()})
#output$actual_data_full <- renderPrint({sub_react$data})
# Transfer edits from top table to bottom table
proxy = dataTableProxy('dt_of_brushed_points')
observeEvent(input$dt_of_brushed_points_cell_edit, {
info = input$dt_of_brushed_points_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
row_to_change <- brushed_df()[i, 1]
sub_react$data[row_to_change, j] <- isolate(coerceValue(v, sub_react$data[row_to_change, j]))
replaceData(proxy, sub_react$data, resetPaging = FALSE)})
}
shinyApp(ui, server)
【问题讨论】：