Nothing
#' Coerce to a BibEntry object
#'
#' Functions to check if an object is a BibEntry, or coerce it if possible.
#'
#' @param x any \code{R} object.
#' @details \code{as.BibEntry} is able to coerce suitably formatted character
#' vectors, \code{\link{bibentry}} objects, lists,
#' and data.frames to BibEntry objects. See the examples.
#' @note Each entry to be coerced should have a bibtype, key, and all required
#' fields for the specified bibtype.
#' @return \code{as.BibEntry} - if successful, an object of class BibEntry.
#' @aliases is.BibEntry
#' @keywords utilities
#' @export
#' @seealso \code{\link{BibEntry}}
#' @examples
#' if (requireNamespace("bibtex")) {
#' file.name <- system.file("Bib", "biblatexExamples.bib", package="RefManageR")
#' bib <- suppressMessages(ReadBib(file.name))[[20:21]]
#' identical(as.BibEntry(unlist(bib)), bib) ## see also RelistBibEntry
#'
#' identical(as.BibEntry(unclass(bib)), bib)
#'
#' identical(as.BibEntry(as.data.frame(bib)), bib)
#' }
#'
#' bib <- c(bibtype = "article", key = "mclean2014", title = "My New Article",
#' author = "Mathew W. McLean", journaltitle = "The Journal", date = "2014-01")
#' as.BibEntry(bib)
#'
#' bib <- bibentry(bibtype = "article", key = "mclean2014", title = "My New Article",
#' journal = "The Journal", year = 2014, author = "Mathew W. McLean")
#' print(bib, .bibstyle = "JSS")
#' as.BibEntry(bib)
#'
#' bib <- list(c(bibtype = "article", key = "mclean2014a", title = "My New Article",
#' author = "Mathew W. McLean", journaltitle = "The Journal", date = "2014-01"),
#' c(bibtype = "article", key = "mclean2014b", title = "Newer Article",
#' author = "Mathew W. McLean", journaltitle = "The Journal", date = "2014-02"))
#' as.BibEntry(bib)
as.BibEntry <- function(x){
if (!length(x))
return(x)
if (inherits(x, 'BibEntry')){
class(x) <- c('BibEntry', 'bibentry')
}else if (inherits(x, 'bibentry')){
att <- attributes(x)
x <- lapply(unclass(x), function(y){
attr(y, "dateobj") <- ProcessDates(y)
if (!length(attr(y, "key")))
attr(y, "key") <- CreateBibKey(y[['title']], y[['author']], y[['year']])
check <- try(.BibEntryCheckBibEntry1(y), TRUE)
if (inherits(check, 'try-error')){
message(gettextf('Ignoring entry titled %s because %s',
dQuote(y[['title']]),
strsplit(check, '\\n[[:space:]]*')[[1]][2]))
return(NULL)
}
y
})
x <- x[!vapply(x, is.null, FALSE)]
if (length(x)){
attributes(x) <- att
class(x) <- c('BibEntry', 'bibentry')
}
}else if (is.character(x)){
if (is.na(x['bibtype']) || is.na(x['key']))
stop("Object of class character must have entries named bibtype and key.")
x <- as.list(x)
attr(x, 'entry') <- x$bibtype
attr(x, 'key') <- x$key
x$bibtype <- NULL
x$key <- NULL
x <- MakeBibEntry(x, FALSE)
}else if(is.data.frame(x)){
.fields <- colnames(x)
if (is.null(x$bibtype))
stop("data.frame must have column for 'bibtype'.")
keys <- rownames(x)
if (keys[1L] == '1')
warning('rownames of data.frame not meaningful for creating keys')
y <- vector('list', length(x))
for (i in seq_len(nrow(x))){
na.ind <- which(!is.na(x[i, ]))
y[[i]] <- as.BibEntry(c(setNames(as.character(x[i, na.ind]),
.fields[na.ind]), key = keys[i]))
}
y <- MakeCitationList(y)
return(y)
}else if(is.list(x)){
if(length(x) == 1L && !is.null(attr(x, 'bibtype'))){
class(x) <- c('BibEntry', 'bibentry')
}else if (!is.null(x$dateobj)){ # x has been unlist'ed
x <- RelistBibEntry(x)
}else if (!is.null(attr(x[[1L]], 'bibtype'))){ # x simply unclass'ed
class(x) <- c('BibEntry', 'bibentry')
}else{
if (length(x[[1L]]) == 1L){
x <- do.call(BibEntry, x)
}else{
x <- lapply(x, function(...) do.call(BibEntry, as.list(...)))
x <- do.call("c", x) # class(x) <- c("BibEntry", "bibentry")
}
}
}else{
classes <- paste(class(x), collapse = ", ")
stop(gettextf("Cannot coerce object of class %s to BibEntry",
sQuote(classes)))
}
x <- MakeKeysUnique(x)
return(x)
}
#' @rdname as.BibEntry
#' @return \code{is.BibEntry} - logical; \code{TRUE} if \code{x} is a BibEntry
#' object.
#' @export
is.BibEntry <- function(x){
inherits(x, "BibEntry")
}
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.