ActionButton with eventReactive

melaakkari · September 28, 2018, 12:27pm

Hello,

Please I am trying to put an action button and I want it to wait for the people to complete their choices in the checkboxgroupinput to output the data in the ggplot -> geom_col to make an hist.

For now, when you click the checkboxgroup it refresh automatically, I want it to not refresh and then when the person click on the actionbutton, the plot refresh with the data.

Please someone help me I am going crazy,

Thank you

Code :

library(shiny)
library(dplyr)
library(ggplot2)
library(lubridate)
library(DBI)
library(extrafont)
library(RColorBrewer)


impala <- config::get("ImpalaEDH")
con_im <- dbConnect(odbc::odbc(),
                    DSN     = impala$dsn,
                    UID     = impala$uid,
                    PWD     = stringi::stri_reverse(impala$pwd))

tv <- dbGetQuery(con_im, "select interval_start_dt, channeltitle, cast(events_qty as integer) events_qty from pvranst.orange_tv_app")

ui <- shinyUI(fluidPage(titlePanel("Volume of views by channels over a period of time"),
                        
                        actionButton("goButton", "Go!"),
                         
                                              checkboxGroupInput("checkgroup","Channels list",
                                                               choices =list ("La Une HD",
                                                                              "La Deux HD",
                                                                              "La Trois HD",
                                                                              "RTL TVI HD",
                                                                              "Club RTL HD",
                                                                              "TF1 HD",
                                                                              "AB3 HD",
                                                                              "13ème Rue HD",
                                                                              "SyFy HD",
                                                                              "Disney Channel",
                                                                              "Disney XD", 
                                                                              "vtm HD",
                                                                              "Q2 HD",
                                                                              "één HD",
                                                                              "Canvas HD",
                                                                              "VIER HD",
                                                                              "VIJF HD",
                                                                              "Discovery Vl HD",
                                                                              "Nat Geo HD", 
                                                                              "Ketnet",
                                                                              "Disney VL",
                                                                              "Vitaya"),
                                                                 selected = "Ketnet"),

dateRangeInput("daterange", "Choose a date range : ",
               start  = "2018-09-01",
               end    = "2018-09-31",
               min    = "2018-01-01",
               max    = "2018-12-31",
               format = "dd/mm/yy",
               separator = " - "),




plotOutput(outputId =  "tv",  width = "auto", height = "500px", click = NULL,
           dblclick = NULL, hover = NULL, hoverDelay = NULL,
           hoverDelayType = NULL, brush = NULL, clickId = NULL, hoverId = NULL,
           inline = FALSE))



)
                                                                          


server <- function(input, output) 
{
eventReactive(input$goButton, ignoreNULL = FALSE {input$checkgroup}),


 
  x<-1:20
  y<-x^2
  
output$tv <- renderPlot({

    
  dist <- isolate(rnorm(input$channeltitle))
  checkboxGroupInput(dist)

  
  

tv_data <- tv %>% 
 filter(channeltitle%in%input$checkgroup,
        interval_start_dt > input$daterange[1],
        interval_start_dt > input$daterange[2])
  


 
ggplot(tv_data, aes(x = interval_start_dt, y = events_qty, fill = channeltitle )) +
geom_col() +
geom_text(aes(label=events_qty), vjust=-0.4, color = "white", size=5) + 
theme(legend.position="bottom")+
theme_minimal()+ 
ggtitle("Views by channels")+
theme(plot.title = element_text(size=30,lineheight=.8, face="bold", 
                                margin = margin(10, 0, 10, 0),
                                vjust=0.5,family="Bauhaus 93"))+
  
labs(x="Date", y="Vues")+
theme(
axis.title.x = element_text(color="peachpuff4", vjust=-0.35, size = 20),
axis.title.y = element_text(color="peachpuff4" , vjust=0.35, size = 20))+
theme(axis.text.x=element_text(angle=50, size=20, vjust=0.5),
      axis.text.y=element_text(angle=360, size=20, vjust=0.5))+
geom_point(color = "white")+
theme(panel.background = element_rect(fill = 'grey75'))+
geom_smooth(aes(fill = "channeltitle"), se = FALSE)


  
})
}

shinyApp(ui = ui, server = server)

kmprioli · September 28, 2018, 1:04pm

Hi there, and welcome to community.rstudio.com! It's a little difficult to work with the code you've presented here. Can you please share a reprex (reproducible example)? This will ensure we're all looking at the same data and code. A guide for creating a reprex can be found here.

Without being able to run your code myself, this is a bit of a stab in the dark, but what happens if you change your eventReactive line of code to the following?:

eventReactive(input$goButton, {input$checkgroup}, ignoreNULL = FALSE)

melaakkari · September 28, 2018, 1:29pm

