R Shiny Input Reactivity Error on Drag-and-Drop

2019-04-15 05:01发布

问题:

Im currently creating a R Shiny app with some custom js to provide drag and drop functionality. While the drag and drop works perfectly for a single file, when I reset it using shinyJS, uploading the same file again does not work properly. I understand that this is because the onchange function is not being triggerred with the file with the same name being re-inputted (regardless of if the file contents have been modified)

JS:

var datasets = {};
var dragOver = function(e) { e.preventDefault(); };

var dropData = function(e) {
    e.preventDefault();
    handleDrop(e.dataTransfer.files);
};

var removeFiles = function(e){
    jQuery('#datafile').empty();
}

var handleDrop = function(files) {
    for (var i = 0, f; f = files[i]; i++) {
    var reader = new FileReader();

    reader.onload = (function(file) {
        return function(e) {
        datasets[file.name.toLowerCase()] = e.target.result;
        Shiny.onInputChange("datafile", datasets);
        var div = document.createElement("div");
        var src = "https://cdn0.iconfinder.com/data/icons/office/512/e42-512.png";
        div.id = "datasets";
        div.innerHTML = [
            "<img class='thumb' src='", src, "' title='", encodeURI(file.name),
            "'/>", "<br>", file.name, "<br>"].join('');
        document.getElementById("drop-area").appendChild(div);
        };
    })(f);
    reader.readAsText(f);
    }
};

Server.R (The part of it looking at file input):

observeEvent(input$datafile, {
    infile <- input$datafile
    if (is.null(infile)) {
      # User has not uploaded a file yet
      return(NULL)
    }

    # CLEAN FILE
    name <- names(input$datafile)[1]
    csvFile <- read.csv(text=input$datafile[[name]])

  output$dataTable <- renderDataTable(csvFile , options = list(scrollX = '1100px') )

}

ui.R (Just the relevant portion):

   # DRAG AND DROP FILE INPUT
   h3(id="data-title", "Drop Datasets"),

   div(class="col-xs-12", id="drop-area", ondragover="dragOver(event)", 
       ondrop="dropData(event)" , onClick="fallback(event)"),

   div(onClick="removeFiles(event)", actionButton(inputId="resetAutomaticInput", label="Reset Input")

I do not understand how to make my shiny values reactive to trigger the event associated with input$datafile. Any help is deeply appreciated!

回答1:

I had a look at this and played with it for awhile, making it into a working example first. I think the drag-and-drop functionality is a useful example here. It handles multi-drop correctly too. There are some interesting javascript constructs in it too - at least to me.

To fix the problem, instead of a random number like BigDataScientist suggested, I just used a count which could be useful for other things too.

In total these changes were made:

  • Completed the fragments into a complete Shiny working example and saved it to its own directory.
  • Placed the javascript code into a sub-directory named www under the directory the Shiny code was saved.
  • Added a tag$head(tag$script(... statement in the UI code to load that javascript.
  • Added some innerhtml text to the drop-area div so there is something to drop it into.
  • Added a dropcount to the javascript.
  • Changed the html so that that dropcount would be echoed to the drop-area div.
  • Changed the output to verbatumPrintOutput so you can see more of the dataframe in less area.
  • Added a couple more fields to the output so you could see better what was in input$datafile.
  • Changed the JS for loop to something that would not generate a warning.
  • Added a jslint comment up top to get rid of another warning.
  • Added some output fields (inputdatafile and rowsdatafile) so you could track what was in input$datafile - until I did that I was not clear what the real error was, but that is just me...
  • Changed the logic slightly in the output to make the reset functionality work the way one would probably expect (the example code seemed still incomplete)
  • Probably a few other small things that I forgot.

Here is the code:

JS:

/*jshint loopfunc:true */ // git rid of warning
var datasets = {};
var dragOver = function(e) { e.preventDefault(); };

var dropData = function(e) {
  e.preventDefault();
  handleDrop(e.dataTransfer.files);
};
var dropcount=0;

var removeFiles = function(e){
    txt = "Drop Area "+dropcount;
    jQuery('#drop-area').html(txt);
    datasets = {};
    Shiny.onInputChange("datafile", datasets);
};
var handleDrop = function(files) {
  for (var i = 0; i<files.length; i++) {
    f = files[i];
    var reader = new FileReader();

    reader.onload = (function(file) {
      return function(e) {
        datasets[file.name.toLowerCase()+'|'+dropcount] = e.target.result;
        Shiny.onInputChange("datafile", datasets);
        var div = document.createElement("div");
        var src = "https://cdn0.iconfinder.com/data/icons/office/512/e42-512.png";
        div.id = "datasets";
        div.innerHTML = [
          "<img class='thumb' src='", src, "' title='", encodeURI(file.name),
          "'/>", "<br>", file.name, "<br>"].join('');
        drpel = document.getElementById("drop-area");
        drpel.appendChild(div);
        drpel.childNodes[0] = "Drop Area "+dropcount;
      };
    })(f);
    reader.readAsText(f);
    dropcount++;
  }
};

Here is the Shiny:

library(plotly)
library(htmlwidgets)
library(shiny)
library(ggplot2)

ui <- shinyUI(fluidPage(

  tags$head(tags$script(type="text/javascript", src = "fileUp.js")),

  # DRAG AND DROP FILE INPUT
  h3(id="data-title", "Drop Datasets"),

  div(class="col-xs-12",id="drop-area",ondragover="dragOver(event)", 
      ondrop="dropData(event)",onClick="fallback(event)","Drop Area"),

  div(onClick="removeFiles(event)",
      actionButton(inputId="resetAutomaticInput",label="Reset Input"),
      verbatimTextOutput("inputdatafile"),
      verbatimTextOutput("rowsdatafile"),
      verbatimTextOutput("dataTable"))
))    
server <- shinyServer(function(input, output) {

  observeEvent(input$datafile, {
    infile <- input$datafile
    if (length(infile)==0) {
      # User has not uploaded a file yet
        return(NULL)
    }    
    # CLEAN FILE
    name <- names(input$datafile)[length(infile)]
    csvFile <- reactive(
      if (length(input$datafile)>0){
        read.csv(text=input$datafile[[name]])
      }
    )

    output$dataTable <- renderPrint(csvFile())
    output$inputdatafile <- renderPrint(names(input$datafile))
    output$rowsdatafile <- renderPrint(sapply(input$datafile,nchar))
  })
})
shinyApp(ui, server)

And a screen shot: