setMethod("as.list", "DVH.list",
function(x, ...) {
return(attr(x,"structures"))
}
)
setAs("DVH", "DVH.list",
function(from) {
return(new("DVH.list", structures=from))
}
)
setAs("zDVH", "DVH.list",
function(from) {
return(new("DVH.list", structures=from))
}
)
setAs("structure.list", "DVH.list",
function(from) {
return(new("DVH.list", lapply(from, function(struct) {return(struct$DVH)})))
}
)
setAs("list", "DVH.list",
function(from) {
DVH.list.combined <- new("DVH.list")
lapply(from, function (DVH.list) {
DVH.list.combined <<- c(DVH.list.combined, DVH.list)
})
return(DVH.list.combined)
}
)
setMethod("lapply", "DVH.list",
function (X, FUN, ...) {
X <- as.list(X)
.Internal(lapply(X, FUN))
}
)
setMethod("length", "DVH.list",
function (x) {
return(length(attr(x,"structures")))
}
)
setMethod("[", "DVH.list",
function (x, i, ...) {
if (missing(i) || (length(i) < 1) || all(is.na(i))) {
return(new("DVH.list"))
}
if (all(is.logical(i))) {
x <- attr(x,"structures")
return(new("DVH.list", x[i]))
}
if (suppressWarnings(all(!is.na(as.numeric(i))))) {
x <- attr(x,"structures")
return(new("DVH.list", x[as.numeric(i)]))
}
if (length(i) == 1) {
x <- attr(x,"structures")
if (grepl("(\\*|\\^|\\$|\\?|\\+|[[]|[{]|\\|)", i)) {
return(new("DVH.list", x[grep(i, unlist(lapply(x, names)))]))
}
else if (is.character(i)) {
return(new("DVH.list", x[which(unlist(lapply(x, names)) == i)]))
}
else if (is.logical(i)) {
return(new("DVH.list", x[i]))
}
else if (suppressWarnings(!is.na(as.numeric(i)))) {
return(new("DVH.list", x[i]))
}
else {
return(new("DVH.list", x[i]))
}
}
return(c(x[i[1]], x[i[2:length(i)]]))
}
)
setMethod("$", "DVH.list",
function (x, name) {
name <- unlist(strsplit(name, ","))
return(lapply(x, function (DVH) { DVH[name] }))
}
)
setMethod("[[", "DVH.list",
function (x, i, exact=TRUE) {
x <- attr(x,"structures")
return(x[[i]])
}
)
setMethod("[[<-", "DVH.list",
function (x, i, value) {
x <- attr(x,"structures")
if (class(value) %in% c("DVH", "zDVH")) {
x[[i]] <- value
}
else {
stop("'value' must be an object of class 'DVH' or 'zDVH'")
}
return(new("DVH.list", x))
}
)
setMethod("c", "DVH.list",
function (x, ..., recursive = FALSE) {
return(new("DVH.list", c(as.list(x), as.list(c(... , recursive=recursive)), recursive=recursive)))
}
)
setMethod("rev", "DVH.list",
function (x) {
if (length(x) <= 1) {
return(x)
}
else {
return(x[length(x):1])
}
}
)
setMethod("print", "DVH.list",
function (x, ...) {
print(paste("List containing ", length(x), " DVH objects (", paste(names(x), collapse=", ", sep=""), ")", sep=""))
}
)
setMethod("show", "DVH.list",
function (object) {
print(object)
}
)
setMethod("names", "DVH.list",
function (x) {
return(as.character(unlist(lapply(x, names))))
}
)
setMethod("names<-", "DVH.list",
function (x, value) {
if (length(x) != length(value)) {
stop(paste("'names' attribute [", length(value), "] must be the same length as the DVH list [", length(x), "]", sep=""))
}
DVHlist <- new("DVH.list", mapply(function(DVH, name) {
DVH$structure.name <- name
return(DVH)
},
x, value
))
names(attr(DVHlist,"structures")) <- value
return(DVHlist)
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.