[Distr-commits] r88 - pkg/distrSim/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 26 07:05:45 CET 2008
Author: ruckdeschel
Date: 2008-02-26 07:05:45 +0100 (Tue, 26 Feb 2008)
New Revision: 88
Added:
pkg/distrSim/R/subsetting-methods.R
Removed:
pkg/distrSim/R/indexing-methods.R
Log:
fixed bug in distrSim -> had to rename indexing into subsetting ...
Deleted: pkg/distrSim/R/indexing-methods.R
===================================================================
--- pkg/distrSim/R/indexing-methods.R 2008-02-26 05:51:46 UTC (rev 87)
+++ pkg/distrSim/R/indexing-methods.R 2008-02-26 06:05:45 UTC (rev 88)
@@ -1,80 +0,0 @@
-setMethod("[", "SeqDataFrames", function(x, i, j, k, drop = FALSE){
- if(missing(k)) k <- 1:length(x at data)
- kl <- length(k)
- if (kl == 1){
- daf <- "["(x at data[[k]],i,j, drop = drop)
- if (drop)
- return(daf)
- else return(new("SeqDataFrames", data = list(daf)))
- }else {
- kn <- 1: length(x at data)
- if(!is.null(names(x at data)))
- names(kn) <- names(x at data)
- kl0 <- kn[k]
- kll <- length(kl0)
- lis <- vector("list",kll)
- for (kk in 1:kll)
- {lis[[kk]] <- as.data.frame("["(x at data[[kl0[kk]]], i,j, drop = drop))
- if(!is.null(names(x at data)))
- names(lis)[kk] <- names(x at data)[kl0[kk]]}
- return(new("SeqDataFrames", data = lis))
- }})
-
-setReplaceMethod("[", "SeqDataFrames", function(x, i, j, k, value){
- if(missing(k)) k <- 1:length(x at data)
- if(length(k)==1){
- if((k<=length(x at data))||!is(try(x at data[[k]],silent=TRUE),"try-error"))
- {zl <- x at data
- z <- zl[[k]]
- if (missing(i))
- { i <- 1:nrow(z)
- #if(!is.null(dim(value)))
- # z <- data.frame(matrix(NA,nrow(value),ncol(x at data[[1]])))
- # else z <- data.frame(matrix(NA,length(value),ncol(x at data[[1]])))
- }
- z[i,j] <- value
- zl[[k]] <- z
- x at data <- zl
- }else{
- if(!is.null(dim(value)))
- z <- data.frame(matrix(NA,nrow(value),ncol(x at data[[1]])))
- else z <- data.frame(matrix(NA,length(value),ncol(x at data[[1]])))
- z[i,j] <- value
- x at data <- c(x at data,list(z))
- }
- return(x)}
-
- if(missing(j)) j <- 1:ncol(x at data[[1]])
- if(missing(i)) i <- lapply(1:length(x at data),function(y) 1:nrow(x at data[[y]]))
-
- if(is(value, "SeqDataFrames")) value <- value at data
-
- kn <- 1: length(x at data)
- if(!is.null(names(x at data)))
- names(kn) <- names(x at data)
- kl0 <- kn[k]
- kll <- length(kl0)
-
- if(!is.list(i)) i <- lapply(kl0,function(y) i)
-
- if(is(value,"atomic"))
- value <- lapply(1:kll,
- function(y) data.frame(matrix(
- rep(value, length( i[[kl0[y]]])*length(j)),
- length(i[[kl0[y]]]),
- length(j) )
- )
- )
- if (kll==1) value <- list(value)
- if(is(value,"data.frame"))
- value <- lapply(kl0,function(y) value)
-
- zl <- x at data
- for(kk in 1:kll)
- {z <- zl[[kl0[kk]]]
- z[c(unlist(i[[kl0[kk]]])),j] <- value[kk]
- zl[[kl0[kk]]] <- z
- }
- x at data <- zl
- return(x)
- })
Copied: pkg/distrSim/R/subsetting-methods.R (from rev 85, pkg/distrSim/R/indexing-methods.R)
===================================================================
--- pkg/distrSim/R/subsetting-methods.R (rev 0)
+++ pkg/distrSim/R/subsetting-methods.R 2008-02-26 06:05:45 UTC (rev 88)
@@ -0,0 +1,80 @@
+setMethod("[", "SeqDataFrames", function(x, i, j, k, drop = FALSE){
+ if(missing(k)) k <- 1:length(x at data)
+ kl <- length(k)
+ if (kl == 1){
+ daf <- "["(x at data[[k]],i,j, drop = drop)
+ if (drop)
+ return(daf)
+ else return(new("SeqDataFrames", data = list(daf)))
+ }else {
+ kn <- 1: length(x at data)
+ if(!is.null(names(x at data)))
+ names(kn) <- names(x at data)
+ kl0 <- kn[k]
+ kll <- length(kl0)
+ lis <- vector("list",kll)
+ for (kk in 1:kll)
+ {lis[[kk]] <- as.data.frame("["(x at data[[kl0[kk]]], i,j, drop = drop))
+ if(!is.null(names(x at data)))
+ names(lis)[kk] <- names(x at data)[kl0[kk]]}
+ return(new("SeqDataFrames", data = lis))
+ }})
+
+setReplaceMethod("[", "SeqDataFrames", function(x, i, j, k, value){
+ if(missing(k)) k <- 1:length(x at data)
+ if(length(k)==1){
+ if((k<=length(x at data))||!is(try(x at data[[k]],silent=TRUE),"try-error"))
+ {zl <- x at data
+ z <- zl[[k]]
+ if (missing(i))
+ { i <- 1:nrow(z)
+ #if(!is.null(dim(value)))
+ # z <- data.frame(matrix(NA,nrow(value),ncol(x at data[[1]])))
+ # else z <- data.frame(matrix(NA,length(value),ncol(x at data[[1]])))
+ }
+ z[i,j] <- value
+ zl[[k]] <- z
+ x at data <- zl
+ }else{
+ if(!is.null(dim(value)))
+ z <- data.frame(matrix(NA,nrow(value),ncol(x at data[[1]])))
+ else z <- data.frame(matrix(NA,length(value),ncol(x at data[[1]])))
+ z[i,j] <- value
+ x at data <- c(x at data,list(z))
+ }
+ return(x)}
+
+ if(missing(j)) j <- 1:ncol(x at data[[1]])
+ if(missing(i)) i <- lapply(1:length(x at data),function(y) 1:nrow(x at data[[y]]))
+
+ if(is(value, "SeqDataFrames")) value <- value at data
+
+ kn <- 1: length(x at data)
+ if(!is.null(names(x at data)))
+ names(kn) <- names(x at data)
+ kl0 <- kn[k]
+ kll <- length(kl0)
+
+ if(!is.list(i)) i <- lapply(kl0,function(y) i)
+
+ if(is(value,"atomic"))
+ value <- lapply(1:kll,
+ function(y) data.frame(matrix(
+ rep(value, length( i[[kl0[y]]])*length(j)),
+ length(i[[kl0[y]]]),
+ length(j) )
+ )
+ )
+ if (kll==1) value <- list(value)
+ if(is(value,"data.frame"))
+ value <- lapply(kl0,function(y) value)
+
+ zl <- x at data
+ for(kk in 1:kll)
+ {z <- zl[[kl0[kk]]]
+ z[c(unlist(i[[kl0[kk]]])),j] <- value[kk]
+ zl[[kl0[kk]]] <- z
+ }
+ x at data <- zl
+ return(x)
+ })
More information about the Distr-commits
mailing list