> [R] Selecting cases from matrices stored in lists
> mdvaan
> to:
> r-help
> 08/22/2011 07:24 AM
>
> Hi,
>
> I have two lists (c and h - see below) containing matrices with similar
> cases but different values. I want to split these matrices into multiple
> matrices based on the values in h. So, I did the following:
>
> years<-c(1997:1999)
> for (t in 1:length(years))
> {
> year=as.character(years[t])
> h[[year]]<-sapply(colnames(h[[year]]), function(var)
> h[[year]][h[[year]][,var]>0, h[[year]][var,]>0])
> }
>
> Now that I have created list h (with split matrices), I would like to
use> these selections to make similar selections in list c. List c needs to
get> the exact same shape as h, so that `8026`in 1997 (c$`1997`$`8026`) looks
> like this:
>
> $`1997`$`8026`
> B
> B 8025 8026 8029
> 8025 1.0000000 0.7739527 0.9656091
> 8026 0.7739527 1.0000000 0.7202771
> 8029 0.9656091 0.7202771 1.0000000
>
> Can anyone help me doing this? I have no idea how I can get it to work.
> Thank you very much for your help!
>
Try this:
c2 <- h
years <- names(h)
for (t in seq(years))
{
year <- years[t]
c2[[year]] <- sapply(colnames(h[[year]]), function(var)
c[[t]][h[[year]][ ,var] > 0, h[[year]][var, ] > 0])
}
By the way, it's great that you included code in your question.
However, I encountered a couple of errors when running you code (see
below).
Also, it would be better to use a different name for your list "c",
because c() is a function in R.
Jean
>
> library(zoo)
> DF1 = data.frame(read.table(textConnection(" B C D E F G
> 8025 1995 0 4 1 2
> 8025 1997 1 1 3 4
> 8026 1995 0 7 0 0
> 8026 1996 1 2 3 0
> 8026 1997 1 2 3 1
> 8026 1998 6 0 0 4
> 8026 1999 3 7 0 3
> 8027 1997 1 2 3 9
> 8027 1998 1 2 3 1
> 8027 1999 6 0 0 2
> 8028 1999 3 7 0 0
> 8029 1995 0 2 3 3
> 8029 1998 1 2 3 2
> 8029 1999 6 0 0 1"),head=TRUE,stringsAsFactors=FALSE))
>
> a <- read.zoo(DF1, split = 1, index = 2, FUN = identity)
> sum.na <- function(x) if (any(!is.na(x))) sum(x, na.rm = TRUE) else NA
> b <- rollapply(a, 3, sum.na, align = "right", partial = TRUE)
Error in FUN(cdata[st, i], ...) : unused argument(s) (partial = TRUE)
rollapply() has no argument partial.
> newDF <- lapply(1:nrow(b), function(i)
> prop.table(na.omit(matrix(b[i,], nc = 4, byrow = TRUE,
> dimnames = list(unique(DF1$B), names(DF1)[-1:-2]))), 1))
> names(newDF) <- time(a)
Error in names(newDF) <- time(a) :
'names' attribute [5] must be the same length as the vector [3]
newDF has only 3 names, but time(a) is of length 5.
> c<-lapply(newDF, function(mat) tcrossprod(mat / sqrt(rowSums(mat^2))))
>
> DF2 = data.frame(read.table(textConnection(" A B C
> 80 8025 1995
> 80 8026 1995
> 80 8029 1995
> 81 8026 1996
> 82 8025 1997
> 82 8026 1997
> 83 8025 1997
> 83 8027 1997
> 90 8026 1998
> 90 8027 1998
> 90 8029 1998
> 84 8026 1999
> 84 8027 1999
> 85 8028 1999
> 85 8029 1999"),head=TRUE,stringsAsFactors=FALSE))
>
> e <- function(y) crossprod(table(DF2[DF2$C %in% y, 1:2]))
> years <- sort(unique(DF2$C))
> f <- as.data.frame(embed(years, 3))
> g<-lapply(split(f, f[, 1]), e)
> h<-lapply(g, function (x) ifelse(x>0,1,0))
[[alternative HTML version deleted]]