## For arbitrary n, just loop over the lag!
Here's an alternative version using logical instead of numerical indexing
(assumes nrow(A) %% n = 0).
You could also use the numerical indexing as before, of course. Doubt that
it would make much of a speed difference, but you can try it and see.
j <- seq_len(nrow(A))%%n
b <- A[j==0,]
for(i in seq_len(n-1))b <- b*A[j==i,]
b
-- Bert
On Mon, Sep 2, 2013 at 10:57 AM, arun <smartpink...@yahoo.com> wrote:
> HI,
> You could modify Bert's solution:
> n<-3
>
> j3<-n*seq_len(nrow(A)/n)
> A[j3,]*A[j3-1,]*A[j3-2,] ##assuming that nrow(dataset)%%n==0
> # [,1] [,2] [,3]
> #[1,] 28 80 162
> #[2,] 162 80 28
>
>
> #Speed comparison
>
>
> set.seed(28)
> mat1<- matrix(sample(1:20,1e5*3,replace=TRUE),ncol=3)
>
> n<-4
> system.time({res1<-
> t(sapply(split(as.data.frame(mat1),as.numeric(gl(nrow(mat1),n,nrow(mat1)))),function(x)
> apply(x,2,prod))) })
> # user system elapsed
> # 8.508 0.620 9.146
> system.time({res2<-
> t(sapply(split(as.data.frame(mat1),as.numeric(gl(nrow(mat1),n,nrow(mat1)))),function(x)
> Reduce("*",as.data.frame(t(x))))) })
> # user system elapsed
> # 8.556 0.000 8.566
>
> A1<- data.frame(mat1,ID=as.numeric(gl(nrow(mat1),n,nrow(mat1))))
> system.time({res3<- aggregate(A1[,-4],list(A1[,4]),colProds)[,-1]})
> # user system elapsed
> # 11.536 0.000 11.553
>
>
> nrow(mat1)%%n
> #[1] 0
> system.time({j4<- n*seq_len(nrow(mat1)/n)
> res5<- mat1[j4,]*mat1[j4-1,]*mat1[j4-2,]*mat1[j4-3,]
> })
>
> # user system elapsed
> # 0.004 0.000 0.004
>
> dimnames(res2)<- dimnames(res5)
> identical(res2,res5)
> #[1] TRUE
>
>
> #if
> n<-6
> nrow(mat1)%%6
> #[1] 4
>
>
> system.time({
> mat2<-mat1[seq(nrow(mat1)-4),]
> j6<- n*seq_len(nrow(mat2)/n)
> res6<-
> mat2[j6,]*mat2[j6-1,]*mat2[j6-2,]*mat2[j6-3,]*mat2[j6-4,]*mat2[j6-5,]
> res6New<-rbind(res6,apply(tail(mat1,4),2,prod)
> )})
>
> # user system elapsed
> # 0.004 0.000 0.006
>
>
>
> system.time({res6Alt<-
> t(sapply(split(as.data.frame(mat1),as.numeric(gl(nrow(mat1),n,nrow(mat1)))),function(x)
> Reduce("*",as.data.frame(t(x))))) })
> #user system elapsed
> # 5.576 0.000 5.583
> dimnames(res6Alt)<- dimnames(res6New)
>
>
> all.equal(res6New,res6Alt)
> #[1] TRUE
>
>
> A.K.
>
>
>
> As you said, this is very loooong.
> Do you have a better solution on big data ?
>
>
>
> ----- Original Message -----
> From: arun <smartpink...@yahoo.com>
> To: Edouard Hardy <hardy.edou...@gmail.com>
> Cc: R help <r-help@r-project.org>; Bert Gunter <gunter.ber...@gene.com>
> Sent: Monday, September 2, 2013 12:07 PM
> Subject: Re: [R] Product of certain rows in a matrix
>
>
>
> Hi,
> No problem.
> n<- 4
>
> t(sapply(split(as.data.frame(Anew),as.numeric(gl(nrow(Anew),n,nrow(Anew)))),function(x)
> apply(x,2,prod)))
>
> # V1 V2 V3
> #1 252 640 1134
> #2 18 30 20
>
>
> This could be a bit slow if you have big dataset.
>
>
> A.K.
>
>
>
> ________________________________
> From: Edouard Hardy <hardy.edou...@gmail.com>
> To: arun <smartpink...@yahoo.com>
> Cc: R help <r-help@r-project.org>
> Sent: Monday, September 2, 2013 11:58 AM
> Subject: Re: [R] Product of certain rows in a matrix
>
>
>
> Thank you A.K.
> And do you have a solution without installing any package ?
> Thank you in advance.
> E.H.
>
>
>
> Edouard Hardy
>
>
>
> On Mon, Sep 2, 2013 at 5:56 PM, arun <smartpink...@yahoo.com> wrote:
>
>
> >
> >HI,
> >In my first solutions:
> > n<-3
>
> > t(sapply(split(as.data.frame(Anew),as.numeric(gl(nrow(Anew),n,nrow(Anew)))),colProds))
> ># [,1] [,2] [,3]
> >#1 28 80 162
> >#2 162 80 28
> >#3 1 3 5
> > n<-4
>
> > t(sapply(split(as.data.frame(Anew),as.numeric(gl(nrow(Anew),n,nrow(Anew)))),colProds))
> ># [,1] [,2] [,3]
> >#1 252 640 1134
> >#2 18 30 20
> >
> >A.K.
> >
> >________________________________
> >From: Edouard Hardy <hardy.edou...@gmail.com>
> >To: arun <smartpink...@yahoo.com>
> >Cc: Bert Gunter <gunter.ber...@gene.com>; R help <r-help@r-project.org>
> >Sent: Monday, September 2, 2013 11:46 AM
> >
> >Subject: Re: [R] Product of certain rows in a matrix
> >
> >
> >
> >Thank you all for your responses.
> >The real problem is that all your answer work for products 2 by 2.
> >I now have to do the product n by n row.
> >Do you have a solution ?
> >Thank you in advance,
> >E.H.
> >
> >
> >
> >Edouard Hardy
> >
> >
> >
> >On Mon, Sep 2, 2013 at 5:43 PM, arun <smartpink...@yahoo.com> wrote:
> >
> >I guess in such situations,
> >>
> >>
> >>fun1<- function(mat){
> >> if(nrow(mat)%%2==0){
> >> j<- 2*seq_len(nrow(mat)/2)
> >> b<- mat[j,]* mat[j-1,]
> >> }
> >> else {mat1<- mat[-nrow(mat),]
> >> j<- 2*seq_len(nrow(mat1)/2)
> >> b<- rbind(mat1[j,]*mat1[j-1,],mat[nrow(mat),])
> >> }
> >>b
> >>}
> >>fun1(A)
> >># [,1] [,2] [,3]
> >>
> >>#[1,] 4 10 18
> >>#[2,] 63 64 63
> >>#[3,] 18 10 4
> >> fun1(Anew)
> >># [,1] [,2] [,3]
> >>
> >>#[1,] 4 10 18
> >>#[2,] 63 64 63
> >>#[3,] 18 10 4
> >>#[4,] 1 3 5
> >>
> >>
> >>A.K.
> >>
> >>
> >>
> >>
> >>----- Original Message -----
> >>From: arun <smartpink...@yahoo.com>
> >>To: Bert Gunter <gunter.ber...@gene.com>
> >>Cc: R help <r-help@r-project.org>
> >>
> >>Sent: Monday, September 2, 2013 11:26 AM
> >>Subject: Re: [R] Product of certain rows in a matrix
> >>
> >>Hi Bert,
> >>Thanks. It is a better solution.
> >>
> >>If nrow() is not even.
> >>
> >>Anew<- rbind(A,c(1,3,5))
> >>j<-seq_len(nrow(Anew)/2)###
> >> Anew[j,]*Anew[j-1,]
> >>#Error in Anew[j, ] * Anew[j - 1, ] : non-conformable arrays
> >>
>
> >>t(sapply(split(as.data.frame(Anew),as.numeric(gl(nrow(Anew),2,7))),colProds))
> >> [,1] [,2] [,3]
> >>1 4 10 18
> >>2 63 64 63
> >>3 18 10 4
> >>4 1 3 5
> >>
> >>A.K.
> >>
> >>
> >>
> >>
> >>
> >>
> >>________________________________
> >>From: Bert Gunter <gunter.ber...@gene.com>
> >>To: arun <smartpink...@yahoo.com>
> >>Cc: R help <r-help@r-project.org>
> >>Sent: Monday, September 2, 2013 10:55 AM
> >>Subject: Re: [R] Product of certain rows in a matrix
> >>
> >>
> >>
> >>These elaborate manipulations are unnecessary and inefficient. Use
> indexing instead:
> >>
> >>j <- 2*seq_len(nrow(A)/2)
> >>b <- A[j,]*A[j-1,]
> >>b
> >>[,1] [,2] [,3]
> >>[1,] 4 10 18
> >>[2,] 63 64 63
> >>[3,] 18 10 4
> >>
> >>[,1] [,2] [,3]
> >>[1,] 4 10 18
> >>[2,] 63 64 63
> >>[3,] 18 10 4
> >>[,1] [,2] [,3]
> >>[1,] 4 10 18
> >>[2,] 63 64 63
> >>[3,] 18 10 4[,1] [,2] [,3]
> >>[1,] 4 10 18
> >>[2,] 63 64 63
> >>[3,] 18 10 4
> >>[,1] [,2] [,3]
> >>[1,] 4 10 18
> >>[2,] 63 64 63
> >>[3,] 18 10 4
> >>
> >>
> >>
> >>
> >>
> >>On Mon, Sep 2, 2013 at 7:25 AM, arun <smartpink...@yahoo.com> wrote:
> >>
> >>Hi,
> >>>You could try:
> >>>
> >>>A<- matrix(unlist(read.table(text="
> >>>1 2 3
> >>>4 5 6
> >>>7 8 9
> >>>9 8 7
> >>>6 5 4
> >>>3 2 1
> >>>",sep="",header=FALSE)),ncol=3,byrow=FALSE,dimnames=NULL)
> >>>
> >>>library(matrixStats)
>
> >>> res1<-t(sapply(split(as.data.frame(A),as.numeric(gl(nrow(A),2,6))),colProds))
> >>> res1
> >>># [,1] [,2] [,3]
> >>>#1 4 10 18
> >>>#2 63 64 63
> >>>#3 18 10 4
> >>>
> >>>
>
> >>> res2<-t(sapply(split(as.data.frame(A),((seq_len(nrow(A))-1)%/%2)+1),colProds))
> >>> identical(res1,res2)
> >>>#[1] TRUE
> >>>
> >>>#or
> >>> t(sapply(split(as.data.frame(A),as.numeric(gl(nrow(A),2,6))),function(x)
> apply(x,2,prod)))
> >>>
> >>>#or
> >>>library(plyr)
>
> >>> as.matrix(ddply(as.data.frame(A),.(as.numeric(gl(nrow(A),2,6))),colProds)[,-1])
> >>># V1 V2 V3
> >>>#[1,] 4 10 18
> >>>#[2,] 63 64 63
> >>>#[3,] 18 10 4
> >>>
> >>>#or
> >>>do.call(rbind,tapply(seq_len(nrow(A)),list(as.numeric(gl(nrow(A),2,6))),FUN=function(x)
> colProds(A[x,])))
> >>>#or
> >>>A1<- data.frame(A,ID=as.numeric(gl(nrow(At),2,6)))
> >>> aggregate(A1[,-4],list(A1[,4]),colProds)[,-1]
> >>># X1 X2 X3
> >>>#1 4 10 18
> >>>#2 63 64 63
> >>>#3 18 10 4
> >>>
> >>>#or
> >>>library(data.table)
> >>>At<- data.table(A1,key='ID')
> >>>subset(At[,lapply(.SD,colProds),by=ID],select=-1)
> >>># X1 X2 X3
> >>>#1: 4 10 18
> >>>#2: 63 64 63
> >>>#3: 18 10 4
> >>>
> >>>A.K.
> >>>
> >>>
> >>>
> >>>
> >>>Hello,
> >>>
> >>>I have this matrix :
> >>>A =
> >>>1 2 3
> >>>4 5 6
> >>>7 8 9
> >>>9 8 7
> >>>6 5 4
> >>>3 2 1
> >>>
> >>>I would like to have this matrix (product of rows 2 by 2) :
> >>>A =
> >>>4 10 18
> >>>63 64 63
> >>>18 10 4
> >>>
> >>>Is it possible to do that without a loop ?
> >>>
> >>>Thank you in advance !
> >>>
> >>>______________________________________________
> >>>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.
> >>>
> >>
> >>
> >>--
> >>
> >>
> >>Bert Gunter
> >>Genentech Nonclinical Biostatistics
> >>
> >>Internal Contact Info:
> >>Phone: 467-7374
> >>Website:
> >>
> >>
> http://pharmadevelopment.roche.com/index/pdb/pdb-functional-groups/pdb-biostatistics/pdb-ncb-home.htm
> >>
> >>______________________________________________
> >>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.
> >>
> >
>
--
Bert Gunter
Genentech Nonclinical Biostatistics
Internal Contact Info:
Phone: 467-7374
Website:
http://pharmadevelopment.roche.com/index/pdb/pdb-functional-groups/pdb-biostatistics/pdb-ncb-home.htm
[[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.
