ggvis "Error :" with shiny

[kasper2619]

I am trying to build a large application with Shiny. I have managed to get the sandbox "mtcars" example to work in the app but when I am using the data the app is supposed to work with, shiny crashes due to the ggvis function. The error message is "Error :".

I have scanned the internet over and over again for solutions but without luck. My latest theory is that ggvis plot i being tun before the data is ready, but it is only a theory...

ui.R

library(shiny)
library(markdown)
library(shinythemes)
library(ggvis)

shinyUI(navbarPage(title = 'Paper 3 - The pattern of ideas', fluid = FALSE, id = "nav", theme = shinytheme("united"),
          #################
          ### LOAD DATA ###
          #################
          tabPanel("Load data", 
            sidebarLayout(
              sidebarPanel(
                fileInput("file", "Choose csv file", accept = c('text/csv', 
                                                                 'text/comma-separated-values,text/plain', 
                                                                 '.csv')), helpText(loadHelp),
                tags$hr(),
                radioButtons('quote', 'Quote', c(None='','Double Quote'='"','Single Quote'="'"),'"'),
                numericInput("sampleSize","Sample size (For computational feasibility)", 0.1,0,1, step = 0.01),
                numericInput("sampleConf","Confidence level", 1,0,1, step = 0.01),
                uiOutput("selGroup"),
                tags$hr(),
                actionButton("goButton", "Update")
              ),

              mainPanel(
                tabsetPanel(
                  id = 'loadTabs',
                  tabPanel('About file', tableOutput('filedf')),
                  tabPanel('Raw data', tableOutput('raw')),
                  tabPanel('Summary', tableOutput('sum'))
                )  
              )
            )
          ),
          ###############
          ###############
          ###############

          #######################
          ### TEXT PROCESSING ###
          #######################
          tabPanel("Text processing",
                   sidebarLayout(
                     sidebarPanel(
                       uiOutput("sparsity"),
                       uiOutput("grams"),
                       uiOutput("weighting"),
                       uiOutput("removeStop"),
                       actionButton("textUpdate", "Update")
                     ),
                     mainPanel(
                       tabsetPanel(
                         id = "textTabs",
                         tabPanel("Bag-of-words", dataTableOutput("bow"))
                       )
                     )
                   )
          ),

          ####################
          ### EXPLORE DATA ###
          ####################
          tabPanel("Principal components",
            sidebarLayout(
              sidebarPanel(
                uiOutput("nComp"),
                uiOutput("plot_ui"),
                actionButton("pcaUpdate", "Update nComp"),
                actionButton("plotUpdate", "Update plot")
              ),
              mainPanel(
                tabsetPanel(
                  id = "pcaTabs",
                  tabPanel("Eigenvalues", tableOutput("eigen")),
                  tabPanel("Scores", tableOutput("scores.out")),
                  tabPanel("VariableCorrelation", tableOutput("varCor")),
                  tabPanel("ScoresPlot",  ggvisOutput("plot"))
                )
              )
            )
          )
        )
)

server.R

llibrary(shiny)
library(rCharts)
library(d3Network)
library(reshape)
library(FactoMineR)
library(ggvis)
library(stringr)
source("functions/BAG_OF_WORDS.R")

options(RCHART_WIDTH = 800)
options(shiny.maxRequestSize = 9*1024^2)
options(browser = "C:/Program Files (x86)/Google/Chrome/Application/chrome.exe")
set.seed(1234)

