r - 将 reactive() 数据帧传递给 reactiveValues()
问题描述
我对 rshiny 应用程序相当陌生，我正在尝试构建一个运行良好的应用程序，但是当我尝试使用画笔和删除点功能添加绘图时，我遇到了错误。
本质上，我正在将 csv 文件读入df_products_upload() 我在其他一些函数中使用的反应函数（用于绘制和填充用户输入的列），但是当我在 reacticeValues() 中调用这个函数来传递数据帧时，它失败了。我正在尝试向绘图（Plot1）添加画笔和删除功能。我不能重新读取 csv 文件只是为了输入到这个 reactiveValues 所以它会起作用。如果我必须为应用程序中使用的所有其他函数重复读取 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相互内部。如果不可能，我如何让这个情节与其余代码一起工作。显然 Shiny 不喜欢在 reactiveValues() 中调用响应式函数。我遇到了这个问题Plot1，代码在底部。您可以使用任何 csv 来测试代码，它只会抱怨 plot -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)
解决方案
推荐阅读
- yarnpkg - 如何创建一个底层链？
- python - Python 类和 __init___ 构造函数，如何创建一个列表变量？
- flutter - 在使用提供程序包的消费者中，如何将图像设置为 Flutter 中的每个构建？
- python - 每 10 行拆分/划分数据帧
- javascript - 在 Javascript 中创建计数器数组（反应原生）
- node.js - 你能“Ping”一个 Roblox 服务器吗？
- php - PHP设置以'：'开头的自定义标题
- html - 文本字母中的背景图像 -> 如果我的屏幕宽度 > 1675px，则在 Mozilla 上不起作用
- php - 原始查询联合所有 laravel
- python - 如何继续添加、检索和比较 MySQL 数据库中的数据？我正在尝试做一个登录平台