R/filechoose.R
In armelmoth/shinyFilesDropBox: What the package does (short line)
#' @include aaa.R
NULL
#' Get the information about the children's folder
#'
#' This function works with fileGetterFile, fileGetterSave, fileGetterDir functions.
#' When the last needs to get information about a children's folder they call this function, which look into
#' the the children's folder. Mtime of the children's folder is the minimum of all of its mtime files.
#' Atime of the children's folder is the minimum of all of its atime files. Ctime of the children's folder
#' is the minimum of all of its ctime files. The size is a sum of its size files.
#'
#' @param folderPath The path of the children's folder.
#'
#' @param dtoken The Dropbox token generated by drop_auth (package rdrop2).
#'
#' @return returns a list of the size, mtime, atime, and ctime file.
#'
#' @importFrom rdrop2 drop_dir
#'
getInfo = function(folderPath,dtoken){
drop_dir = data.frame()
repeat{
drop_dir = tryCatch(drop_dir(folderPath,dtoken = dtoken),error=function(e) { e })
if(is.data.frame(drop_dir)){
break
}
}
res = list()
if(nrow(drop_dir)==0){
res = list(
mtime = format(Sys.time(), format='%Y-%m-%d-%H-%M'),
ctime = format(Sys.time(), format='%Y-%m-%d-%H-%M'),
atime = format(Sys.time(), format='%Y-%m-%d-%H-%M'),
size = 0
)
}
else{
if (length(drop_dir$.tag[drop_dir$.tag=='file'])==0){
files = drop_dir$path_display
lengthDir = length(files)
infoDir = lapply(as.vector(files), getInfo, dtoken)
res = list(
mtime = min(sapply(1:lengthDir, function (i){infoDir[i][[1]]$mtime}), na.rm = TRUE),
ctime = min(sapply(1:lengthDir, function (i){infoDir[i][[1]]$ctime}), na.rm = TRUE),
atime = min(sapply(1:lengthDir, function (i){infoDir[i][[1]]$atime}), na.rm = TRUE),
size = sum(infoDir$size, na.rm = TRUE)
)
}
else{
fileInfo = data.frame(size=drop_dir$size)
drop_dir$client_modified = chartr(":T", "--", drop_dir$client_modified)
drop_dir$client_modified = gsub("Z","", drop_dir$client_modified)
drop_dir$server_modified = chartr(":T", "--", drop_dir$server_modified)
drop_dir$server_modified = gsub("Z","", drop_dir$server_modified)
res = list(
mtime = min(substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3)), na.rm = TRUE),
ctime = min(substr(drop_dir$server_modified,1,(nchar(drop_dir$server_modified)-3)), na.rm = TRUE),
atime = min(substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3)), na.rm = TRUE),
size = sum(fileInfo$size, na.rm = TRUE)
)
}
}
return(res)
}
#' Create a function that returns fileinfo according to the given restrictions
#'
#' This functions returns a new function that can generate file information to
#' be send to a shiny app based on a path relative to the given root. The
#' function is secure in the sense that it prevents access to files outside of
#' the given root directory as well as to subdirectories matching the ones given
#' in restrictions. Furthermore can the output be filtered to only contain
#' certain filetypes using the filter parameter.
#'
#' @param roots A named vector of absolute filepaths or a function returning a
#' named vector of absolute filepaths (the latter is useful if the volumes
#' should adapt to changes in the filesystem).
#'
#' @param restrictions A vector of directories within the root that should be
#' filtered out of the results
#'
#' @param filetypes A character vector of file extensions (without dot in front
#' i.e. 'txt' not '.txt') to include in the output. Use the empty string to
#' include files with no extension. If not set all file types will be included
#'
#' @param dtoken The Dropbox token generated by drop_auth (package rdrop2).
#'
#' @return A function taking a single path relative to the specified root, and
#' returns a list of files to be passed on to shiny
#'
#' @rdname shinyFilesDropBox-fileGetter
#' @name shinyFilesDropBox-fileGetter
#'
#' @importFrom tools file_ext
#' @importFrom rdrop2 drop_dir drop_exists
#'
fileGetterFile <- function(restrictions, filetypes, session,id,dtoken,roots=c(Home="")) {
if (missing(filetypes)) filetypes <- NULL
if (missing(restrictions)) restrictions <- NULL
function(dir, root) {
session$sendCustomMessage('shinyFilesProgress',list(width = "24",id=id))
currentRoots <- if(class(roots) == 'function') roots() else roots
if (is.null(names(currentRoots))) stop('Roots must be a named vector or a function returning one')
if (is.null(root)) root <- names(currentRoots)[1]
session$sendCustomMessage('shinyFilesProgress',list(width = "24",id=id))
if(substr(dir,1,1)=="/"){
dir = substr(dir,2,nchar(dir))
}
if(substr(dir,nchar(dir),nchar(dir))=="/"){
dir = substr(dir,1,(nchar(dir)-1))
}
fulldir <- file.path(currentRoots[root], dir)
if(substr(fulldir,nchar(fulldir),nchar(fulldir))=="/" & nchar(fulldir)>1){
fulldir = substr(fulldir,1,(nchar(fulldir)-1))
}
session$sendCustomMessage('shinyFilesProgress',list(width = "24",id=id))
drop_dir = data.frame()
repeat{
drop_dir = tryCatch(drop_dir(fulldir,dtoken = dtoken),error=function(e) { e })
if(is.data.frame(drop_dir)){
break
}
}
writable = TRUE
res = list()
drop_exists = FALSE
repeat{
drop_exists = tryCatch(drop_exists(fulldir,dtoken = dtoken),error=function(e) { e })
if(is.logical(drop_exists)){
break
}
}
if(nrow(drop_dir)==0){
session$sendCustomMessage('shinyFilesProgress',list(width = "158",id=id))
breadcrumps <- strsplit(dir, .Platform$file.sep)[[1]]
fileInfo = data.frame(filename=character(0), extension=character(0), isdir=logical(0), size=integer(0), mtime=character(0), ctime=character(0), atime=character(0))
res = list(
files=fileInfo[, c('filename', 'extension', 'isdir', 'size', 'mtime', 'ctime', 'atime')],
writable=writable,
exist = (fulldir == "/") || drop_exists,
breadcrumps=I(c('', breadcrumps[breadcrumps != ''])),
roots=I(names(currentRoots)),
root=root
)
}
if(nrow(drop_dir)>0){
if (length(drop_dir$.tag[drop_dir$.tag=='file'])==0){
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
files = drop_dir$path_display
files <- gsub(pattern='//*', '/', files, perl=TRUE)
lengthDir = length(files)
infoDir = lapply(as.vector(files), getInfo, dtoken)
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
fileInfo = data.frame(filename = basename(files))
fileInfo$size = sapply(1:lengthDir, function (i){infoDir[i][[1]]$size})
fileInfo$mtime= sapply(1:lengthDir, function (i){infoDir[i][[1]]$mtime})
fileInfo$atime= sapply(1:lengthDir, function (i){infoDir[i][[1]]$atime})
fileInfo$ctime= sapply(1:lengthDir, function (i){infoDir[i][[1]]$ctime})
fileInfo$isdir = TRUE
fileInfo$extension = tolower(file_ext(files))
session$sendCustomMessage('shinyFilesProgress',list(width = "102",id=id))
rownames(fileInfo) <- NULL
breadcrumps <- strsplit(dir, .Platform$file.sep)[[1]]
res = list(
files=fileInfo[, c('filename', 'extension', 'isdir', 'size', 'mtime', 'ctime', 'atime')],
writable=writable,
exist = (fulldir == "/") || drop_exists,
breadcrumps=I(c('', breadcrumps[breadcrumps != ''])),
roots=I(names(currentRoots)),
root=root
)
}
if (length(drop_dir$.tag[drop_dir$.tag=='file'])>0){
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
files = drop_dir$path_display
files <- gsub(pattern='//*', '/', files, perl=TRUE)
if (!is.null(restrictions) && length(files) != 0) {
if (length(files) == 1) {
keep <- !any(sapply(restrictions, function(x) {grepl(x, files, fixed=T)}))
} else {
keep <- !apply(sapply(restrictions, function(x) {grepl(x, files, fixed=T)}), 1, any)
}
files <- files[keep]
}
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
fileInfo = data.frame(filename = basename(files))
fileInfo$extension <- tolower(file_ext(files))
drop_dir$client_modified = chartr(":T", "--", drop_dir$client_modified)
drop_dir$client_modified = gsub("Z","", drop_dir$client_modified)
drop_dir$server_modified = chartr(":T", "--", drop_dir$server_modified)
drop_dir$server_modified = gsub("Z","", drop_dir$server_modified)
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
fileInfo$mtime <- substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3))
fileInfo$ctime <- substr(drop_dir$server_modified,1,(nchar(drop_dir$server_modified)-3))
fileInfo$atime <- substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3))
session$sendCustomMessage('shinyFilesProgress',list(width = "50",id=id))
fileInfo$isdir = drop_dir$.tag == 'folder'
fileInfo$size = drop_dir$size
lengthIsdir = length(fileInfo$filename[fileInfo$isdir])
session$sendCustomMessage('shinyFilesProgress',list(width = "12",id=id))
if(lengthIsdir > 0){
infoIsdir = lapply(as.vector(drop_dir$path_display[drop_dir$.tag == 'folder']), getInfo,dtoken)
fileInfo$size[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$size})
fileInfo$mtime[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$mtime})
fileInfo$atime[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$atime})
fileInfo$ctime[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$ctime})
}
session$sendCustomMessage('shinyFilesProgress',list(width = "12",id=id))
if (!is.null(filetypes)) {
matchedFiles <- tolower(fileInfo$extension) %in% tolower(filetypes) & fileInfo$extension != ''
fileInfo$isdir[matchedFiles] <- FALSE
fileInfo <- fileInfo[matchedFiles | fileInfo$isdir,]
}
rownames(fileInfo) <- NULL
breadcrumps <- strsplit(dir, .Platform$file.sep)[[1]]
res = list(
files=fileInfo[, c('filename', 'extension', 'isdir', 'size', 'mtime', 'ctime', 'atime')],
writable=writable,
exist = (fulldir == "/") || drop_exists,
breadcrumps=I(c('', breadcrumps[breadcrumps != ''])),
roots=I(names(currentRoots)),
root=root
)
}
}
session$sendCustomMessage('shinyFilesProgress',list(width = "10",id=id))
return(res)
}
}
#' Create a connection to the server side filesystem
#'
#' These function sets up the required connection to the client in order for the
#' user to navigate the filesystem. For this to work a matching button should be
#' present in the html, either by using one of the button generating functions
#' or adding it manually. See \code{\link{shinyFiles-buttons}} for more details.
#'
#' Restrictions on the access rights of the client can be given in several ways.
#' The root parameter specifies the starting position for the filesystem as
#' presented to the client. This means that the client can only navigate in
#' subdirectories of the root. Paths passed of to the \code{restrictions}
#' parameter will not show up in the client view, and it is impossible to
#' navigate into these subdirectories. The \code{filetypes} parameter takes a
#' vector of file extensions to filter the output on, so that the client is
#' only presented with these filetypes. Whenever a file or folder
#' choice is made the resulting files/folder will be accessible in the input
#' variable with the id given in the parameters. This value should probable be
#' run through a call to one of the parser (\code{\link{shinyDropFiles-parsers}}) in
#' order to get well formatted paths to work with.
#'
#' @param input The input object of the \code{shinyServer()} call (usaully
#' \code{input})
#'
#' @param id The same ID as used in the matching call to
#' \code{shinyDropFilesButton} or as the id attribute of the button, in case of a
#' manually defined html. This id will also define the id of the file choice in
#' the input variable
#'
#' @param updateFreq The time in milliseconds between file system lookups. This
#' determines the responsiveness to changes in the filesystem (e.g. addition of
#' files or drives)
#'
#' @param session The session object of the shinyServer call (usually
#' \code{session}).
#'
#' @param defaultRoot The default root to use. For instance if
#' \code{roots = c(Home = '', Home2='/home')} then \code{defaultRoot}
#' can be either \code{'Home'} or \code{'Home2'}.
#'
#' @param defaultPath The default relative path specified given the \code{defaultRoot}.
#'
#' @param dtoken The Dropbox token generated by drop_auth (package rdrop2).
#'
#' @param ... Arguments to be passed on to \code{\link{fileGetterFile}} or
#' \code{\link{dirDropGetter}}
#'
#' @return A reactive observer that takes care of the server side logic of the
#' filesystem connection.
#'
#' @rdname shinyFilesDropBox-observers
#' @name shinyFilesDropBox-observers
#'
#' @examples
#' \dontrun{
#'# File selections
#'token = drop_auth(new_user = FALSE, cache=TRUE)
#' ui <- shinyUI(bootstrapPage(
#' shinyDropFilesButton('files', 'File select', 'Please select a file', FALSE)
#' ))
#' server <- shinyServer(function(input, output,session) {
#' shinyDropFileChoose(input, 'files',session = session, dtoken =token)
#' })
#'
#' runApp(list(
#' ui=ui,
#' server=server
#' ))
#'}
#'
#' @rdname shinyFiles-observers
#' @name shinyFiles-observers
#'
#' @family shinyFilesDropBox
#'
#' @importFrom shiny observe invalidateLater
#'
#' @export
#'
shinyDropFileChoose <- function(input, id, updateFreq=100000, session = getDropSession(),
defaultRoot=NULL, defaultPath='', dtoken, ...) {
clientId = session$ns(id)
fileGet <- do.call('fileGetterFile', list(session=session,id = clientId,dtoken=dtoken,...))
currentDir <- list()
return(observe({
dir <- input[[paste0(id, '-modal')]]
if(is.null(dir) || is.na(dir)) {
dir <- list(dir=defaultPath, root=defaultRoot)
} else {
dir <- list(dir=dir$path, root=dir$root)
}
dir$dir <- do.call(file.path, as.list(dir$dir))
#print(paste("Geting file",id))
newDir <- do.call('fileGet', dir)
#print(paste("File got",id))
session$sendCustomMessage('shinyFilesProgressEnd',list(id=clientId))
if(!identical(currentDir, newDir)) {
currentDir <<- newDir
#print(paste("Dialog box",id))
session$sendCustomMessage('shinyFiles', list(id=clientId, dir=newDir))
#print(paste("Dialog box Done",id))
}
invalidateLater(updateFreq, session)
}))
}
#' Create a button to summon a shinyFiles dialog
#'
#' This function adds the required html markup for the client to access the file
#' system. The end result will be the appearance of a button on the webpage that
#' summons one of the shinyFiles dialog boxes. The last position in the file
#' system is automatically remembered between instances, but not shared between
#' several shinyFiles buttons. For a button to have any functionality it must
#' have a matching observer on the server side. shinyDropFilesButton() is matched
#' with shinyDropFileChoose() and shinyDropDirButton with shinyDropDirChoose(). The id
#' argument of two matching calls must be the same. See
#' \code{\link{shinyFiles-observers}} on how to handle client input on the
#' server side.
#'
#' @details
#' \strong{Selecting files}
#'
#' When a user selects one or several files the corresponding input variable is
#' set to a list containing a character vector for each file. The character
#' vectors gives the traversal route from the root to the selected file(s). The
#' reason it does not give a path as a string is that the client has no
#' knowledge of the file system on the server and can therefore not ensure
#' proper formatting. The \code{\link{parseDropFilePaths}} function can be used on
#' the server to format the input variable into a format similar to that
#' returned by \code{\link[shiny]{fileInput}}.
#'
#' \strong{Selecting folders}
#'
#' When a folder is selected it will also be available in its respective input
#' variable as a list giving the traversal route to the selected folder. To
#' properly format it, feed it into \code{\link{parseDirPath}} and a string with
#' the full folder path will be returned.
#'
#' \strong{Creating files (saving)}
#'
#' When a new filename is created it will become available in the respective
#' input variable and can be formatted with \code{\link{parseSavePath}} into a
#' data.frame reminiscent that returned by fileInput. There is no size column
#' and the type is only present if the filetype argument is used in
#' \code{shinySaveButton}. In that case it will be the name of the chosen type
#' (not the extension).
#'
#' \strong{Manual markup}
#'
#' For users wanting to design their html markup manually it is very easy to add
#' a shinyFiles button. The only markup required is:
#'
#' \emph{shinyDropFilesButton}
#'
#' \code{<button id="inputId" type="button" class="shinyFiles btn btn-default" data-title="title" data-selecttype="single"|"multiple">label</button>}
#'
#' \emph{shinyDropDirButton}
#'
#' \code{<button id="inputId" type="button" class="shinyDirectories btn-default" data-title="title">label</button>}
#'
#' \emph{shinyDropSaveButton}
#'
#' \code{<button id="inputId" type="button" class="shinySave btn-default" data-title="title" data-filetype="[{name: 'type1', ext: ['txt']}, {name: 'type2', ext: ['exe', 'bat']}]">label</button>}
#'
#' where the id tag matches the inputId parameter, the data-title tag matches
#' the title parameter, the data-selecttype is either "single" or "multiple"
#' (the non-logical form of the multiple parameter) and the internal textnode
#' mathces the label parameter. The data-filetype tag is a bit more involved as
#' it is a json formatted array of objects with the properties 'name' and 'ext'.
#' 'name' gives the name of the filetype as a string and 'ext' the allowed
#' extensions as an array of strings. The non-exported
#' \code{\link{formatDropFiletype}} function can help convert from a named R list
#' into the string representation. In the example above "btn-default" is used as
#' button styling, but this can be changed to any other Bootstrap style.
#'
#' Apart from this the html document should link to a script with the
#' following path 'sF/shinyFiles.js' and a stylesheet with the following path
#' 'sF/styles.css'.
#'
#' The markup is bootstrap compliant so if the bootstrap css is used in the page
#' the look will fit right in. There is nothing that hinders the developer from
#' ignoring bootstrap altogether and designing the visuals themselves. The only
#' caveat being that the glyphs used in the menu buttons are bundled with
#' bootstrap. Use the css ::after pseudoclasses to add alternative content to
#' these buttons. Additional filetype specific icons can be added with css using
#' the following style:
#'
#' \preformatted{
#' .sF-file .sF-file-icon .yourFileExtension{
#' content: url(path/to/16x16/pixel/png);
#' }
#' .sF-fileList.sF-icons .sF-file .sF-file-icon .yourFileExtension{
#' content: url(path/to/32x32/pixel/png);
#' }
#' }
#'
#' If no large version is specified the small version gets upscaled.
#'
#' \strong{Client side events}
#'
#' If the shiny app uses custom Javascript it is possible to react to selections
#' directly from the javascript. Once a selection has been made, the button will
#' fire of the event 'selection' and pass the selection data along with the
#' event. To listen for this event you simple add:
#'
#' \preformatted{
#' $(button).on('selection', function(event, path) {
#' // Do something with the paths here
#' })
#' }
#'
#' in the same way a 'cancel' event is fired when a user dismisses a selection
#' box. In that case, no path is passed on.
#'
#' Outside events the current selection is available as an abject binded to the
#' button and can be accessed at any time:
#'
#' \preformatted{
#' // For a shinyDropFilesButton
#' $(button).data('files')
#'
#' // For a shinyDropDirButton
#' $(button).data('directory')
#'
#' // For a shinyDropSaveButton
#' $(button).data('file')
#' }
#'
#' @param id The id matching the \code{\link{shinyDropFileChoose}}
#'
#' @param label The text that should appear on the button
#'
#' @param title The heading of the dialog box that appears when the button is
#' pressed
#'
#' @param multiple A logical indicating whether or not it should be possible to
#' select multiple files
#'
#' @param buttonType The Bootstrap button markup used to colour the button.
#' Defaults to 'default' for a neutral appearance but can be changed for another
#' look. The value will be pasted with 'btn-' and added as class.
#'
#' @param class Additional classes added to the button
#'
#' @param icon An optional \href{http://shiny.rstudio.com/reference/shiny/latest/icon.html}{icon} to appear on the button.
#'
#' @param filetype A named list of file extensions. The name of each element
#' gives the name of the filetype and the content of the element the possible
#' extensions e.g. \code{list(picture=c('jpg', 'jpeg'))}. The first extension
#' will be used as default if it is not supplied by the user.
#'
#' @return This function is called for its side effects
#'
#' @rdname shinyFilesDropBox-buttons
#' @name shinyFilesDropBox-buttons
#'
#' @family shinyFilesDropBox
#'
#' @references The file icons used in the file system navigator is taken from
#' FatCows Farm-Fresh Web Icons (\url{http://www.fatcow.com/free-icons})
#'
#' @importFrom htmltools tagList singleton tags
#'
#' @export
#'
shinyDropFilesButton <- function(id, label, title, multiple, buttonType='default', class=NULL, icon=NULL) {
tagList(
singleton(tags$head(
tags$script(src='sF/shinyFiles.js'),
tags$link(
rel='stylesheet',
type='text/css',
href='sF/styles.css'
),
tags$link(
rel='stylesheet',
type='text/css',
href='sF/fileIcons.css'
)
)),
tags$button(
id=id,
type='button',
class=paste(c('shinyFiles btn', paste0('btn-', buttonType), class), collapse=' '),
'data-title'=title,
'data-selecttype'=ifelse(multiple, 'multiple', 'single'),
list(icon, label)
)
)
}
#' Convert the output of a selection to platform specific path(s)
#'
#' This function takes the value of a shinyFiles button input variable and
#' converts it to be easier to work with on the server side. In the case of file
#' selections and saving the input variable is converted to a data frame (using
#' \code{parseDropFilePaths()} or \code{parseDropSavePath() respectively}) of the same
#' format as that provided by \code{\link[shiny]{fileInput}}. The only caveat
#' here is that the MIME type cannot be inferred in file selections so this will
#' always be an empty string and new files doesn't have a size so this is left
#' out with file saving. In the case of folder selection the input variable is
#' converted to a string (using \code{parseDropDirPath()}) giving the absolute path
#' to the selected folder.
#'
#' The use of \code{parseDropFilePaths} makes it easy to substitute fileInput and
#' shinyFiles in your code as code that relies on the values of a file selection
#' doesn't have to change.
#'
#' @param roots The path to the root as specified in the \code{shinyDropFileChoose()}
#' call in \code{shinyServer()}
#'
#' @param selection The corresponding input variable to be parsed
#'
#' @return A data frame mathcing the format of \code{\link[shiny]{fileInput}}
#'
#' @examples
#' \dontrun{
#' token = drop_auth(new_user = FALSE, cache=TRUE)
#' ui <- shinyUI(bootstrapPage(
#' shinyDropFilesButton('files', 'File select', 'Please select a file', FALSE),
#' verbatimTextOutput('rawInputValue'),
#' verbatimTextOutput('filepaths')
#'))
#'
#'server <- shinyServer(function(input, output,session) {
#' shinyDropFileChoose(input, 'files',session = session, dtoken =token)
#' output$rawInputValue <- renderPrint({str(input$files)})
#' output$filepaths <- renderPrint({parseDropFilePaths(input$files)})
#' })
#' }
#'
#' @rdname shinyFilesDropBox-parsers
#' @name shinyFilesDropBox-parsers
#'
#' @family shinyFilesDropBox
#'
#' @export
#'
parseDropFilePaths <- function(selection,roots=c(Home="")) {
roots <- if(class(roots) == 'function') roots() else roots
if (is.null(selection) || is.na(selection)) return(data.frame(name=character(0), datapath=character(0),
stringsAsFactors = FALSE))
files <- sapply(selection$files, function(x) {file.path(roots[selection$root], do.call('file.path', x))})
files <- gsub(pattern='//*', '/', files, perl=TRUE)
data.frame(name=basename(files), datapath=files, stringsAsFactors = FALSE)
}
armelmoth/shinyFilesDropBox documentation built on May 17, 2019, 11:14 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @include aaa.R
NULL
#' Get the information about the children's folder
#'
#' This function works with fileGetterFile, fileGetterSave, fileGetterDir functions.
#' When the last needs to get information about a children's folder they call this function, which look into
#' the the children's folder. Mtime of the children's folder is the minimum of all of its mtime files.
#' Atime of the children's folder is the minimum of all of its atime files. Ctime of the children's folder
#' is the minimum of all of its ctime files. The size is a sum of its size files.
#'
#' @param folderPath The path of the children's folder.
#'
#' @param dtoken The Dropbox token generated by drop_auth (package rdrop2).
#'
#' @return returns a list of the size, mtime, atime, and ctime file.
#'
#' @importFrom rdrop2 drop_dir
#'
getInfo = function(folderPath,dtoken){
drop_dir = data.frame()
repeat{
drop_dir = tryCatch(drop_dir(folderPath,dtoken = dtoken),error=function(e) { e })
if(is.data.frame(drop_dir)){
break
}
}
res = list()
if(nrow(drop_dir)==0){
res = list(
mtime = format(Sys.time(), format='%Y-%m-%d-%H-%M'),
ctime = format(Sys.time(), format='%Y-%m-%d-%H-%M'),
atime = format(Sys.time(), format='%Y-%m-%d-%H-%M'),
size = 0
)
}
else{
if (length(drop_dir$.tag[drop_dir$.tag=='file'])==0){
files = drop_dir$path_display
lengthDir = length(files)
infoDir = lapply(as.vector(files), getInfo, dtoken)
res = list(
mtime = min(sapply(1:lengthDir, function (i){infoDir[i][[1]]$mtime}), na.rm = TRUE),
ctime = min(sapply(1:lengthDir, function (i){infoDir[i][[1]]$ctime}), na.rm = TRUE),
atime = min(sapply(1:lengthDir, function (i){infoDir[i][[1]]$atime}), na.rm = TRUE),
size = sum(infoDir$size, na.rm = TRUE)
)
}
else{
fileInfo = data.frame(size=drop_dir$size)
drop_dir$client_modified = chartr(":T", "--", drop_dir$client_modified)
drop_dir$client_modified = gsub("Z","", drop_dir$client_modified)
drop_dir$server_modified = chartr(":T", "--", drop_dir$server_modified)
drop_dir$server_modified = gsub("Z","", drop_dir$server_modified)
res = list(
mtime = min(substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3)), na.rm = TRUE),
ctime = min(substr(drop_dir$server_modified,1,(nchar(drop_dir$server_modified)-3)), na.rm = TRUE),
atime = min(substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3)), na.rm = TRUE),
size = sum(fileInfo$size, na.rm = TRUE)
)
}
}
return(res)
}
#' Create a function that returns fileinfo according to the given restrictions
#'
#' This functions returns a new function that can generate file information to
#' be send to a shiny app based on a path relative to the given root. The
#' function is secure in the sense that it prevents access to files outside of
#' the given root directory as well as to subdirectories matching the ones given
#' in restrictions. Furthermore can the output be filtered to only contain
#' certain filetypes using the filter parameter.
#'
#' @param roots A named vector of absolute filepaths or a function returning a
#' named vector of absolute filepaths (the latter is useful if the volumes
#' should adapt to changes in the filesystem).
#'
#' @param restrictions A vector of directories within the root that should be
#' filtered out of the results
#'
#' @param filetypes A character vector of file extensions (without dot in front
#' i.e. 'txt' not '.txt') to include in the output. Use the empty string to
#' include files with no extension. If not set all file types will be included
#'
#' @param dtoken The Dropbox token generated by drop_auth (package rdrop2).
#'
#' @return A function taking a single path relative to the specified root, and
#' returns a list of files to be passed on to shiny
#'
#' @rdname shinyFilesDropBox-fileGetter
#' @name shinyFilesDropBox-fileGetter
#'
#' @importFrom tools file_ext
#' @importFrom rdrop2 drop_dir drop_exists
#'
fileGetterFile <- function(restrictions, filetypes, session,id,dtoken,roots=c(Home="")) {
if (missing(filetypes)) filetypes <- NULL
if (missing(restrictions)) restrictions <- NULL
function(dir, root) {
session$sendCustomMessage('shinyFilesProgress',list(width = "24",id=id))
currentRoots <- if(class(roots) == 'function') roots() else roots
if (is.null(names(currentRoots))) stop('Roots must be a named vector or a function returning one')
if (is.null(root)) root <- names(currentRoots)[1]
session$sendCustomMessage('shinyFilesProgress',list(width = "24",id=id))
if(substr(dir,1,1)=="/"){
dir = substr(dir,2,nchar(dir))
}
if(substr(dir,nchar(dir),nchar(dir))=="/"){
dir = substr(dir,1,(nchar(dir)-1))
}
fulldir <- file.path(currentRoots[root], dir)
if(substr(fulldir,nchar(fulldir),nchar(fulldir))=="/" & nchar(fulldir)>1){
fulldir = substr(fulldir,1,(nchar(fulldir)-1))
}
session$sendCustomMessage('shinyFilesProgress',list(width = "24",id=id))
drop_dir = data.frame()
repeat{
drop_dir = tryCatch(drop_dir(fulldir,dtoken = dtoken),error=function(e) { e })
if(is.data.frame(drop_dir)){
break
}
}
writable = TRUE
res = list()
drop_exists = FALSE
repeat{
drop_exists = tryCatch(drop_exists(fulldir,dtoken = dtoken),error=function(e) { e })
if(is.logical(drop_exists)){
break
}
}
if(nrow(drop_dir)==0){
session$sendCustomMessage('shinyFilesProgress',list(width = "158",id=id))
breadcrumps <- strsplit(dir, .Platform$file.sep)[[1]]
fileInfo = data.frame(filename=character(0), extension=character(0), isdir=logical(0), size=integer(0), mtime=character(0), ctime=character(0), atime=character(0))
res = list(
files=fileInfo[, c('filename', 'extension', 'isdir', 'size', 'mtime', 'ctime', 'atime')],
writable=writable,
exist = (fulldir == "/") || drop_exists,
breadcrumps=I(c('', breadcrumps[breadcrumps != ''])),
roots=I(names(currentRoots)),
root=root
)
}
if(nrow(drop_dir)>0){
if (length(drop_dir$.tag[drop_dir$.tag=='file'])==0){
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
files = drop_dir$path_display
files <- gsub(pattern='//*', '/', files, perl=TRUE)
lengthDir = length(files)
infoDir = lapply(as.vector(files), getInfo, dtoken)
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
fileInfo = data.frame(filename = basename(files))
fileInfo$size = sapply(1:lengthDir, function (i){infoDir[i][[1]]$size})
fileInfo$mtime= sapply(1:lengthDir, function (i){infoDir[i][[1]]$mtime})
fileInfo$atime= sapply(1:lengthDir, function (i){infoDir[i][[1]]$atime})
fileInfo$ctime= sapply(1:lengthDir, function (i){infoDir[i][[1]]$ctime})
fileInfo$isdir = TRUE
fileInfo$extension = tolower(file_ext(files))
session$sendCustomMessage('shinyFilesProgress',list(width = "102",id=id))
rownames(fileInfo) <- NULL
breadcrumps <- strsplit(dir, .Platform$file.sep)[[1]]
res = list(
files=fileInfo[, c('filename', 'extension', 'isdir', 'size', 'mtime', 'ctime', 'atime')],
writable=writable,
exist = (fulldir == "/") || drop_exists,
breadcrumps=I(c('', breadcrumps[breadcrumps != ''])),
roots=I(names(currentRoots)),
root=root
)
}
if (length(drop_dir$.tag[drop_dir$.tag=='file'])>0){
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
files = drop_dir$path_display
files <- gsub(pattern='//*', '/', files, perl=TRUE)
if (!is.null(restrictions) && length(files) != 0) {
if (length(files) == 1) {
keep <- !any(sapply(restrictions, function(x) {grepl(x, files, fixed=T)}))
} else {
keep <- !apply(sapply(restrictions, function(x) {grepl(x, files, fixed=T)}), 1, any)
}
files <- files[keep]
}
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
fileInfo = data.frame(filename = basename(files))
fileInfo$extension <- tolower(file_ext(files))
drop_dir$client_modified = chartr(":T", "--", drop_dir$client_modified)
drop_dir$client_modified = gsub("Z","", drop_dir$client_modified)
drop_dir$server_modified = chartr(":T", "--", drop_dir$server_modified)
drop_dir$server_modified = gsub("Z","", drop_dir$server_modified)
session$sendCustomMessage('shinyFilesProgress',list(width = "28",id=id))
fileInfo$mtime <- substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3))
fileInfo$ctime <- substr(drop_dir$server_modified,1,(nchar(drop_dir$server_modified)-3))
fileInfo$atime <- substr(drop_dir$client_modified,1,(nchar(drop_dir$client_modified)-3))
session$sendCustomMessage('shinyFilesProgress',list(width = "50",id=id))
fileInfo$isdir = drop_dir$.tag == 'folder'
fileInfo$size = drop_dir$size
lengthIsdir = length(fileInfo$filename[fileInfo$isdir])
session$sendCustomMessage('shinyFilesProgress',list(width = "12",id=id))
if(lengthIsdir > 0){
infoIsdir = lapply(as.vector(drop_dir$path_display[drop_dir$.tag == 'folder']), getInfo,dtoken)
fileInfo$size[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$size})
fileInfo$mtime[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$mtime})
fileInfo$atime[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$atime})
fileInfo$ctime[fileInfo$isdir][1:lengthIsdir] = sapply(1:lengthIsdir, function (i){infoIsdir[i][[1]]$ctime})
}
session$sendCustomMessage('shinyFilesProgress',list(width = "12",id=id))
if (!is.null(filetypes)) {
matchedFiles <- tolower(fileInfo$extension) %in% tolower(filetypes) & fileInfo$extension != ''
fileInfo$isdir[matchedFiles] <- FALSE
fileInfo <- fileInfo[matchedFiles | fileInfo$isdir,]
}
rownames(fileInfo) <- NULL
breadcrumps <- strsplit(dir, .Platform$file.sep)[[1]]
res = list(
files=fileInfo[, c('filename', 'extension', 'isdir', 'size', 'mtime', 'ctime', 'atime')],
writable=writable,
exist = (fulldir == "/") || drop_exists,
breadcrumps=I(c('', breadcrumps[breadcrumps != ''])),
roots=I(names(currentRoots)),
root=root
)
}
}
session$sendCustomMessage('shinyFilesProgress',list(width = "10",id=id))
return(res)
}
}
#' Create a connection to the server side filesystem
#'
#' These function sets up the required connection to the client in order for the
#' user to navigate the filesystem. For this to work a matching button should be
#' present in the html, either by using one of the button generating functions
#' or adding it manually. See \code{\link{shinyFiles-buttons}} for more details.
#'
#' Restrictions on the access rights of the client can be given in several ways.
#' The root parameter specifies the starting position for the filesystem as
#' presented to the client. This means that the client can only navigate in
#' subdirectories of the root. Paths passed of to the \code{restrictions}
#' parameter will not show up in the client view, and it is impossible to
#' navigate into these subdirectories. The \code{filetypes} parameter takes a
#' vector of file extensions to filter the output on, so that the client is
#' only presented with these filetypes. Whenever a file or folder
#' choice is made the resulting files/folder will be accessible in the input
#' variable with the id given in the parameters. This value should probable be
#' run through a call to one of the parser (\code{\link{shinyDropFiles-parsers}}) in
#' order to get well formatted paths to work with.
#'
#' @param input The input object of the \code{shinyServer()} call (usaully
#' \code{input})
#'
#' @param id The same ID as used in the matching call to
#' \code{shinyDropFilesButton} or as the id attribute of the button, in case of a
#' manually defined html. This id will also define the id of the file choice in
#' the input variable
#'
#' @param updateFreq The time in milliseconds between file system lookups. This
#' determines the responsiveness to changes in the filesystem (e.g. addition of
#' files or drives)
#'
#' @param session The session object of the shinyServer call (usually
#' \code{session}).
#'
#' @param defaultRoot The default root to use. For instance if
#' \code{roots = c(Home = '', Home2='/home')} then \code{defaultRoot}
#' can be either \code{'Home'} or \code{'Home2'}.
#'
#' @param defaultPath The default relative path specified given the \code{defaultRoot}.
#'
#' @param dtoken The Dropbox token generated by drop_auth (package rdrop2).
#'
#' @param ... Arguments to be passed on to \code{\link{fileGetterFile}} or
#' \code{\link{dirDropGetter}}
#'
#' @return A reactive observer that takes care of the server side logic of the
#' filesystem connection.
#'
#' @rdname shinyFilesDropBox-observers
#' @name shinyFilesDropBox-observers
#'
#' @examples
#' \dontrun{
#'# File selections
#'token = drop_auth(new_user = FALSE, cache=TRUE)
#' ui <- shinyUI(bootstrapPage(
#' shinyDropFilesButton('files', 'File select', 'Please select a file', FALSE)
#' ))
#' server <- shinyServer(function(input, output,session) {
#' shinyDropFileChoose(input, 'files',session = session, dtoken =token)
#' })
#'
#' runApp(list(
#' ui=ui,
#' server=server
#' ))
#'}
#'
#' @rdname shinyFiles-observers
#' @name shinyFiles-observers
#'
#' @family shinyFilesDropBox
#'
#' @importFrom shiny observe invalidateLater
#'
#' @export
#'
shinyDropFileChoose <- function(input, id, updateFreq=100000, session = getDropSession(),
defaultRoot=NULL, defaultPath='', dtoken, ...) {
clientId = session$ns(id)
fileGet <- do.call('fileGetterFile', list(session=session,id = clientId,dtoken=dtoken,...))
currentDir <- list()
return(observe({
dir <- input[[paste0(id, '-modal')]]
if(is.null(dir) || is.na(dir)) {
dir <- list(dir=defaultPath, root=defaultRoot)
} else {
dir <- list(dir=dir$path, root=dir$root)
}
dir$dir <- do.call(file.path, as.list(dir$dir))
#print(paste("Geting file",id))
newDir <- do.call('fileGet', dir)
#print(paste("File got",id))
session$sendCustomMessage('shinyFilesProgressEnd',list(id=clientId))
if(!identical(currentDir, newDir)) {
currentDir <<- newDir
#print(paste("Dialog box",id))
session$sendCustomMessage('shinyFiles', list(id=clientId, dir=newDir))
#print(paste("Dialog box Done",id))
}
invalidateLater(updateFreq, session)
}))
}
#' Create a button to summon a shinyFiles dialog
#'
#' This function adds the required html markup for the client to access the file
#' system. The end result will be the appearance of a button on the webpage that
#' summons one of the shinyFiles dialog boxes. The last position in the file
#' system is automatically remembered between instances, but not shared between
#' several shinyFiles buttons. For a button to have any functionality it must
#' have a matching observer on the server side. shinyDropFilesButton() is matched
#' with shinyDropFileChoose() and shinyDropDirButton with shinyDropDirChoose(). The id
#' argument of two matching calls must be the same. See
#' \code{\link{shinyFiles-observers}} on how to handle client input on the
#' server side.
#'
#' @details
#' \strong{Selecting files}
#'
#' When a user selects one or several files the corresponding input variable is
#' set to a list containing a character vector for each file. The character
#' vectors gives the traversal route from the root to the selected file(s). The
#' reason it does not give a path as a string is that the client has no
#' knowledge of the file system on the server and can therefore not ensure
#' proper formatting. The \code{\link{parseDropFilePaths}} function can be used on
#' the server to format the input variable into a format similar to that
#' returned by \code{\link[shiny]{fileInput}}.
#'
#' \strong{Selecting folders}
#'
#' When a folder is selected it will also be available in its respective input
#' variable as a list giving the traversal route to the selected folder. To
#' properly format it, feed it into \code{\link{parseDirPath}} and a string with
#' the full folder path will be returned.
#'
#' \strong{Creating files (saving)}
#'
#' When a new filename is created it will become available in the respective
#' input variable and can be formatted with \code{\link{parseSavePath}} into a
#' data.frame reminiscent that returned by fileInput. There is no size column
#' and the type is only present if the filetype argument is used in
#' \code{shinySaveButton}. In that case it will be the name of the chosen type
#' (not the extension).
#'
#' \strong{Manual markup}
#'
#' For users wanting to design their html markup manually it is very easy to add
#' a shinyFiles button. The only markup required is:
#'
#' \emph{shinyDropFilesButton}
#'
#' \code{<button id="inputId" type="button" class="shinyFiles btn btn-default" data-title="title" data-selecttype="single"|"multiple">label</button>}
#'
#' \emph{shinyDropDirButton}
#'
#' \code{<button id="inputId" type="button" class="shinyDirectories btn-default" data-title="title">label</button>}
#'
#' \emph{shinyDropSaveButton}
#'
#' \code{<button id="inputId" type="button" class="shinySave btn-default" data-title="title" data-filetype="[{name: 'type1', ext: ['txt']}, {name: 'type2', ext: ['exe', 'bat']}]">label</button>}
#'
#' where the id tag matches the inputId parameter, the data-title tag matches
#' the title parameter, the data-selecttype is either "single" or "multiple"
#' (the non-logical form of the multiple parameter) and the internal textnode
#' mathces the label parameter. The data-filetype tag is a bit more involved as
#' it is a json formatted array of objects with the properties 'name' and 'ext'.
#' 'name' gives the name of the filetype as a string and 'ext' the allowed
#' extensions as an array of strings. The non-exported
#' \code{\link{formatDropFiletype}} function can help convert from a named R list
#' into the string representation. In the example above "btn-default" is used as
#' button styling, but this can be changed to any other Bootstrap style.
#'
#' Apart from this the html document should link to a script with the
#' following path 'sF/shinyFiles.js' and a stylesheet with the following path
#' 'sF/styles.css'.
#'
#' The markup is bootstrap compliant so if the bootstrap css is used in the page
#' the look will fit right in. There is nothing that hinders the developer from
#' ignoring bootstrap altogether and designing the visuals themselves. The only
#' caveat being that the glyphs used in the menu buttons are bundled with
#' bootstrap. Use the css ::after pseudoclasses to add alternative content to
#' these buttons. Additional filetype specific icons can be added with css using
#' the following style:
#'
#' \preformatted{
#' .sF-file .sF-file-icon .yourFileExtension{
#' content: url(path/to/16x16/pixel/png);
#' }
#' .sF-fileList.sF-icons .sF-file .sF-file-icon .yourFileExtension{
#' content: url(path/to/32x32/pixel/png);
#' }
#' }
#'
#' If no large version is specified the small version gets upscaled.
#'
#' \strong{Client side events}
#'
#' If the shiny app uses custom Javascript it is possible to react to selections
#' directly from the javascript. Once a selection has been made, the button will
#' fire of the event 'selection' and pass the selection data along with the
#' event. To listen for this event you simple add:
#'
#' \preformatted{
#' $(button).on('selection', function(event, path) {
#' // Do something with the paths here
#' })
#' }
#'
#' in the same way a 'cancel' event is fired when a user dismisses a selection
#' box. In that case, no path is passed on.
#'
#' Outside events the current selection is available as an abject binded to the
#' button and can be accessed at any time:
#'
#' \preformatted{
#' // For a shinyDropFilesButton
#' $(button).data('files')
#'
#' // For a shinyDropDirButton
#' $(button).data('directory')
#'
#' // For a shinyDropSaveButton
#' $(button).data('file')
#' }
#'
#' @param id The id matching the \code{\link{shinyDropFileChoose}}
#'
#' @param label The text that should appear on the button
#'
#' @param title The heading of the dialog box that appears when the button is
#' pressed
#'
#' @param multiple A logical indicating whether or not it should be possible to
#' select multiple files
#'
#' @param buttonType The Bootstrap button markup used to colour the button.
#' Defaults to 'default' for a neutral appearance but can be changed for another
#' look. The value will be pasted with 'btn-' and added as class.
#'
#' @param class Additional classes added to the button
#'
#' @param icon An optional \href{http://shiny.rstudio.com/reference/shiny/latest/icon.html}{icon} to appear on the button.
#'
#' @param filetype A named list of file extensions. The name of each element
#' gives the name of the filetype and the content of the element the possible
#' extensions e.g. \code{list(picture=c('jpg', 'jpeg'))}. The first extension
#' will be used as default if it is not supplied by the user.
#'
#' @return This function is called for its side effects
#'
#' @rdname shinyFilesDropBox-buttons
#' @name shinyFilesDropBox-buttons
#'
#' @family shinyFilesDropBox
#'
#' @references The file icons used in the file system navigator is taken from
#' FatCows Farm-Fresh Web Icons (\url{http://www.fatcow.com/free-icons})
#'
#' @importFrom htmltools tagList singleton tags
#'
#' @export
#'
shinyDropFilesButton <- function(id, label, title, multiple, buttonType='default', class=NULL, icon=NULL) {
tagList(
singleton(tags$head(
tags$script(src='sF/shinyFiles.js'),
tags$link(
rel='stylesheet',
type='text/css',
href='sF/styles.css'
),
tags$link(
rel='stylesheet',
type='text/css',
href='sF/fileIcons.css'
)
)),
tags$button(
id=id,
type='button',
class=paste(c('shinyFiles btn', paste0('btn-', buttonType), class), collapse=' '),
'data-title'=title,
'data-selecttype'=ifelse(multiple, 'multiple', 'single'),
list(icon, label)
)
)
}
#' Convert the output of a selection to platform specific path(s)
#'
#' This function takes the value of a shinyFiles button input variable and
#' converts it to be easier to work with on the server side. In the case of file
#' selections and saving the input variable is converted to a data frame (using
#' \code{parseDropFilePaths()} or \code{parseDropSavePath() respectively}) of the same
#' format as that provided by \code{\link[shiny]{fileInput}}. The only caveat
#' here is that the MIME type cannot be inferred in file selections so this will
#' always be an empty string and new files doesn't have a size so this is left
#' out with file saving. In the case of folder selection the input variable is
#' converted to a string (using \code{parseDropDirPath()}) giving the absolute path
#' to the selected folder.
#'
#' The use of \code{parseDropFilePaths} makes it easy to substitute fileInput and
#' shinyFiles in your code as code that relies on the values of a file selection
#' doesn't have to change.
#'
#' @param roots The path to the root as specified in the \code{shinyDropFileChoose()}
#' call in \code{shinyServer()}
#'
#' @param selection The corresponding input variable to be parsed
#'
#' @return A data frame mathcing the format of \code{\link[shiny]{fileInput}}
#'
#' @examples
#' \dontrun{
#' token = drop_auth(new_user = FALSE, cache=TRUE)
#' ui <- shinyUI(bootstrapPage(
#' shinyDropFilesButton('files', 'File select', 'Please select a file', FALSE),
#' verbatimTextOutput('rawInputValue'),
#' verbatimTextOutput('filepaths')
#'))
#'
#'server <- shinyServer(function(input, output,session) {
#' shinyDropFileChoose(input, 'files',session = session, dtoken =token)
#' output$rawInputValue <- renderPrint({str(input$files)})
#' output$filepaths <- renderPrint({parseDropFilePaths(input$files)})
#' })
#' }
#'
#' @rdname shinyFilesDropBox-parsers
#' @name shinyFilesDropBox-parsers
#'
#' @family shinyFilesDropBox
#'
#' @export
#'
parseDropFilePaths <- function(selection,roots=c(Home="")) {
roots <- if(class(roots) == 'function') roots() else roots
if (is.null(selection) || is.na(selection)) return(data.frame(name=character(0), datapath=character(0),
stringsAsFactors = FALSE))
files <- sapply(selection$files, function(x) {file.path(roots[selection$root], do.call('file.path', x))})
files <- gsub(pattern='//*', '/', files, perl=TRUE)
data.frame(name=basename(files), datapath=files, stringsAsFactors = FALSE)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.