Nothing
#' Add an empty cluster to a metadata object
#'
#' @param m A metadata object
#' @return A metadata object with an empty additional cluster
#' @examples
#' require(MASS)
#' m <- new("metadata.metric",
#' clusters = list(c1 = list(n = 25, mu = c(4,5), Sigma=diag(1,2)),
#' c2 = list(n = 25, mu = c(-1,-2), Sigma=diag(1,2))),
#' genfunc = mvrnorm)
#' m2 <- addCluster(m)
#' @export
addCluster <- function(m){
prev <- length(m@clusters)
new <- paste("cl", prev + 1, sep="")
eval(parse(text=(paste("m@clusters$", new, " <- formals(m@genfunc)", sep=""))))
return(m)
}
#' Delete a cluster from a metadata object
#'
#' @param m A metadata object
#' @param clnumber The cluster to delete
#' @return A metadata object
#' @examples
#' require(MASS)
#' m <- new("metadata.metric",
#' clusters = list(c1 = list(n = 25, mu = c(4,5), Sigma=diag(1,2)),
#' c2 = list(n = 25, mu = c(-1,-2), Sigma=diag(1,2))),
#' genfunc = mvrnorm)
#' m2 <- deleteCluster(m, 2)
#' @export
deleteCluster <- function(m, clnumber){
m@clusters <- m@clusters[-clnumber]
l <- length(names(m@clusters))
names(m@clusters) <- paste("cl", 1:l, sep="")
return(m)
}
#' Initialize a new metadata object
#'
#' @param type The data type for the new object
#' @param k Number of clusters
#' @param genfunc The distribution function for data generation
#' @param seed The random number seed parameters for the data generation
#' @return A metadata object
#' @examples
#' require(MASS)
#' initializeObject(type = "metric", k = 3, genfunc = mvrnorm)
#' @export
#' @importFrom methods new
initializeObject <- function(type, k, genfunc, seed = list(100,
paste(R.version$major, R.version$minor, sep = "."),
RNGkind())){
if(type == "metric") type <- "metadata.metric"
if(type == "functional") type <- "metadata.functional"
if(type == "ordinal") type <- "metadata.ordinal"
if(type == "binary") type <- "metadata.binary"
if(type == "randomstring") type <- "metadata.randomstring"
cl <- paste("cl", 1:k, sep="")
clusters <- list()
clusters <- sapply(cl,function(x) NULL)
clusters <- lapply(clusters, function(x) formals(genfunc))
new(type, clusters=clusters, seedinfo=seed, genfunc=genfunc)
}
#' Saves a list of metadata objects to a new setup file
#'
#' @param name The name of the new setup (and thus also the filename)
#' @param author Full name of the author
#' @param mail Contact e-mail address of the author
#' @param inst Institution of the author
#' @param cit Reference to the publication where the setup was used, defaults to unpublished
#' @param objects List of metadata objects
#' @param table Info table for the setup
#' @param seedinfo Random number generator parameters for the data sets
#' @param metaseedinfo Random number generator parameters for the metadata
#' @param custom_funcs Custom functions that are needed to generate the meta(data)
#' @param custom_name Custom filename that deviates from the authorYear format
#' @return A .R file that can be processed by \code{create.dataset}
#' @examples
#' require(MASS)
#' a = new("metadata.metric",
#' clusters = list(c1 = list(n = 25, mu = c(4,5), Sigma=diag(1,2)),
#' c2 = list(n = 25, mu = c(-1,-2), Sigma=diag(1,2))),
#' genfunc = mvrnorm)
#' b = new("metadata.metric",
#' clusters = list(c1 = list(n = 44, mu = c(1,2), Sigma=diag(1,2)),
#' c2 = list(n = 66, mu = c(-5,-6), Sigma=diag(1,2))),
#' genfunc = mvrnorm)
#' \dontrun{
#' saveSetup(name="doe2002.R", author="John Dow", mail="john.doe@edu.com",
#' inst="Example University", cit="Simple Data, pp. 23-24", objects=list(a, b),
#' table=data.frame(n = c(50, 110), k = c(2,2), shape = c("spherical", "spherical")))
#' unlink("doe2002.R")
#' }
#' @export
saveSetup <- function(name, author, mail, inst,
cit = "Unpublished", objects, table,
seedinfo = list(100,
paste(R.version$major, R.version$minor, sep = "."),
RNGkind()),
metaseedinfo = list(100,
paste(R.version$major, R.version$minor, sep = "."),
RNGkind()),
custom_funcs = NULL, custom_name = NULL){
if(is.null(custom_name))
newname <- paste(strsplit(name, ".R")[[1]], ".R", sep="")
else
newname <- custom_name
funcname <- strsplit(name, ".R")[[1]]
file.create(newname)
cat("# Simulation setup file generated by \n \n", file = newname)
cat(paste("# ", author, "\n", "# ", mail, "\n", "# ", inst, "\n \n", sep = ""), file = newname, append = T)
cat(paste(c(funcname, " <- function(setnr = NULL, seedinfo = ", capture.output(dput(seedinfo)), ", metaseedinfo = ", capture.output(dput(metaseedinfo)),", info = F) { \n \n"), sep=""), file=newname, append=T)
infotable <- capture.output(dput(table))
cat(paste(" infotable <- ", infotable[1], "\n", sep = ""), file = newname, append=T)
cat(paste(" ", infotable[-1], "\n", sep = ""), file = newname, append=T)
cat("\n", file = newname, append=T)
cat(paste(" reference <- ", strsplit(capture.output(cit), "] ")[[1]][2], "\n \n", sep = ""), file = newname, append=T)
cat(paste(" if(info == T) return(list(summary=infotable, reference=reference)) \n \n"), file = newname, append=T)
objlength <- length(objects)
cat(" if(is.null(metaseedinfo)) metaseedinfo <- seedinfo \n \n", file=newname, append=T)
cat(" # For a specified seed and setnr, return the respective metadata object \n \n", file = newname, append=T)
cat(paste(" set.seed(", metaseedinfo[[1]], ") \n", sep=""), file = newname, append=T)
cat(paste(" RNGversion(\"", metaseedinfo[[2]], "\") \n", sep=""), file = newname, append=T)
cat(paste(" RNGkind(\"", metaseedinfo[[3]][1], "\",\"", metaseedinfo[[3]][2], "\") \n \n", sep=""), file = newname, append=T)
for(i in 1:objlength){
cat(paste(" if(setnr == ", i, ") \n \n", sep =""), file = newname, append=T)
cat(paste(" return(", capture.output(dput(objects[[i]]))[1], "\n", sep =""), file = newname, append = T)
cat(paste(" ", capture.output(dput(objects[[i]]))[-1], "\n", sep =""), file = newname, append = T)
cat(" )\n", file = newname, append=T)
}
cat("} \n \n", file = newname, append=T)
if(!is.null(custom_funcs)) {
cat("# Custom functions: \n \n", file = newname, append=T)
for(i in 1:length(custom_funcs)){
u <- capture.output(dput(custom_funcs[i]))
u[1] <- paste(custom_funcs[i], u[1], sep="")
cat(paste(u, "\n \n", sep=""), file = newname, append=T)
}
}
}
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.