Shiny R Reactive Function Fired Twice

[tao hong]

I am working on a small Shiny R app which includes some reactive functions, but I found its behavior is not what I expected. In my app:

1. A user uploads a CSV file and select columns and studies (rows) to display

2. In this reactive process, I called a function `test_func`, which prints the number of rows selected. However, I found for a single uploaded file, this `test_func` is called twice, and the first outcome is always `0`. I am wondering how to only call this function once, since the first `0` breaks my app... Thanks!

    `> shiny::runApp('my app')`

    `>Listening on http://127.0.0.1:3368`

    `[1] 0`

    `[1] 15`

Below is my code:

###ui.R

    library(shiny)

    

    shinyUI(fluidPage(

     titlePanel('test'),

   

      sidebarLayout(

        sidebarPanel(

          fileInput('file1', 'Choose CSV File',

                    accept=c('text/csv', 

                             'text/comma-separated-values,text/plain', 

                             '.csv')),

          checkboxGroupInput('show_vars', 'Columns to show:',

                             choices=c("Col1"="Col1", "Col2"="Col2", "Col3"="Col3"), 

                             c("Col1"="Col1", "Col2"="Col2", "Col3"="Col3")),

          

          uiOutput("study")

        ),

        mainPanel(

          dataTableOutput('contents')

        )

      )

    ))

