#' A Web and Library Data-Loading Facility
#'
#' \code{fetchData} provides a means for students and others to
#' locate and load data sets and R commands provided by instructors.
#' Data can be pre-loaded for off-line sessions, can be positioned
#' on identified web sites, or loaded from packages.
#' \code{fetchData} also will load local files using a complete path name (relative
#' to the current working directory) or, if no name is given, via a dialog box.
#'
#' @param name a character string naming a data set.
#' This will often end in \code{.csv} for reading in a data set.
#' If it ends in \code{.r} or \code{.R}, the file will be "sourced".
#' @param show.path If \code{TRUE}, causes the current search path to be returned
#' @param add.to.path Name of a web directory (ending in \code{/}), which
#' should be pre-pended to the search path.
#'
#' @param drop.from.path Name of a web directory to be deleted from the path.
#' @param cache If \code{TRUE}, indicates that a data set is to be pre-loaded
#' into the cached library. This allows,
#' for instance, users to pre-load on-line data to be used when they are off-line.
#' @param verbose a logical indicating whether additional status messages (e.g., indicating
#' where the dataset was located) should be printed.
#'
#'
#' @details
#' There are two major purposes for this function. One is to provide a
#' consistent interface to reading data: a file name is given and a data frame is
#' returned, which can be assigned to an object as the user desires. This
#' differs from the behavior of \code{data}, which doesn't return a value but
#' instead creates an object without explicit assignment.
#'
#' The other purpose is to allow instructors or other group leaders to post data
#' and R code on
#' web sites that can be searched as naturally as if the data were on the users'
#' own machines. For instance, an instructor might want to post a new data set
#' just before class, enabling her students to access it in class.
#'
#' To support this, \code{fetchData} allows new web sites to be added to the
#' web search path. Typically, the command to add a site would be in a script
#' file that is provided to the student that could be run automatically at start
#' up or \code{source}d over the web. That is, an instructor might create a
#' script file stored on a website and, using a web page, provide students with
#' the text of the command to \code{source} it.
#'
#' Currently, https addresses are changed to http
#'
#' @return a data frame.
#'
#' @export
#' @examples
#' \dontrun{dome <- fetchData("Dome.csv")}
#' \dontrun{carbon <- fetchData("CO2")}
#' \dontrun{fetchData(show=TRUE)}
#' \dontrun{fetchData(add.to.path="http://www.macalester.edu/~kaplan/ISM/datasets/")}
#' \dontrun{fetchData(drop.from.path="http://www.macalester.edu/~kaplan/ISM/datasets/") }
#' \dontrun{dome <- fetchData("Dome.csv", cache=TRUE)}
#' @keywords util
#'
fetchData <- function(name=NULL,show.path=FALSE,
add.to.path = NULL, drop.from.path = NULL,
cache = FALSE, verbose = TRUE) {
# Deal with lack of https support
if( !is.null(name)) name <- .https2http(name)
# Handle various actions
if(show.path) return( get("path",envir=.fetchEnvironment))
if(!is.null(add.to.path)) {
.fetchStorage(add=.https2http(add.to.path))
return( fetchData(show.path=TRUE) )
}
if(!is.null(drop.from.path)) {
.fetchStorage(drop=.https2http(drop.from.path))
return( fetchData(show.path=TRUE) )
}
## Get the data
file.found <- FALSE
look.for.name <- FALSE
## Is it a request to search on the local computer?
if (!file.found && is.null(name) ) {
name = file.choose()
look.for.name <- TRUE
}
## What should we do when we find it?
action <- .fileTypeAction(name)
## Check the data sets in packages
if( !file.found ) {
suppressWarnings( data(name) )
if (exists(name)) {
val = get(name)
if(verbose) message(paste("Data",name,"found in package."))
file.found <- TRUE
}
}
## Is the name complete enough to work on its own.
if( !file.found ) {
val <- action(name)
if( !is.null(val) ) {
if( !look.for.name )
if(verbose) message("Complete file name given. No searching necessary.")
file.found <- TRUE
}
}
## Is it a URL
if (!file.found && .isURL(name)) {
val <- action(name)
file.found <- TRUE
}
## Check the current directory
if (!file.found) {
if( length(ls(pattern=name))>0 ) {
if(verbose) message("File found in current working directory.")
val <- action(name)
file.found <- TRUE
}
}
## Check the library
if( !file.found ) {
val <- .checkLibrary(name)
if( !is.null(val) ) {
file.found <- TRUE
if(verbose) message("Data found in mosaic cache.")
}
}
## Look through web sites on the path
if( !file.found ) {
path <- fetchData(show.path=TRUE)
for (k in path) {
location <- paste(k, name, sep="")
val <- action(location)
if( !is.null(val)) {
if (verbose) message(paste("Retrieving from", location))
file.found <- TRUE
break
}
}
}
if( !file.found )
stop("Can't locate file ",name)
## Did we want to cache it?
if (cache & !is.null(val)) {
.fetchStorage(cache=TRUE, name=name, val=val )
message("Caching data.")
}
return(val)
}
#' @rdname fetchData
#' @keywords mosaic
#' @keywords internel
.fetchEnvironment <- new.env()
# initialize the storage environment
assign( "data.library", list(), envir=.fetchEnvironment)
assign( "path", c("http://www.mosaic-web.org/go/datasets/"), envir=.fetchEnvironment)
.fetchStorage <- function(...){
dots <- list(...)
if( "add" %in% names(dots) ) {
path <- get("path", envir=.fetchEnvironment)
assign("path", c(path, dots[["add"]]), envir=.fetchEnvironment)
}
if( "drop" %in% names(dots) ) {
path <- get("path", envir=.fetchEnvironment)
to.be.dropped <- dots[["drop"]]
ind <- which( to.be.dropped == path )
if (length(ind) == 0 )
warning(paste("Path", to.be.dropped, "not found in search path:", paste(path,collapse=":")))
else {
path <- path[-ind]
assign("path", path, envir=.fetchEnvironment)
}
}
if( "cache" %in% names(dots) ) {
# cache is true. name contains name, val contains data
if (!("name" %in% names(dots) && "val" %in% names(dots))) # should never get here
stop("Must provide arguments <name> and <val> when caching.")
lib <- get("data.library", envir=.fetchEnvironment)
lib[[ dots[["name"]] ]] <- dots[["val"]]
assign("data.library", lib, envir=.fetchEnvironment)
}
}
.checkLibrary <- function(name){
lib <- get("data.library", envir=.fetchEnvironment)
if( name %in% names(lib) ) return(lib[[name]])
else return(NULL)
}
.loadWorkspace <- function(name) { stop("Not yet implemented.")}
.read.csv <- function(name) {
res <- try( suppressWarnings(read.csv( name )), silent=TRUE )
if( is.null(res) | class(res)=="try-error" ) return(NULL)
else return(res)
}
.source.file <- function(name){
res <- try( suppressWarnings(source( name )), silent=TRUE )
if( is.null(res) | class(res)=="try-error" ) return(NULL)
else return(TRUE)
}
# What to do with various file types
.fileTypeAction <- function(name) {
matches <- function(pattern) { length( grep(pattern,name)) > 0 }
if( matches(".r$|.R$") ) return( .source.file )
if( matches(".csv$|.CSV$") ) return( .read.csv )
if( matches(".Rdata$|.rdata$|.rda$|.RDA$")) return( .loadWorkspace )
return(read.csv) # default
}
.isURL <- function(name) {length( grep("^http|^https|^ftp", name)) > 0}
.https2http <- function(name) sub("^https","http",name)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.