plotting issue on shinyapps.io

[Kevin Fayle]

Hi everyone,

I've published an app at https://nat-gunner.shinyapps.io/TexPred/.  It takes a user's text, predicts the next word, and displays a barplot of the possible words and their various probabilities.

I'm experiencing a strange issue where the plot loads fine for the first query, but then begins to load the plot from the previous query. (I.e., a user inputs "go to" and the plot doesn't change.  The user then inputs "an incredible" and the plot changes to the plot for "go to". Next, the user inputs for "what do" and the plot changes to the plot for "an incredible").  

What's strange is that if you refresh the app in the browser (I'm using Chrome v39.0.2171.95), the issue disappears and the plots function correctly.  

The app works totally fine on my local machine (R version 3.1.0 (2014-04-10), Platform: x86_64-apple-darwin10.8.0 (64-bit), shinyapps_0.3.63, shiny_0.10.2.1). I never see the issue that's occurring on the shinyapps server.

Does anyone have any thoughts on what's causing the issue and how to fix it?

I thought it was probably related to lexical scoping, and I tried a bunch of different fixes (e.g, removing variables from memory after the plot is drawn or not making them global in the first place, etc.) but nothing worked.

Any help is greatly appreciated!

Thanks,

Kevin

Here's the server.R code for the app:

library(shiny)

library(shinyapps)

library(RMySQL)

algo <- function(ngram){

    

    word.ct <- strsplit(ngram, split=" ")

    

    trigram <- function(x){

        match <- regexpr("([a-zA-Z0-9[:punct:]]+[[:space:]]*){3}$", x)

        tri <- regmatches(x, match)

        if (grepl("([a-zA-Z0-9[:punct:]]+[[:space:]]+){3}$", tri) == FALSE){

            tri <- paste(tri, "")

        }

        

        tri <- gsub("'", "\\'", tri, fixed=TRUE)

        

        return(tri)

    }

    

    bigram <- function(x){

        match <- regexpr("([a-zA-Z0-9[:punct:]]+[[:space:]]*){2}$", x)

        bi <- regmatches(x, match)

        if (grepl("([a-zA-Z0-9[:punct:]]+[[:space:]]+){2}$", bi) == FALSE){

            bi <- paste(bi, "")

        }

        

        bi <- gsub("'", "\\'", bi, fixed=TRUE)

        

        return(bi)

    }

    

    unigram <- function(x){

        match <- regexpr("([a-zA-Z0-9[:punct:]]+[[:space:]]*){1}$", x)

        uni <- regmatches(x, match)

        if (grepl("([a-zA-Z0-9[:punct:]]+[[:space:]]+){1}$", uni) == FALSE){

            uni <- paste(uni, "")

        }

        

        uni <- gsub("'", "\\'", uni, fixed=TRUE)

        

        return(uni)

    }

    

    unigram2 <<- function(x){

        match <- regexpr("([a-zA-Z0-9[:punct:]]+[[:space:]]*){1}$", x)

        uni <- regmatches(x, match)

#         if (grepl("([a-zA-Z0-9[:punct:]]+[[:space:]]+){1}$", uni) == FALSE){

#             uni <- paste(uni, "")

#         }

        

        # uni <- gsub("'", "\\'", uni, fixed=TRUE)

        

        return(uni)

    }

    

    tri.pred <- function(z){

        

        con <- dbConnect(MySQL(), 

                         user=, 

                         password=, 

                         host=, 

                         dbname=

        )

        

        expr <- paste("^", bigram(z), sep="")

        

        stmt <- paste("SELECT tri, freq FROM trigrams WHERE (tri REGEXP BINARY'", expr, "');", sep="")

        t.values <<- dbGetQuery(conn = con, statement = stmt)

        #print("trigrams loaded")

        dbDisconnect(con)

        

        if (identical(t.values[1,1], NULL)){

            #print("backing off to bigrams")

            wordz <<- c("is", "to", "of")

            bi.pred(z)

        }   else {

            word <- unigram2(t.values[1,1])

            wordz <<- c(unigram2(t.values[2,1]), unigram2(t.values[3,1]), unigram2(t.values[4,1]))

            return(word)

        }

    }

    

    bi.pred <- function(w){

        

        con <- dbConnect(MySQL(), 

                         user=, 

                         password=, 

                         host=, 

                         dbname=

        )

        

        expr <- paste("^", unigram(w), sep="")

        stmt <- paste("SELECT bi, freq FROM bigrams WHERE (bi REGEXP BINARY '", expr, "');", sep="")

        b.values <<- dbGetQuery(conn = con, statement = stmt)

        # print("bigrams loaded")

        dbDisconnect(con)

        

        if(identical(b.values[1,1], NULL)){

            ## rm(bi.comb.3)

            wordz <<- c("is", "to", "of")

            return("the")

        }   else {

            word <- unigram2(b.values[1,1])

            wordz <<- c(unigram2(b.values[2,1]), unigram2(b.values[3,1]), unigram2(t.values[4,1]))

            return(word)

        }

    }

    

    if (length(unlist(word.ct)) >= 2){

        tri.pred(ngram)

    } else {

        bi.pred(ngram)

    }

    

}

