Rorschach
Rorschach

Reputation: 32426

Drag and drop data into shiny app

How can I drag and drop data into a shiny app? I can drag and drop into an area and read it with javascript, but I'm not sure how to have shiny register it so I can process it on the server. Here is an example setup -- it's kinda long b/c I don't think there is a javascript function builtin to deal with drag-n-drop.

It currently should look like the following when run and a dataset "dat.csv" is dragged in. The goal is register the data that has been drag-n-dropped into a variable in input so it can be processed in R. enter image description here

ui.R

library(shiny)

ui <- shinyUI(
  fluidPage(
    tags$head(tags$link(rel="stylesheet", href="css/styles.css", type="text/css"),
      tags$script(src="getdata.js")),
    h3(id="data-title", "Drop Datasets"),
    div(class="col-xs-12", id="drop-area", ondragover="dragOver(event)", 
      ondrop="dropData(event)"),
    tableOutput('table'),  # doesn't do anything now

    ## debug
    div(class="col-xs-12",
      tags$hr(style="border:1px solid grey;width:150%"),
      tags$button(id="showData", "Show", class="btn btn-info", 
        onclick="printData('dat.csv')")),
    div(id="data-output")  # print the data
  )
)

server.R

## Make a sample dataset
# write.csv(data.frame(a=1:10, b=letters[1:10]), "dat.csv", row.names=FALSE)
server <- function(input, output, session) {
  output$table <- renderTable(input$data)  # this variable doesn't exist
}

www/getdata.js

var datasets = {};
var dragOver = function(e) { e.preventDefault(); };
var dropData = function(e) {
    e.preventDefault();
    handleDrop(e.dataTransfer.files);
};
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;
        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);
    }
};
// debug
var printData = function(data) {
    var div = document.createElement("div");
    div.innerHTML = datasets[data];
    document.getElementById("data-output").appendChild(div);
};

www/css/styles.css

#data-title {
    text-align:center;
}

#drop-area {
    background-color:#BCED91;
    border:2px solid #46523C;
    border-radius:25px;
    height:90px;
    overflow:auto;
    padding:12px;
}

#drop-area #datasets {
    display:inline-block;
    font-size:small;
    margin-right:8px;
    text-align:center;
    vertical-align:top;
}

.thumb {
    height:45px;
}

Upvotes: 30

Views: 7591

Answers (2)

Charlotte Hadley
Charlotte Hadley

Reputation: 818

As of August 2017 this functionality is now provided by fileInput directly from shiny! How wonderful.

Here's the blogpost announcing the feature https://blog.rstudio.com/2017/08/15/shiny-1-0-4/

Upvotes: 10

Xiongbing Jin
Xiongbing Jin

Reputation: 12097

You just need to add the following line into the js file

datasets[file.name.toLowerCase()] = e.target.result;
# Add this line
Shiny.onInputChange("mydata", datasets);

Then you can use input$mydata in the server code. Note that it's a list, so you'll need to iterate through it (also necessary if you plan to drop several files).

Complete code (that also displays multiple csv files, note that if you drop multiple files with the same name, only one will be displayed):

getdata.js (add one line as above)

styles.css (no change)

ui.R

library(shiny)

ui <- shinyUI(
  fluidPage(
    tags$head(tags$link(rel="stylesheet", href="css/styles.css", type="text/css"),
              tags$script(src="getdata.js")),
    sidebarLayout(
      sidebarPanel(
        h3(id="data-title", "Drop Datasets"),
        div(class="col-xs-12", id="drop-area", ondragover="dragOver(event)", 
            ondrop="dropData(event)")
      ),
      mainPanel(
        uiOutput('tables')
      )
    )

  )
)

server.R

server <- function(input, output, session) {
  observeEvent(input$mydata, {
    len = length(input$mydata)
    output$tables <- renderUI({
      table_list <- lapply(1:len, function(i) {
        tableName <- names(input$mydata)[[i]]
        tableOutput(tableName)
      })
      do.call(tagList, table_list)
    })
    for (name in names(input$mydata)) {
      output[[name]] <- renderTable(read.csv(text=input$mydata[[name]]))
    }
  })
}

Upvotes: 18

Related Questions