Nothing
## out$regdate <- format(x@regdate, "%Y-%m-%d")
## out$regtime = format(x@regdate, "%H:%M:%S")
## out$regdatetime = format(x@regdate, "%Y-%m-%dT%H:%M:%SZ")
noflat = c("codeinfo", "object", "fullcodeinfo")
listRecToFeatureSet = function(lst) {
clsdef = getClass(lst$fsetklass)
slts = getSlots(clsdef)
sltpres = names(slts) [ names(slts) %in% names(lst)]
## "missing" values go to NA_character
lst[sapply(lst, is.null)] = NA_character_
## slots go in as characters unless they are "AsIs in which case
## the values don't go in at all
lst[sltpres] = lapply(sltpres, function(x) {if(is(lst[[x]], "AsIs")) character() else lst[[x]]})
## fix up time issues
if(!is.null(lst$regdatetime) && is(lst$regdatetime, "POSIXct"))
lst$regdate = lst$regdatetime
else if(!is.null(lst$regdatetime))
lst$regdate = as.POSIXct(strptime(lst$regdatetime, "%Y-%m-%dT%H:%M:%SZ" ))
else if(!is.null(lst$regdate) && is(lst$regdate, "character"))
lst$regdate = as.POSIXct(strptime(lst$regdate, "%Y-%m-%dT%H:%M:%SZ" ))
toflat = setdiff(names(slts), c(names(lst), noflat))
for(sl in toflat) {
lst = unflattenField(lst, sl)
}
lst$codeinfo = getInputs(parseCode(lst$code))
## non-slot list elemenst will go into the extramdata slot which
## is handled specially in both directions
nonslots = names(lst)[!names(lst) %in% names(slts)]
## grab then clear non-slot list elements and put them into lst$extramdata
nonsltlist = lst[nonslots]
lst[nonslots] = NULL
lst$extramdata = nonsltlist
lst$provtable = hydrateProvTable(lst$provtable)
lst$object = NULL
## by this time, we've created the extramdata element so that gets
## correctly included here
ret = do.call(new, c(Class = lst$fsetklass,
lst[names(lst) %in% names(slts)]))
objCode(ret) = paste(as.character(lst$code), collapse="\n")
ret
}
hydrateProvTable = function(json) {
df = fromJSON(json)
if(!is.data.frame(df))
df = as.data.frame(df, stringsAsFactors = FALSE)
prefix = gsub("^([^:]+):.*", "\\1", df$outputvarhash[1])
df$outputvarhash = gsub("^[^:]+:", "", df$outputvarhash)
## this should work fine even for ""
df$inputvarhash = gsub("^[^:]+:", "", df$inputvarhash)
new("ProvStoreDF", hashprefix = prefix, provdata = df)
}
norecurse = c("varnames", "varsummaries", "varclasses", "na", ## for na.rm
"codeinfo", "fullcodeinfo", "outputids", "chunks",
"sessioninfo"
)
## we "flattened" by splitting nesting levels by ".", so we undo that here
## we have some special cases we have to handle where recursion shouldn't
## happen
unflattenField = function(lst, sl, recursive=TRUE) {
pattern = sprintf("^%s\\.", sl)
elinds = grep(pattern, names(lst))
if(!length(elinds))
return(lst)
els = lst[elinds]
lst = lst[-elinds]
names(els) = gsub(pattern, "", names(els))
if(recursive && !(sl %in% norecurse) ) {
subpat = "^([^\\.]+)\\..*"
torecurse = grep(subpat, names(els), value=TRUE)
sls = unique(gsub(subpat, "\\1", setdiff(torecurse, norecurse)))
for(nm in sls) {
els = unflattenField(els, nm)
}
}
## ugh, special casing. Terrible.
if(sl == "na" && identical(names(els), "rm"))
lst[["na.rm"]] = els[[1]]
else
lst[[sl]] = els
lst
}
##' @title Generate a (switchr) Seed Manifest from a Record
##' @description Extracts the session info information within the
##' record and uses it to generate a switchr manifest which can be
##' used to reinstall exact versions of the R packages associated
##' with the result
##' @param lst The record in the form of a list (eg an element of the
##' list returned by findRecords
##' @return A switchr SessionManifest object
##' @export
manifestFromRecord = function(lst) {
if(!requireNamespace("switchr"))
stop("Unable to generate package manifest without the switchr package")
stopifnot(is(lst, "list"),
all(c("sessioninfo.otherPkgs",
"sessioninfo.loadedOnly") %in%
names(lst))
)
pkgs = c(lst$sessioninfo.otherPkgs, lst$sessioninfo.loadedOnly)
pkgswvers = as.data.frame(do.call(rbind, strsplit(pkgs, ":")),
stringsAsFactors = FALSE)
names(pkgswvers) = c("name", "version")
switchr::makeSeedMan(pkgswvers)
}
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.