Я довольно новичок в приложениях rshiny и пытаюсь создать приложение, которое работает нормально, но когда я пытаюсь добавить график с помощью кисти и удалить точки, я сталкиваюсь с ошибками.
По сути, я читаю CSV-файл в реактивную функцию df_products_upload(), которую я использую в некоторых других функциях (для построения графиков и для заполнения столбцов для пользовательских вводов), но когда я вызываю эту функцию внутри реагировать на значения (), чтобыпередать фрейм данных мне не удастся.Я пытаюсь добавить кисть и удалить функциональность на график (Plot1).Я не могу перечитать CSV-файл только для того, чтобы ввести эти значения, чтобы оно работало.Вся идея реактивной функции умирает, если мне нужно продолжать читать 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 друг в друге, если это вообще возможно.если невозможно, как заставить этот график работать с остальным кодом.Ясно, что блестящему не нравится вызывать реактивную функцию внутри реактивных значений ().У меня проблема с 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)