shinyServer(

    function(input, output) {

        

        output$word <- renderPrint({

            input$Submit

            if (input$Submit == 0)

                return(print("Waiting for input..."))

            ngram <- isolate(input$text)

            return(algo(ngram))

        })

        

        output$other <- renderPrint({

            input$Submit

            if (input$Submit == 0)

                return(print("Waiting for input..."))

            return(wordz)

        })

        

        output$hist <- renderPlot({

            if (input$Submit == 0){

                return(print("Waiting for input..."))

            } else {

                if (wordz == c("is", "to", "of")){

                    bp <- NULL

                } else if (exists("t.values")){

                    if (length(t.values[,2]) > 20){

                        bp <- barplot(t.values[1:20,2]/sum(t.values[,2]), main="Highest probability words", xaxt="n", ylab="Probability", col="cornflowerblue")

                        axis(1, labels=lapply(t.values[1:20,1], unigram2), at=bp, las=2)

                    } else {

                         bp <- barplot(t.values[,2]/sum(t.values[,2]), main="Highest probability words", xaxt="n", ylab="Probability", col="cornflowerblue")

                        axis(1, labels=lapply(t.values[,1], unigram2), at=bp, las=2)

                    } 

                } else {

                    if (length(b.values[,2] > 20)){

                        bp <- barplot(b.values[1:20,2]/sum(b.values[,2]), main="Highest probability words", xaxt="n", ylab="Probability", col="cornflowerblue")

                        axis(1, labels=lapply(b.values[1:20,1], unigram2), at=bp, las=2)

                    } else {

                        bp <- barplot(b.values[,2]/sum(b.values[,2]), main="Highest probability words", xaxt="n", ylab="Probability", col="cornflowerblue")

                        axis(1, labels=lapply(b.values[,1], unigram2), at=bp, las=2)

                    }

                }

            }

        })    

    }

)

[Winston Chang]

Just a guess, but the double-arrow assignment may be the culprit. Because the variables you're assigning to aren't present in the enclosing environment (e.g. the `algo` function or the `bi.pred` function), R will assign those values in the global environment. 

The global environment is shared across sessions, so that's why things may be persisting from session to session.

-Winston

--
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/01fb0808-41bd-490d-9060-e79b2982b1d4%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Kevin Fayle]

Hi Winston,

Thanks for the response, and sorry for the late reply.  

I changed the code so that it wasn't assigning the results of the DB query to a global variable, and that fixed the plot lag issue but it really slowed down my app.

I'm still struggling with how to use the results of a MySQL query constructed from user input for several different shinyServer outputs.

Right now, I'm just running duplicate DB queries for each output because I can't find a way to reuse the results of a single query without causing the lag.  It works, but it's extremely inefficient.

Do you (or does anyone else out there) know of a way to run a DB query once and then use the results for multiple outputs?

Thanks,

Kevin 

[Winston Chang]

I strongly suggest reading the three articles in the "Reactive programming" section:

  http://shiny.rstudio.com/articles/