Saya mencoba mencari cara untuk mengunduh timeline timeVis dari aplikasi mengkilap saya. Lebih khusus lagi, saya ingin menyimpan versi yang sudah dimodifikasi oleh pengguna.

Maksud saya adalah, setelah garis waktu dibuat dan ditampilkan, pengguna dapat berinteraksi dan menyeret elemen blok untuk mengaturnya sesuai keinginan. Saya kemudian menginginkan tombol yang menyimpan gambar garis waktu dalam kondisi saat ini. (Pada akhirnya saya akan memasukkan gambar ini ke dalam file zip item yang diunduh bersama.)

Saya mencoba menerapkan jawaban yang saya temukan di utas lain, tetapi saya tidak yakin apakah itu cara modern yang benar untuk melakukannya, ditambah lagi tidak berhasil.

Ide ide?

KODE

if (interactive()) {
  library(shiny)
  library(timevis)
  library(lubridate)
  
  starthour <- 8
  today <- as.character(Sys.Date())
  todayzero <- paste(today,"00:00:00")
  todayAM <- paste(today,"07:00:00")
  todayPM <- paste(today, "18:00:00")
  
  items <- data.frame(
    category = c("Room","IceBreaker","Activity","Break"),
    group=c(1,2,3,4),
    className   = c ("red_point", "blue_point", "green_point","purple_point"),
    content = c("Big Room","Introductions","Red Rover","Lunch"),
    length = c(480,60,120,90)
  )
  
  groups <- data.frame(id= items$group, content = items$category)
  
  data <- items %>% mutate(id = 1:4,
                           start = as.POSIXct(todayzero) + hours(starthour),
                           end   = as.POSIXct(todayzero) + hours(starthour) + minutes(items$length)
  )
  
  ui <- fluidPage(
    tags$head(
      tags$style(HTML("
                        .red_point  { border-color: red; border-width: 2px;   }
                        .blue_point { border-color: blue; border-width: 2px;  }
                        .green_point  { border-color: green; border-width: 2px;   }
                        .purple_point { border-color: purple; border-width: 2px;  }
                        "))),
    timevisOutput("appts"),
    div("Selected items:", textOutput("selected", inline = TRUE)),
    div("Visible window:", textOutput("window", inline = TRUE)),
    tableOutput("table"),
    downloadButton("downloadData", "Download timeline",class = "btn-success")
  )
  
  server <- function(input, output) {
    output$appts <- renderTimevis(
      timevis(
        data = data,
        groups = groups,
        fit = TRUE,
        options = list(editable = TRUE, multiselect = TRUE, align = "center", stack = TRUE,start = todayAM,
                       end = todayPM,showCurrentTime = FALSE,showMajorLabels=FALSE)
        
      )
    )
    
    output$selected <- renderText(
      paste(input$appts_selected, collapse = " ")
    )
    
    output$window <- renderText(
      paste(input$appts_window[1], "to", input$appts_window[2])
    )
    
    output$table <- renderTable(
      input$appts_data
    )
    time_line <- reactive(appts)
    
    output$downloadData <- downloadHandler( 
      filename = function(){ paste("Timeline", Sys.Date(), '.png', sep = '') }, 
      content = function(file){ time_line %>% htmltools::html_print() %>% webshot::webshot(file = filename) } )
    
    
  }
  shinyApp(ui, server)
 
}
0
Steve 7 Juli 2020, 19:04

1 menjawab

Jawaban Terbaik

Berikut adalah cara menggunakan pustaka JavaScript dom-to-image:

library(shiny)
library(timevis)
library(lubridate)
library(dplyr)

starthour <- 8
today <- as.character(Sys.Date())
todayzero <- paste(today,"00:00:00")
todayAM <- paste(today,"07:00:00")
todayPM <- paste(today, "18:00:00")

items <- data.frame(
  category = c("Room","IceBreaker","Activity","Break"),
  group=c(1,2,3,4),
  className   = c ("red_point", "blue_point", "green_point","purple_point"),
  content = c("Big Room","Introductions","Red Rover","Lunch"),
  length = c(480,60,120,90)
)

groups <- data.frame(id= items$group, content = items$category)

data <- items %>% mutate(id = 1:4,
                         start = as.POSIXct(todayzero) + hours(starthour),
                         end   = as.POSIXct(todayzero) + hours(starthour) + minutes(items$length)
)

js <- "
$(document).ready(function(){
  $('#download').on('click', function(){
    domtoimage.toPng(document.getElementById('appts'), {bgcolor: 'white'})
    .then(function (dataUrl) {
        var link = document.createElement('a');
        link.download = 'my-timeline.png';
        link.href = dataUrl;
        link.click();
    });
  });
});"

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/dom-to-image/2.6.0/dom-to-image.min.js"),
    tags$script(HTML(js)),
    tags$style(HTML("
                    .red_point  { border-color: red; border-width: 2px;   }
                    .blue_point { border-color: blue; border-width: 2px;  }
                    .green_point  { border-color: green; border-width: 2px;   }
                    .purple_point { border-color: purple; border-width: 2px;  }
                    "))),
  timevisOutput("appts"),
  div("Selected items:", textOutput("selected", inline = TRUE)),
  div("Visible window:", textOutput("window", inline = TRUE)),
  tableOutput("table"),
  actionButton("download", "Download timeline", class = "btn-success")
)

server <- function(input, output) {
  output$appts <- renderTimevis(
    timevis(
      data = data,
      groups = groups,
      fit = TRUE,
      options = list(editable = TRUE, multiselect = TRUE, align = "center", stack = TRUE,start = todayAM,
                     end = todayPM,showCurrentTime = FALSE,showMajorLabels=FALSE)
    )
  )
  
  output$selected <- renderText(
    paste(input$appts_selected, collapse = " ")
  )
  
  output$window <- renderText(
    paste(input$appts_window[1], "to", input$appts_window[2])
  )
  
  output$table <- renderTable(
    input$appts_data
  )
  
}
shinyApp(ui, server)
2
Stéphane Laurent 7 Juli 2020, 16:41