我对rshiny应用程序还很陌生，我试图构建一个运行良好的应用程序，但是当我尝试使用画笔添加绘图并删除点功能时，我遇到了错误。
基本上，我正在将一个csv文件读入一个反应性函数df_products_upload()中，该函数在其他一些函数中使用（用于绘制和填充用户输入的列），但是当我在reacticeValues（）中调用此函数以传递时数据帧使我失败。我正在尝试向绘图（Plot1）添加画笔和删除功能。我不能重新读取csv文件只是为了输入到此reactValues中，因此它可以工作。如果我必须继续冗余读取应用程序中使用的所有其他功能的csv文件，那么响应功能的整个想法就会消失。
vals <- reactiveValues(
df1 <- df_products_upload(),
data=df1
)
############## plotting -1
output$plot1 <- renderPlot({
ggplot(vals$data, aes_string(x = input$column1, y = input$column2)) + geom_point()
})
observe({
df = brushedPoints(vals$data, brush = input$plot1_brush, allRows = TRUE)
vals$data = df[df$selected_== FALSE, ] ## Taking only those data points where the selected_ value is FALSE (alternatively ignoring rows with selected_ = TRUE status)
})
有人可以建议我该怎么做吗？尽可能在内部使用reactive和reactiveValues的正确逻辑是什么？如果不可能的话，如何使该图与其余代码一起使用。显然，闪亮并不喜欢在reactValues（）内部调用反应函数。我在Plot1上遇到了麻烦，代码位于底部。您可以使用任何csv来测试代码，它只会抱怨剧情-3，其中我已经硬编码了列名，只需在测试时更改它们即可。
这是完整的代码：
library(DT)
library(shinydashboard)
library(ggplot2)
library(shinyFiles)
ui <- fluidPage(
# File upload button
shinyFilesButton(id = 'file', label= 'Choose file to upload',
title = 'Select file', multiple = FALSE),
#Shows data table on the main page
fluidRow(
column(12, DT::dataTableOutput('tabl'))
# dataTableOutput("tabl")
),
# h5('Select two Columns to Plot'),
uiOutput("Col1"),
uiOutput("Col2"),
#-----------------------------------------------------------
#Shows Plot button
fluidRow(
column(6, plotOutput('plot2', height = 500)),
column(6, plotOutput('plot3', height = 500))
),
fluidRow(
column(7, class = "row",
h4("Brush and click to exclude Point"),
plotOutput("plot1", height = 500,
# click = "plot1_click",
brush = brushOpts(
id = "plot1_brush"
# resetOnNew = TRUE
)
)
)
)
)
#------------------------------------------------------------------------
server <- function(input, output, session) {
###Read cvs file and convert julian Date to regular Date format
shinyFileChoose(input, 'file', roots= c(wd="/Users/mnoon/Desktop/projects/2018/rShinyApp_imageData"), filetypes= c('', 'csv'))
df_products_upload <- reactive({
inFile <- parseFilePaths(roots=c(wd='/Users/mnoon/Desktop/projects/2018/rShinyApp_imageData/'), input$file)
if (NROW(inFile)){
# return(NULL)
df <- read.csv(as.character(inFile$datapath), header = TRUE, sep = ",", stringsAsFactors = F)
# Convert Julian to Calendar date
df$Julian.Date <- as.Date((as.numeric(df$Julian.Date) - 2400000.5), origin=as.Date("1858-11-17"))
#Change Column name to 'Date'
names(df)[names(df) == 'Julian.Date'] <- 'Date'
df <- as.data.frame(df)
return(df)
}
})
###Previews data table on the main display window
output$tabl<- DT::renderDataTable({
df <- df_products_upload()
DT::datatable(df)
}, server = FALSE)
###The following set of functions populate the column selectors
output$Col1 <- renderUI({
df <-df_products_upload()
if (is.null(df)) return(NULL)
cols=names(df)
names(cols)=cols
selectInput("column1", "Select Column for X-axis", cols)
})
output$Col2 <- renderUI({
df <-df_products_upload()
if (is.null(df)) return(NULL)
cols=names(df)
names(cols)=cols
selectInput("column2", "Select Column for Y-axis", cols)
})
# -------------------------------------------------------------------
###plot2
# # # A scatterplot with certain points highlighted
# #
output$plot2 = renderPlot({
df2 <- df_products_upload()
df <- df2[,c(input$column1, input$column2)]
s1 = input$tabl_rows_current # rows on the current page
s2 = input$tabl_rows_all # rows on all pages (after being filtered)
req(input$column1)
##get xlim values for plot
xdiff <- (as.numeric(max(df[,1])) - as.numeric(min(df[,1])))
xd1 <- (as.numeric(max(df[,1]))) + 0.7*(xdiff)
xd2 <- (as.numeric(min(df[,1]))) - 0.7*(xdiff)
##get ylim values for plot
ydiff <- (ceiling(as.numeric(max(df[,2]))) - floor(as.numeric(min(df[,2]))))
yd1 <- (ceiling(as.numeric(max(df[,2])))) + 0.7*(ydiff)
yd2 <- (floor(as.numeric(min(df[,2])))) - 0.7*(ydiff)
######################## --- Plotting -2
par(mar = c(4, 4, 1, .1))
plot(df, pch = 21, xlim = c(xd2,xd1), ylim = c(yd2,yd1), xlab = input$column1, ylab = input$column2)
grid()
# solid dots (pch = 19) for current page
if (length(s1)) {
points(df[s1, , drop = FALSE], pch = 19, cex = 1.5)
}
# show red circles when performing searching
if (length(s2) > 0 && length(s2) < nrow(df)) {
points(df[s2, , drop = FALSE], pch = 21, cex = 2, col = 'red')
}
# dynamically change the legend text
s = input$tabl_search
txt = if (is.null(s) || s == '') 'Filtered data' else {
sprintf('Data matching "%s"', s)
}
legend(
'topright', c('Original data', 'Data on current page', txt),
pch = c(21, 19, 21), pt.cex = c(1, 1.5, 2), col = c(1, 1, 2),
y.intersp = 2, bty = 'n'
)
})
# -------------------------------------------------------------------
###plot3
########[Always plot these two columns - 'Right.Ascension..deg.', 'Declination..deg.']
output$plot3 = renderPlot({
df2 <- df_products_upload()
## Columns hard-coded (always plot these)
df3 = df2[, c('Right.Ascension..deg.', 'Declination..deg.' )]
s1 = input$tabl_rows_current # rows on the current page
s2 = input$tabl_rows_all # rows on all pages (after being filtered)
##get xlim values for plot
xdiff <- (as.numeric(max(df3[,"Right.Ascension..deg."])) - as.numeric(min(df3[,"Right.Ascension..deg."])))
xd1 <- (as.numeric(max(df3[,"Right.Ascension..deg."]))) + 0.2*(xdiff)
xd2 <- (as.numeric(min(df3[,"Right.Ascension..deg."]))) - 0.2*(xdiff)
##get ylim values for plot
yd1 <- (as.numeric(max(df3[,"Declination..deg."]))) - 0.1
yd2 <- (ceiling((as.numeric(min(df3[,"Declination..deg."])))))
########################## --- Plotting -3
par(mar = c(4, 4, 1, .1))
plot(df3, pch = 21, xlim = c(xd2,xd1), ylim = c(yd2,yd1), xlab = names(df3[1]), ylab = names(df3[2]))
# axis(1, )
grid()
# solid dots (pch = 19) for current page
if (length(s1)) {
points(df3[s1, , drop = FALSE], pch = 19, cex = 1.5)
}
# show red circles when performing searching
if (length(s2) > 0 && length(s2) < nrow(df3)) {
points(df3[s2, , drop = FALSE], pch = 21, cex = 2, col = 'red')
}
# dynamically change the legend text
s = input$tabl_search
txt = if (is.null(s) || s == '') 'Filtered data' else {
sprintf('Data matching "%s"', s)
}
legend(
'topright', c('Original data', 'Data on current page', txt),
pch = c(21, 19, 21), pt.cex = c(1, 1.5, 2), col = c(1, 1, 2),
y.intersp = 2, bty = 'n'
)
})
# -------------------------------------------------------------------
###plot1
# brush and delete with ggplot
vals <- reactiveValues(
df1 <- df_products_upload(),
data=df1
)
############## plotting -1
output$plot1 <- renderPlot({
ggplot(vals$data, aes_string(x = input$column1, y = input$column2)) + geom_point()
})
observe({
df = brushedPoints(vals$data, brush = input$plot1_brush, allRows = TRUE)
vals$data = df[df$selected_== FALSE, ] ## Taking only those data points where the selected_ value is FALSE (alternatively ignoring rows with selected_ = TRUE status)
})
}
#------------------------------------------------------------
shinyApp(ui, server)