> Re: [R] Selecting cases from matrices stored in lists
> mdvaan 
> to:
> r-help
> 08/22/2011 09:46 AM
> 
> Jean V Adams wrote:
> > 
> >> [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]]
> > 
> > ______________________________________________
> > R-help@r-project.org mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-help
> > PLEASE do read the posting guide
> > http://www.R-project.org/posting-guide.html
> > and provide commented, minimal, self-contained, reproducible code.
> > 
> 
> Sorry, I am using the devel version of zoo which allows you to use the
> "partial" argument. The correct code is given below. 

My error.  I didn't have the latest version installed.

> 
> I didn't get your suggestion to work. If I understand what you are 
trying to
> do (multiplying c and h), this is likely to give the wrong results 
because h
> contains values of 0. Since I am ultimately interested in the values of 
the
> split matrices in c (based on the original matrices in c), this will
> probable not work. Or am I just not understanding you? 

I'm not doing any multiplication.  I just applied your extraction
        [h[[year]][ ,var] > 0, h[[year]][var, ] > 0]
to the c list rather than the h list.

You say you didn't get it to work.  Did you get an error message?  Or did 
it run, but not give you the values you wanted?  Or ... ?

Jean

> 
> Thanks! 
> 
> # devel version of zoo
> install.packages("zoo", repos = "http://r-forge.r-project.org";)
> 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) 
> 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) 
> 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))
> 
> 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]) 
>         } 

        [[alternative HTML version deleted]]

______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

Reply via email to