shinyServer(function(input, output, session) {

  ############################
  ### LOAD DATA REACTIVELY ###
  ############################
  ds <- eventReactive(input$goButton,{
    file1 <- input$file
    if (is.null(file1)){return(NULL)}
    out <- read.csv(file1$datapath, header=TRUE, sep=",", quote=input$quote)
    out <- out[sample(nrow(out)),]
    out <- out[which(out$CLASS_CONFIDENCE >= input$sampleConf),]
    out <- out[sample(nrow(out)*input$sampleSize),]
    out <- out[which(out$GROUP %in% input$selGroup == TRUE),]
    return(out)
  })
  ############################
  ############################

  #####################
  ### LOAD DATA TAB ###
  #####################

  ### DATAFILE TAB ###
  output$filedf <- renderTable({
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, it will be a data frame with 'name',
    # 'size', 'type', and 'datapath' columns. The 'datapath'
    # column will contain the local filenames where the data can
    # be found.
    if(is.null(ds())){return()}
      input$file
  }, include.rownames=FALSE)

  ### RAWDATA TAB ###
  output$raw <- renderTable({
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, it will be a data frame with 'name',
    # 'size', 'type', and 'datapath' columns. The 'datapath'
    # column will contain the local filenames where the data can
    # be found.
    if(is.null(ds())){return()}
      ds()
  }, include.rownames=FALSE)

  ### SUMMARY TAB ###
  output$sum <- renderTable({
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, it will be a data frame with 'name',
    # 'size', 'type', and 'datapath' columns. The 'datapath'
    # column will contain the local filenames where the data can
    # be found.
    if(is.null(ds())){return()}
      out <- ds()
      out <- out[c(2,3,4)]
      return(summary(out))
  }, include.rownames=FALSE)

  ### CONTROLS FOR LOAD DATA TAB ###
  # SELECT GROUPS
  output$selGroup <- renderUI({
    checkboxGroupInput("selGroup", 
                       label = h3("Select groups"), 
                       choices = list("BREWING" = "BREWING", 
                                      "FOODEQUIPMENT" = "FOODEQUIPMENT", 
                                      "IPHONE" = "IPHONE",
                                      "LEGO" = "LEGO"),
                       selected = "BREWING")})
  #####################
  #####################

  ###########################
  ### TEXT PROCESSING TAB ###
  ###########################

  ### REACTIVE EXPRESSION THAT HANDLES BOW
  bow <- eventReactive(input$textUpdate,{
    # BOW function
    out <- BAG_OF_WORDS(ds(),input$sparsity,input$grams,input$weighting,input$removeStop)
    return(out)
  })

  ### BOW TAB ###
  output$bow <- renderDataTable({
      file1 <- input$file
      if (is.null(file1)){return(NULL)}

      out <- bow()[1:20,1:20]
      return(out)
  })

  ### CONTROLS FOR TEXT PROCESSING TAB ###
  # SET SPARSITY LEVEL
  output$sparsity <- renderUI({
    numericInput("sparsity", "Sparsity for bag-of-words", 0.975,0.50,0.9999, step = 0.001)
    })
  # SET NUMBER OF N-GRAMS
  output$grams <- renderUI({
    numericInput("grams", "Number of n-grams", 3,1,5, step = 1)
  })
  # SET WEIGHTING SCHEME
  output$weighting <- renderUI({
    selectInput("weighting", h5("Select weighting scheme"), choices = c("Binary" = "bin",
                                                                        "Term frequency" = "tf",
                                                                        "Term frequency inverse document frequency" = "tfidf"),
                                                                        selected = "tf")
  })
  # SET STOPWORDS TRUE OR FALSE
  output$removeStop <- renderUI({
    checkboxInput("removeStop", "Remove stopwords", value = FALSE)
  })
  ###########################
  ###########################

  ########################
  ### EXPLORE DATA TAB ###
  ########################
  pca <- eventReactive(input$pcaUpdate,{
    # pca
    out <- PCA(bow()[-c(which(names(bow()) == "ID"),which(names(bow()) == "TARGET"))], scale.unit = TRUE, ncp = input$nComp)
    return(out)
  })

  output$eigen <- renderTable({
    # eigenvalues
    set.seed(1234)
    out <- pca()$eig
    return(out)
  })

  output$scores<- renderTable({
    # variable correlation with principal components
    out <- cbind("ID" = as.data.frame(bow())$ID, as.data.frame(pca()$ind$coord))
    return(out)
  }, include.rownames = FALSE)

  output$varCor <- renderTable({
    # variable correlation with principal components
    out <- as.data.frame(pca()$var$coord)
    return(out)
  })

  #plot.ds <- reactive({
  scores.ds <- eventReactive(input$plotUpdate,{
    # scoresPlot ds
    out <- as.data.frame(cbind("ID" = as.data.frame(ds())$ID,
                               "MESSAGE_BODY" = as.data.frame(ds())$MESSAGE_BODY,
                               "TARGET" = as.data.frame(ds())$TARGET,
                               "GROUP" = as.data.frame(ds())$GROUP,
                               as.data.frame(pca()$ind$coord)))
    names(out) <- gsub("\\.", "_", names(out))
    return(out)
  })

  output$scores.out <- renderTable({
    return(scores.ds())
  })

  # A simple visualisation. In shiny apps, need to register observers
  # and tell shiny where to put the controls 
  scores.ds() %>%
    ggvis(x= ~ Dim_1, y= ~ Dim_2) %>%
    layer_points() %>%
    bind_shiny("plot")

  #reactive({
    #scores.ds %>%
      #ggvis(~Dim.1, ~Dim.2) %>%
      #layer_points() 
  #}) %>% bind_shiny("plot")

  ### CONTROLS FOR EXPLORE TAB ###
  ### PCA TAB
  output$nComp <- renderUI({
    numericInput(inputId = "nComp", label = h5("Select number of components"), value = 10, min = 1, max = 10000, step = 1)
  })

  ### SVD TAB

  # Y AXIS FOR SCATTERPLOT
  output$exploreSelectY <- renderUI({
    conditionalPanel(
      condition = 'input.exploretabs === "Scatterplot"',
        selectInput(inputId = "expSelectY", label = h5("Select Y variable"), choices = names(ds()))
    )
  })

  # X AXIS FOR SCATTERPLOT & HISTOGRAM
  output$exploreSelectX <- renderUI({
    conditionalPanel(
      condition = 'input.exploretabs === "Scatterplot" | input.exploretabs === "Histogram"',
        selectInput(inputId = "expSelectX", label = h5("Select X variable"), choices = names(ds()))
    )
  })

  # SELECT TARGET/GROUP FOR SCATTERPLOT AND TARGET/GROUP PLOT
  output$TARGET <- renderUI({
    conditionalPanel(
      condition = 'input.exploretabs === "TARGET/GROUP variable" | input.exploretabs === "Scatterplot" & input.targetTick == true',
        selectInput(inputId = "TARGET", label = h5("Select TARGET/GROUP variable"), choices = names(ds()))
    )
  })

  # BINS FOR HISTOGRAM
  output$histBins <- renderUI({
    conditionalPanel(
      condition = 'input.exploretabs === "Histogram"',
        numericInput(inputId = "histBins", label = h5("Choose how many bins for the histogram"), value = 10)
    )
  })

  # Y SLIDER FOR SCATTERPLOT
  output$exploreSliderY <- renderUI({
    conditionalPanel(
      condition = 'input.exploretabs === "Scatterplot"',
        sliderInput("expSliderY", label = h5("Slider Y Range"), min = (floor(min(ds()[input$expSelectY]))-2), max = (ceiling(max(ds()[input$expSelectY]))+2), value = c(0, 10))
    )
  })

  # X SLIDER FOR SCATTERPLOT
  output$exploreSliderX <- renderUI({
    conditionalPanel(
      condition = 'input.exploretabs === "Scatterplot"',
        sliderInput("expSliderX", label = h5("Slider X Range"), min = (floor(min(ds()[input$expSelectX]))-2), max = (ceiling(max(ds()[input$expSelectX]))+2), value = c(0, 10))
    )
  })

  ### SCATTERPLOT ###
  output$chart1 <- 
    renderChart2({
      if(is.null(ds)){return()}

      # build chart
      char1 <- nPlot(x = input$expSelectX, y = input$expSelectY, group = ifelse(input$targetTick == TRUE,input$TARGET,""), data = ds(), type = "scatterChart")
               char1$yAxis(axisLabel= input$expSelectY)
               char1$xAxis(axisLabel= input$expSelectX)
               char1$chart(forceY = c(input$expSliderY[1],input$expSliderY[2]))
               char1$chart(forceX = c(input$expSliderX[1],input$expSliderX[2]))
               char1$chart(sizeRange = c(50,50)) # set the size range
               char1$setTemplate(afterScript = '<script>
                                                var css = document.createElement("style");
                                                css.type = "text/css";
                                                css.innerHTML = ".nv-axislabel { font-size: 100px; }";
                                                document.body.appendChild(css);
                                                </script>') # snippet that makes you control font size. 
      return(char1)
    })

  ### HISTOGRAM ###
  output$chart2 <- 
    renderChart2({
      if(is.null(ds)){return()}

      # build chart
      ds.melt <- melt(ds())
      ds.melt <- subset(ds.melt, variable == input$expSelectX)
      ds.melt$bin <- cut(ds.melt$value, input$histBins)
      ds.cast <- cast(ds.melt, bin ~ variable)
      char2 <- nPlot(x = "bin", y = input$expSelectX, data = ds.cast, type = "discreteBarChart")
      char2$chart(color = c('green', 'blue'))
      char2$xAxis(rotateLabels=-45)
      return(char2)
  })

  ### TARGET VARIABLE ###  
  output$chart3 <- 
    renderChart2({
      if(is.null(ds)){return()}

      # build chart
      ds.melt <- as.data.frame(table(ds()[input$TARGET]))
      char3 <- nPlot(x = "Var1", y = "Freq", data = ds.melt, type = "discreteBarChart")
      char3$chart(color = c('green', 'blue', 'red', 'orange', 'purple'))
      return(char3)
    })

  })

whether i write:

scores.ds() %>%
...
...
...

or 

scores.ds %>%
...
...
... 

...does not make a difference. I also tried wrapping the ggvis into a reactive function.

Thank you four your help!

[kasper2619]

So my solution to this became:

server,R

observe({
    if(is.null(input$file) == TRUE){
      return(NULL)
    } else {
      ds %>%
        ggvis(~wt, ~mpg) %>%
        layer_points() %>%
        layer_points(size := input_slider(100, 1000, value = 1)) %>%
        add_tooltip(function(data){
          paste0("Wt: ", data$wt, "<br>", "Mpg: ",as.character(data$mpg), "<br>", "String: ", as.character(data$long))
        }, "hover") %>%
        bind_shiny("plot", "plot_ui")
    }
  })

The ui is fine as is.

I guess the problem is that ggvis causes shiny to crash when there is no data loaded. If anyone have better solutions I am all ear...