Reputation: 13
I have a small shiny example with which I would like to illustrate my problem. I want to change my dataset during a session which will change my options in my app. So during my shiny app I source a second R Script (addrow) which change my existing dataframe. After sourcing I would like to change my input- year to 2009 and input - condition to volatil so that i can plot the value by filtering on this two inputs. When I push the actionbutton "refresh dataframe" my dataframe gets another row but my input options doesnt change so that i can not display the existing new value. How can I make my dataframe and my inputs reactive to an existing shiny session? Sourcing a new Script changes my dataframe --> my inputs --> my outputs
library(shiny)
library(dplyr)
year <- c(2002, 2003, 2003, 2003, 2004, 2005, 2005)
condition <- c("volatil", "volatil", "increase", "decrease", "volatil", "volatil", "increase")
value <- c(3,5,10,1,6,22,25)
example <- data.frame(year, condition, value)
yearData <- example %>% group_by(year) %>% slice(1)
condData <- example %>% select(year,condition) %>% distinct()
path <- setwd("of second R Script (addrow) with only one row of code: example[8,] <- c(2009, "volatil", 55)")
ui <- fluidPage(
fluidRow(
column(2,selectInput("year", h4("year:"),choices = yearData$year)),
column(2,selectInput("cond", h4("condition:"), choices = condData$condition))
),
hr(),
actionButton("addrow","Refresh Dataframe"),
actionButton("plot","Plot Data"),
plotOutput("plotdata")
)
server <- function(input,output, session){
observeEvent(input$addrow, {
source(paste0(path,'/addrow.R'))
showNotification("A Row was added")
},priority = 1)
condData2 <- eventReactive(input$addrow, {
example %>% select(year,condition) %>% distinct()
})
observeEvent(c(input$year, input$addrow), {
if(input$addrow){
condData2 <- condData2()
updateSelectInput(session, "cond", choices = condData2$condition[condData2$year == input$year])
} else {
updateSelectInput(session, "cond", choices = condData$condition[condData$year == input$year])
}
}, priority = 2 )
observeEvent(input$plot, {
print(input$year)
print(input$cond)
output$plotdata <- renderPlot({
plot(example[example$year == input$year & example$condition == input$cond, ]$value, ylab= "value")
})
})
}
shinyApp(ui=ui, server=server)
Upvotes: 0
Views: 1259
Reputation: 21297
You can add a row in eventReactive
. I have added the code to add row within this code. You can source to add row. Try this
library(shiny)
library(dplyr)
year <- c(2002, 2003, 2003, 2003, 2004, 2005, 2005)
condition <- c("volatil", "volatil", "increase", "decrease", "volatil", "volatil", "increase")
value <- c(3,5,10,1,6,22,25)
example <- data.frame(year, condition, value)
yearData <- example %>% group_by(year) %>% slice(1)
condData <- example %>% select(year,condition) %>% distinct()
#path <- setwd("of second R Script (addrow) with only one row of code: example[8,] <- c(2009, "volatil", 55)")
ui <- fluidPage(
fluidRow(
column(2,selectInput("year", h4("year:"),choices = yearData$year)),
column(2,selectInput("cond", h4("condition:"), choices = condData$condition))
),
hr(),
actionButton("addrow","Refresh Dataframe"),
actionButton("plot","Plot Data"),
# DTOutput("t1"), ## to check if add row is working
plotOutput("plotdata")
)
server <- function(input,output, session){
rv <- reactiveValues(data=example)
example2 <- eventReactive(input$addrow, {
val = 55 + as.numeric(input$addrow)
#source(paste0(path,'/addrow.R'))
newrow <- c(2009,"volatil",val)
rv$data <- rbind(rv$data,newrow)
})
observeEvent(input$addrow, {
req(example2())
yearData2 <- example2() %>% group_by(year) %>% slice(1)
condData2 <- example2() %>% select(year,condition) %>% distinct()
updateSelectInput(session, "year", choices = yearData2$year)
updateSelectInput(session, "cond", choices = condData2$condition)
showNotification("A Row was added")
},priority = 1)
output$t1 <- renderDT({example2()})
# condData2 <- eventReactive(input$addrow, {
# req(example2())
# example2() %>% select(year,condition) %>% distinct()
#
# })
#
# observeEvent(c(input$year, input$addrow), {
#
# if(input$addrow){
#
# condData2 <- condData2()
#
# updateSelectInput(session, "cond", choices = condData2$condition[condData2$year == input$year])
#
# } else {
#
# updateSelectInput(session, "cond", choices = condData$condition[condData$year == input$year])
#
# }
#
# }, priority = 2 )
observeEvent(input$plot, {
if (input$addrow) {exampl <- example2()
}else exampl <- example
print(input$year)
print(input$cond)
output$plotdata <- renderPlot({
ggplot(exampl, aes(x=year, y=value, color=condition)) + geom_point()
#plot(exampl[exampl$year == input$year & exampl$condition == input$cond, ]$value, ylab= "value")
})
})
}
shinyApp(ui=ui, server=server)
Upvotes: 1