Nothing
ena.set <- function(x) {
newset = list()
class(newset) <- c("ena.set", class(newset))
x.is.set <- T
if("ENAdata" %in% class(x)) {
x <- list(enadata = x);
x.is.set <- F
}
code.columns <- apply(x$enadata$adjacency.matrix, 2, paste, collapse = " & ")
newset$connection.counts <- x$enadata$adjacency.vectors;
colnames(newset$connection.counts) <- code.columns
for (i in seq(ncol(newset$connection.counts))) {
set(newset$connection.counts, j = i,
value = as.ena.co.occurrence(newset$connection.counts[[i]]))
}
if (grepl(x = x$enadata$model, pattern = "Traj", ignore.case = T)) {
newset$meta.data <- data.table::copy(x$enadata$trajectories$units)
newset$meta.data[, ENA_UNIT := apply(x$enadata$trajectories$units, 1,
paste, collapse = ".")]
newset$trajectories <- cbind(newset$meta.data, x$enadata$trajectories$step)
for (i in seq(ncol(newset$trajectories))) {
set(newset$trajectories, j = i,
value = as.ena.metadata(newset$trajectories[[i]]))
}
}
else {
newset$meta.data <- x$enadata$metadata
}
if (!is.null(newset$meta.data) && ncol(newset$meta.data) > 0) {
for (i in seq(ncol(newset$meta.data))) {
set(newset$meta.data, j = i,
value = as.ena.metadata(newset$meta.data[[i]]))
}
}
if (x.is.set) {
newset$line.weights <- as.data.table(cbind(x$enadata$metadata, x$line.weights))
to_cols <- names(which(!find_meta_cols(newset$line.weights)))
for(col in to_cols) {
set(x = newset$line.weights, j = col, value = as.ena.co.occurrence(newset$line.weights[[col]]))
}
class(newset$line.weights) <- c("ena.line.weights", class(newset$line.weights))
newset$points <- cbind(x$enadata$metadata, x$points.rotated)
to_cols <- names(which(!find_meta_cols(newset$points)))
for(col in to_cols) {
set(x = newset$points, j = col, value = as.ena.dimension(newset$points[[col]]))
}
newset$points <- as.ena.matrix(newset$points, "ena.points")
newset$rotation.matrix <- x$rotation.set$rotation
}
newset$connection.counts <- cbind(newset$meta.data, newset$connection.counts)
class(newset$connection.counts) <- c("ena.connections",
class(newset$connection.counts))
newset$model <- list(
model.type = x$enadata$model,
raw.input = x$enadata$raw,
row.connection.counts = x$enadata$accumulated.adjacency.vectors[,
unique(names(x$enadata$accumulated.adjacency.vectors)), with = F],
unit.labels = x$enadata$unit.names
)
#####
# if(quote(x$enadata$function.params$weight.by) != "binary") {
# newset$model$unweighted.connection.counts <- x$enadata$adjacency.vectors.raw
# class(newset$model$unweighted.connection.counts) <- c("ena.connections",
# class(newset$model$unweighted.connection.counts))
# are.codes <- find_code_cols(newset$model$unweighted.connection.counts)
# for (i in seq(are.codes)) {
# if (are.codes[i]) {
# set(newset$model$unweighted.connection.counts, j = i,
# value = as.ena.co.occurrence(
# newset$model$unweighted.connection.counts[[i]]
# )
# )
# } else {
# set(newset$model$unweighted.connection.counts, j = i,
# value = as.ena.metadata(
# newset$model$unweighted.connection.counts[[i]]
# )
# )
# }
# }
# }
#####
cols <- grep("adjacency.code", colnames(newset$model$row.connection.counts))
colnames(newset$model$row.connection.counts)[cols] <- code.columns
for(i in cols) {
set(newset$model$row.connection.counts, j = i,
value = as.ena.co.occurrence(newset$model$row.connection.counts[[i]]))
}
for (i in which(colnames(newset$model$row.connection.counts)
%in% colnames(newset$meta.data))
) {
set(newset$model$row.connection.counts, j = i,
value = as.ena.metadata(newset$model$row.connection.counts[[i]]))
}
for (i in which(colnames(newset$model$row.connection.counts) %in%
x$enadata$codes)
) {
set(newset$model$row.connection.counts, j = i,
value = as.ena.code(newset$model$row.connection.counts[[i]]))
}
class(newset$model$row.connection.counts) <- c("row.connections",
class(newset$model$row.connection.counts))
if (x.is.set) {
newset$model$centroids <- x$centroids
newset$model$correlations <- x$correlations
newset$model$function.call <- x$function.call
newset$model$function.params <- x$function.params
newset$model$points.for.projection <- cbind(x$enadata$metadata,
x$points.normed.centered)
newset$model$variance <- x$variance
names(newset$model$variance) <- colnames(newset$rotation.matrix)
}
newset$rotation <- list(
adjacency.key = as.data.table(x$enadata$adjacency.matrix),
codes = x$enadata$codes
)
class(newset$rotation) <- c("ena.rotation.set", class(newset$rotation))
for (i in seq(ncol(newset$rotation$adjacency.key))) {
set(newset$rotation$adjacency.key, j = i,
value = as.ena.codes(newset$rotation$adjacency.key[[i]]))
}
if(x.is.set) {
newset$rotation$eigenvalues = x$rotation.set$eigenvalues
newset$rotation$nodes = x$node.positions
newset$rotation$rotation.matrix = x$rotation.set$rotation
}
newset$`_function.call` <- sys.calls()[[1]]
back.frame <- sapply(sys.frames(), function(f) {
"window.size.back" %in% ls(envir = f) })
if (any(back.frame)) {
call.frame <- sys.frame(which(back.frame))
newset$`_function.params` <- mget(ls(envir = call.frame),
envir = call.frame)
} else {
newset$`_function.params` <- list()
}
return(newset);
}
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.