You're right I am sorry. So for exemple :
my x = interval_start_dt (it's some interval start time 15 minutes each time)
my y = events_qty (it's the number of views a person watch a channel)
and I fill my barplot in ggplot with fill = channeltitle

I have some channel title like : Disney, Discovery, etc that I displayed in a checkboxgroupInput
I have a ggplot with geo_col to make a histogramme of number of views for different channels in a period of time (period of time defined by a daterangeinput)

I want the button go to wait that the person have completely choose their different channel on the checkboxgroup and to click on "go" to refresh the histogramme :

example :

mydata <- some data

ui <- shinyUI(fluidPage(titlePanel("Volume of views by channels over a period of time"),
                         
                                              checkboxGroupInput("checkgroup","Checkbox group",
                                                               choices =list ("La Une HD",
                                                                                     "Discovery Vl HD"
                                                                                     "Nat Geo HD", 
                                                                                     selected = "Nat Geo HD"),

#those are some channel tilte

dateRangeInput("daterange", "Choose a date range : ",
               start  = "2018-09-01",
               end    = "2018-09-31",
               min    = "2018-01-01",
               max    = "2018-12-31",
               format = "dd/mm/yy",
               separator = " - "),


actionButton("goButton", "Go!"),


plotOutput(outputId =  "mydata",  width = "auto", height = "500px", click = NULL,
           dblclick = NULL, hover = NULL, hoverDelay = NULL,
           hoverDelayType = NULL, brush = NULL, clickId = NULL, hoverId = NULL,
           inline = FALSE))

)
                                                                    

server <- function(input, output) 
{

n <- eventReactive(input$goButton, {input$checkgroup}, ignoreNULL = FALSE)
n
  
output$tv <- renderPlot({

tv_data <- mydata %>% 
 filter(channeltitle%in%input$checkgroup,
        interval_start_dt > input$daterange[1],
        interval_start_dt > input$daterange[2])

#to put the interval in a certain order
  

ggplot(tv_data, aes(x = interval_start_dt, y = events_qty, fill = channeltitle,  col=brewer.pal(n = 3, name = "RdBu") ) +
  geom_col() +
  theme_minimal()+ 
  ggtitle("Views by channels")+  
})
}
  


shinyApp(ui = ui, server = server)

This is like an example code

barret · September 28, 2018, 2:04pm

To reiterate your question: You are producing a plot every time a checkbox is changed and you ONLY want the plot to update when the button is pressed (and I'll assume the dates are changed).

The eventReactive will return a new reactive object that will only be updated when the button is triggered. We can then use this new reactive (instead of input$checkgroups) inside the renderPlot function.

server <- function(input, output) {

# make a reactive variable `checkedGroups` that is only updated when `input$goButton` is pressed. 
# this value will represent the captured state of `input$checkgroup`
# ignoreNULL is not needed as the button value represents the click count and will never be NULL
checkedGroups <- eventReactive(input$goButton, {input$checkgroup})

output$tv <- renderPlot({

  tv_data <- mydata %>%
    filter(
      ## using `input$checkgroup` directly creates a reactive dependency (updates the plot on change)
      ## instead, use the newly created `checkedGroups` (as it only changes when the button is pressed)
      channeltitle %in% checkedGroups,
      interval_start_dt > input$daterange[1], # if reactivity for dates is not desired, wrap using isolate `isolate(input$daterange[1])`
      interval_start_dt > input$daterange[2]
    )

    #to put the interval in a certain order
    ggplot(
      tv_data, 
      aes(
        x = interval_start_dt, 
        y = events_qty, 
        fill = channeltitle, col=brewer.pal(n = 3, name = "RdBu") 
      )
    ) +
      geom_col() +
      theme_minimal()+
      ggtitle("Views by channels")
  })
}

- Barret

melaakkari · September 28, 2018, 2:18pm

Hello Barret,

The code didn't work but really thank you for taking the time to help me,

Mélanie

barret · September 28, 2018, 2:48pm

Just saw I never evaluated checkedGroups

Please update

      channeltitle %in% checkedGroups,

to

      channeltitle %in% checkedGroups(),

Should at least get you a more sensible error.

melaakkari · September 28, 2018, 3:16pm

Hello Barret,

Thank you very much it works!! However, when I run the app, the system tells me : Error : Evaluation Error : . and then when I click on one of my checkbox the plot appears and it works well, it wait for me to click on go to refresh. It's a detail but do you know from where it could come from?

Again, thank you very vey much for your useful help!!

Melanie

barret · September 28, 2018, 6:25pm

@melaakkari

You hinted at safeguarding against NULL values earlier with the ignoreNULL = TRUE. But now we need to check for a NULL checkedGroups() value within renderPlot

The eventReactive works independently of the output value. When no checkboxes are checked and the button is pressed, checkedGroups() is set to the current value of input$checkgroup will have a value of NULL. This causes the line channeltitle %in% checkedGroups() to be equivalent to filter(channeltitle %in% NULL) which will fail.

There are a couple routes I can see going forward.

If no boxes are checked, the filtering should not done.

output$tv <- renderPlot({
  tv_data <- mydata %>%
    # filter on the dates anyways
    filter(
      interval_start_dt > input$daterange[1], # if reactivity for dates is not desired, wrap using isolate `isolate(input$daterange[1])`
      interval_start_dt > input$daterange[2]
    )
  # possibly filter on the checkedGroups() value
  if (!is.null(checkedGroups())) {
    tv_data <- tv_data %>% filter(channeltitle %in% checkedGroups())
  }
  # rest of renderPlot code
})

Require a checkbox to be set. (But not inform the user)

output$tv <- renderPlot({
  # return silently if checkedGroups() is NULL
  req(checkedGroups())
  # rest of renderPlot code
})

Throw an informative error. See https://shiny.rstudio.com/reference/shiny/1.1.0/validate.html

output$tv <- renderPlot({
  # present an informative error if checkedGroups() is NULL
  validate(need(checkedGroups(), "Please check a box"))
  # rest of renderPlot code
})

I lean towards #1 or #3. I like #1 because I wouldn't want to check all the boxes (while getting rid of the error) and #3 because it informs the user what needs to change to make the plot work.

Hope this helps!

Best,
Barret