From: mathijsdevaan <mathijsdevaan_at_gmail.com>

Date: Wed, 20 Apr 2011 02:49:19 -0700 (PDT)

c<-lapply(newDF, function(mat) tcrossprod(mat / sqrt(rowSums(mat^2))))

Date: Wed, 20 Apr 2011 02:49:19 -0700 (PDT)

As a follow up on this post, I am trying to slightly adjust the solution kindly provided by Gabor. However, I am getting some results that I do not understand. Example:

# 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))))

Now I would like the elements e in c to be equal to 1-e. However,

c<-lapply(newDF, function(mat) 1 - tcrossprod(mat / sqrt(rowSums(mat^2))))

gives a value of 2.220446e-16 for as.data.frame(c['1999'])[2,2] instead of 0

What am I doing wrong here? Thanks a lot!

> First we use read.zoo to reform DF into a multivariate time series and

*> use rollapply (where we have used the devel version of zoo since it
**> supports the partial= argument on rollapply). We then reform each
**> resulting row into a matrix converting each row of each matrix to
**> proportions. Finally we form the desired scaled cross product.
**>
**> # devel version of zoo
**> install.packages("zoo", repos = "http://r-forge.r-project.org")
**> library(zoo)
**>
**> z <- read.zoo(DF, split = 2, index = 3, FUN = identity)
**>
**> sum.na <- function(x) if (any(!is.na(x))) sum(x, na.rm = TRUE) else NA
**> r <- rollapply(z, 3, sum.na, align = "right", partial = TRUE)
**>
**> newDF <- lapply(1:nrow(r), function(i)
**> prop.table(na.omit(matrix(r[i,], nc = 4, byrow = TRUE,
**> dimnames = list(unique(DF$B), names(DF)[-2:-3]))[, -1]),
**> 1))
**> names(newDF) <- time(z)
**>
**> lapply(newDF, function(mat) tcrossprod(mat / sqrt(rowSums(mat^2))))
*

-- View this message in context: http://r.789695.n4.nabble.com/Yearly-aggregates-and-matrices-tp3438140p3462564.html Sent from the R help mailing list archive at Nabble.com. ______________________________________________ R-help_at_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.Received on Wed 20 Apr 2011 - 10:38:29 GMT

Archive maintained by Robert King, hosted by
the discipline of
statistics at the
University of Newcastle,
Australia.

Archive generated by hypermail 2.2.0, at Wed 20 Apr 2011 - 13:10:32 GMT.

*
Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help.
Please read the posting
guide before posting to the list.
*