Nothing
#' @importFrom rcrossref cr_works
.suppdata.pub <- function(x){
if(!is.character(x))
stop("'x' must be a character")
#Doing the check here saves one internet call
if(grepl("figshare", x))
return("figshare")
if(grepl("dryad", x))
return("dryad")
pub <- rcrossref::cr_works(x)$data
if(length(pub) < 1)
stop("Cannot find publisher for DOI: ", x)
if(pub$prefix == "http://id.crossref.org/prefix/10.0000")
stop("Cannot find publisher for DOI: ", x)
return(.grep.text(pub$member, "[0-9]+"))
}
.suppdata.func <- function(x) {
#Check by code, return if found
output <- switch(x,
"340" = .suppdata.plos,
"311" = .suppdata.wiley,
"221" = .suppdata.science,
"175" = .suppdata.proceedings,
"246" = .suppdata.biorxiv,
"4443" = .suppdata.peerj,
"3145" = .suppdata.copernicus,
"1968" = .suppdata.mdpi,
"7893" = .suppdata.jstatsoft
)
if(!is.null(output))
return(output)
#Check by letter code
output <- switch(x,
"plos" = .suppdata.plos,
"wiley" = .suppdata.wiley,
"science" = .suppdata.science,
"proceedings" = .suppdata.proceedings,
"figshare" = .suppdata.figshare,
"biorxiv" = .suppdata.biorxiv,
"epmc" = .suppdata.epmc,
"dryad" = .suppdata.dryad,
"peerj" = .suppdata.peerj,
"copernicus" = .suppdata.copernicus,
"mdpi" = .suppdata.mdpi,
"jstatsoft" = .suppdata.jstatsoft
)
#If all else fails, try EPMC
if(is.null(output))
output <- .suppdata.epmc
return(output)
}
# Internal regexp functions
.grep.url <- function(url, regexp, which=1){
html <- as.character(GET(url))
return(.grep.text(html, regexp, which))
}
.grep.text <- function(text, regexp, which=1){
links <- gregexpr(regexp, text)
if(which > length(links[[1]]))
stop(
"SI number '", which, "' greater than number of detected SIs (",
length(links[[1]]), ")"
)
pos <- as.numeric(links[[1]][which])
return(substr(text, pos, pos+attr(links[[1]], "match.length")[which]-1))
}
.file.suffix <- function(text, max.length=4){
suffix <- .grep.text(text, "[a-zA-Z]+$")
if(nchar(suffix) <= max.length & nchar(suffix) > 0)
return(suffix)
return(NA)
}
# Internal download function
#' @importFrom utils download.file
.download <- function(url, dir, save.name, cache=TRUE, suffix=NULL, zip=FALSE){
destination <- file.path(dir, save.name)
if(is.null(suffix))
suffix <- .file.suffix(url, 5)
if(cache==TRUE & file.exists(destination)){
if(!is.na(suffix))
attr(destination, "suffix") <- suffix
return(destination)
}
# Must download zips *manually* in binary mode, or Windows machines will error
if(zip){
result <- download.file(url, destination, quiet=TRUE, mode="wb")
} else {
result <- download.file(url, destination, quiet=TRUE)
}
if(result != 0)
stop("Error code", result, " downloading file;", url, "may not exist")
if(!is.na(suffix))
attr(destination, "suffix") <- suffix
return(destination)
}
# Internal unzip function
#' @importFrom utils unzip
.unzip <- function(zip, dir, save.name, cache, si, list=FALSE){
files <- unzip(zip, list=TRUE)
if(list){
cat("Files in ZIP:")
print(files)
}
if(!si %in% files$Name)
stop("Required file not in zipfile ", zip)
file <- unzip(zip, si)
file.rename(file, file.path(dir, save.name))
suffix <- .file.suffix(si, 5)
output <- file.path(dir, save.name)
if(!is.na(suffix))
attr(output, "suffix") <- suffix
return(output)
}
# Internal URL 'redirect' function
.url.redir <- function(x)
return(GET(x)$url)
.tmpdir <- function(dir){
if(!is.na(dir)){
if(!file.exists(dir))
stop("'dir' must exist unless NA")
} else dir <- tempdir()
return(dir)
}
.save.name <- function(doi, save.name, file){
if(is.na(save.name)){
save.name <- paste(doi,file, sep="_")
save.name <- gsub(.Platform$file.sep, "_", save.name, fixed=TRUE)
}
return(save.name)
}
#Expanding arguments when handling ft-classes
.fix.param <- function(x, param, name){
if(length(x) != length(param)){
if((length(x) %% length(param)) != 0)
stop("length of ", name, " (", length(param),
") is incompatible with 'x' (", length(x), ")")
param <- rep(param, length(x))
}
return(param)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.