r 拖放闪亮的文件上传 - http://stackoverflow.com/questions/36108705/drag-and-drop-data-into-shiny-app

Posted 2021-05-24

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;
        Shiny.onInputChange("mydata", 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);
    }
};
// debug
var printData = function(data) {
    var div = document.createElement("div");
    div.innerHTML = datasets[data];
    document.getElementById("data-output").appendChild(div);
};

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]]))
    }
  })
}

#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;
}

library(shiny)
jsfile <- "https://gist.githubusercontent.com/fbreitwieser/e6459659182486c5b7060f2e43435ec7/raw/c7e359ebce8f2e0a9e96c6e6fd1d696a5256009a/getdata.js"
cssfile <- "https://gist.githubusercontent.com/fbreitwieser/e6459659182486c5b7060f2e43435ec7/raw/b86a531d7d1f1628501772df0ea680b39be9dd59/styles.css"
ui <- shinyUI(
  fluidPage(
    tags$head(tags$link(rel="stylesheet", href=cssfile, type="text/css"),
              tags$script(src=jsfile)),
    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')
      )
    )

  )
)