##server.R

    test_func<-function(data_raw){

      print (nrow(data_raw))

    }

    

    shinyServer(function(input, output) {

      

      dataInput <- reactive({

        inFile <- input$file1

        if (is.null(inFile)) return(NULL)

        

        data_load_all<-read.csv(inFile$datapath, header=T, sep=',', quote='"', stringsAsFactors=FALSE)

        data_load<-subset(data_load_all, select=c(input$show_vars))

        data_study<-unique(data_load$Col2)

        return (list("data_load_all"=data_load_all, "data_load"=data_load, "data_study"=data_study))

      })

      

      

      study<-reactive({

        if (is.null(dataInput()$data_study))

          return ()

        all_citation<-dataInput()$data_load$Col2

        study_choose<-unlist(lapply(input$columns,  function(x) which(all_citation==x)))

        test<-test_func(dataInput()$data_load_all[study_choose, ])

        return (list("study_choose"=study_choose))

      })

    

      output$contents <- renderDataTable({

        study_choose_temp<-study()$study_choose

        dataInput()$data_load[study_choose_temp,]

        }

      )

    

       output$study <- renderUI({

        # If missing input, return to avoid error later in function

        if(is.null(dataInput()$data_study)) return()

    

        # Create the checkboxes and select them all by default

        checkboxGroupInput("columns", "Choose studies to plot", 

                            choices  = dataInput()$data_study,

                            selected = dataInput()$data_study)

      })

###[CSV][1]

  [1]: https://s3.amazonaws.com/stackquestion/test.csv

[Joe Cheng]

(Side note: For dataInput, I'd replace the line "if (is.null(inFile)) return(NULL)" with "validate(need(inFile, message=FALSE))". And then you can basically remove all the other NULL checks that derive from the input file being missing, as long as they all go through dataInput() to get at the uploaded data.)

This is happening twice because input$columns starts out empty; then when the output$study renderUI takes effect, input$columns comes back populated. Perhaps you also need "validate(need(input$columns, 'Please select some columns'))" at the beginning of the `study` reactive expression?

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/229a0144-a1b0-46d4-b88b-03c74ef588c5%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[tao hong]

I think adding the validation helps to solve part of the issue. But the problem still exists, and it is related to input$columns, which is not updated properly. For example, the code works if a user uploads a first CSV, but when he uploads a second CSV, the "all_citation=", is updated but "input$columns=" still has values from previous CSV. Later, Shiny R reload `"input$columns="`. So my question because how to let reactive function only run once... Thanks!

Below are console outputs and codes:

links to

CSV https://s3.amazonaws.com/stackquestion/test.csv

CSV1 https://s3.amazonaws.com/stackquestion/test1.csv

Server.R

test_func<-function(data_raw){

  print (nrow(data_raw))

}

shinyServer(function(input, output) {

  

  dataInput <- reactive({

    inFile <- input$file1

    if (is.null(inFile)) return(NULL)

    

    data_load_all<-read.csv(inFile$datapath, header=T, sep=',', quote='"', stringsAsFactors=FALSE)

    data_load<-subset(data_load_all, select=c(input$show_vars))

    data_study<-unique(data_load$Col2)

    return (list("data_load_all"=data_load_all, "data_load"=data_load, "data_study"=data_study))

  })

  

  

  study<-reactive({

    if (is.null(dataInput()$data_study))

      return ()

    all_citation<-dataInput()$data_load$Col2

    if (is.null(input$columns)) return()

    study_choose<-unlist(lapply(input$columns,  function(x) which(all_citation==x)))

    print (c('all_citation=', all_citation))

    print (c('input$columns=', input$columns))

    print (c('study_choose=', study_choose))

    test<-test_func(dataInput()$data_load_all[study_choose, ])

    return (list("study_choose"=study_choose))

  })

  output$contents <- renderDataTable({

    study_choose_temp<-study()$study_choose

    dataInput()$data_load[study_choose_temp,]

    }

  )

   output$study <- renderUI({

    # If missing input, return to avoid error later in function

    if(is.null(dataInput()$data_study)) return()

    # Create the checkboxes and select them all by default

    checkboxGroupInput("columns", "Choose studies to plot", 

                        choices  = dataInput()$data_study,

                        selected = dataInput()$data_study)

  })

Listening on http://127.0.0.1:3368

###CSV 1###

 [1] "all_citation=" "Study 1"       "Study 1"       "Study 2"       "Study 2"       "Study 2"       "Study 2"       "Study 3"       "Study 4"       "Study 4"      

[11] "Study 4"       "Study 4"       "Study 5"       "Study 5"       "Study 5"       "Study 5"      

[1] "input$columns=" "Study 1"        "Study 2"        "Study 3"        "Study 4"        "Study 5"       

 [1] "study_choose=" "1"             "2"             "3"             "4"             "5"             "6"             "7"             "8"             "9"            

[11] "10"            "11"            "12"            "13"            "14"            "15"           

[1] 15

###CSV 2###

[1] "all_citation=" "Study 6"       "Study 6"       "Study 6"       "Study 7"       "Study 7"       "Study 7"      

[1] "input$columns=" "Study 1"        "Study 2"        "Study 3"        "Study 4"        "Study 5"       

[1] "study_choose="

[1] 0

[1] "all_citation=" "Study 6"       "Study 6"       "Study 6"       "Study 7"       "Study 7"       "Study 7"      

[1] "input$columns=" "Study 6"        "Study 7"       

[1] "study_choose=" "1"             "2"             "3"             "4"             "5"             "6"            

[1] 6

On Monday, November 17, 2014 2:24:21 PM UTC-5, tao hong wrote:

Adding Validation did solve this problem. Thanks!

[Joe Cheng]

Does it matter that the calculation happens twice? If so, because these calculations take a long time to run, it might be desirable to add an explicit "Calculate" button, so you're not automatically recalculating each time the user selects or deselects a column. If you decide to do that, you'll want to avoid the submitButton() function (it doesn't work right with file inputs) and use actionButton instead. There's an article here but feel free to ask if it's not clear how you would apply that to your app.

If you want to avoid a calculate button, you could work around this a bit painfully by putting in a high-priority observer that basically detects each time a file is uploaded and sets a flag that tells the reactives to ignore the uploaded file until the column information is also uploaded. Something like this (my additions in bold):

test_func<-function(data_raw){

  print (nrow(data_raw))

}

shinyServer(function(input, output) {

  values <- reactiveValues(waitForColumns = FALSE)

  observe(priority = 10, {

    input$file1

    values$waitForColumns <- TRUE

  })

  observe({

    input$columns

    values$waitForColumns <- FALSE

  })

  

  dataInput <- reactive({

    inFile <- input$file1

    if (is.null(inFile)) return(NULL)

    

    data_load_all<-read.csv(inFile$datapath, header=T, sep=',', quote='"', stringsAsFactors=FALSE)

    data_load<-subset(data_load_all, select=c(input$show_vars))

    data_study<-unique(data_load$Col2)

    return (list("data_load_all"=data_load_all, "data_load"=data_load, "data_study"=data_study))

  })

  

  

  study<-reactive({

    if (is.null(dataInput()$data_study))

      return ()

    validate(need(!values$waitForColumns, FALSE))

    all_citation<-dataInput()$data_load$Col2

    if (is.null(input$columns)) return()

    study_choose<-unlist(lapply(input$columns,  function(x) which(all_citation==x)))

    print (c('all_citation=', all_citation))

    print (c('input$columns=', input$columns))

    print (c('study_choose=', study_choose))

    test<-test_func(dataInput()$data_load_all[study_choose, ])

    return (list("study_choose"=study_choose))

  })

  output$contents <- renderDataTable({

    study_choose_temp<-study()$study_choose

    dataInput()$data_load[study_choose_temp,]

    }

  )

   output$study <- renderUI({

    # If missing input, return to avoid error later in function

    if(is.null(dataInput()$data_study)) return()

    # Create the checkboxes and select them all by default

    checkboxGroupInput("columns", "Choose studies to plot", 

                        choices  = dataInput()$data_study,

                        selected = dataInput()$data_study)

  })

--

You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/511400ea-e6be-4dec-a315-da085cab5921%40googlegroups.com.

[tao hong]

Thanks for the quick reply. In the real code, running the code twice kills my data.frame... It seems like `renderUI` fires too fast or it could should be a event driven function (does Shiny R offer something like .change() used in jQuery?)

[Joe Cheng]

> In the real code, running the code twice kills my data.frame

Yikes, can you explain this?

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/10427381-305f-4420-ac11-847c117b5ac0%40googlegroups.com.

[tao hong]

Sure. I think `.change()` is similar to your suggested  `validate` function. Maybe something like:

$('input[name=file]').change(function() {

   run `study_choose<-unlist(lapply(input$columns,  function(x) which(all_citation==x)))`; 

});

BTW, I tried to add your validate function but got the following error... Do I need to install any packages?

Listening on http://127.0.0.1:3368

Error in UseMethod("validate") : 

  no applicable method for 'validate' applied to an object of class "logical"

Error in UseMethod("validate") : 

  no applicable method for 'validate' applied to an object of class "NULL"

Thanks!

[Joe Cheng]

It looks like a different package implements an S3 method called validate. You can make that error go away using shiny::validate.

I was actually asking not about jQuery's change, but about why running the code twice kills your data frame?

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/06f196c0-a83f-4d15-9211-917ef618d87f%40googlegroups.com.

[tao hong]

The reason is an early fired `renderUI` will generate a data framework with different number of rows...  Most of the columns of this data frame comes from CSV, but there a several hard coded columns. I guess I can also set an exception rule on the data frame part. So may I know why `renderUI` is running twice?

[Joe Cheng]

The reason isn't that renderUI is running too fast. If anything it's too "slow" (I put it in quotes because it couldn't possibly happen faster). When a new file is uploaded, dataInput, study, output$contents, and output$study all become invalidated and need to run. That all happens; this is the first run, when nrow == 0. Now output$study has run, the browser's UI updates with a new set of columns, and since they're all selected by default, now a new value for input$columns is sent to the server. That causes study and output$contents to become invalidated and need to run. When that happens, it's the second run, when nrow == 13 or whatever.

That's why my solution says, when input$file changes, don't actually let study execute. Only when input$columns changes is study allowed to execute. So what you were asking for (jquery change()) actually exists, it's just called observe() in Shiny, and my proposed changes include that.

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/e6c81288-363a-481b-b2d4-acc0928c5472%40googlegroups.com.

[Joe Cheng]

There is one problem in the observer-based solution I sent you, I'm not sure how to fix it without adding some JS. That is, uploading two files which both contain the same set of columns, one after another, will not work; the second won't update because if input$columns is set to the same value, the observer won't fire at all.

Is the button approach problematic?

[tao hong]

Wow, thanks for the step by step explanation and I do agree your proposed method fixed the issue. Thanks for your help!

[Jan Stanstrup]

I am having the same issues now when I have 1 selectInput that depends on another selectInput. You code worked to solve the problem of updating the rest before the dependant selectInput got a change to update.

But if the dependant selectInput stays the same when the first selectInput is updated it fails as you mentioned.

Any way around this currently?