[R] Product of certain rows in a matrix

arun smartpink111 at yahoo.com
Mon Sep 2 19:57:20 CEST 2013


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 <smartpink111 at yahoo.com>
To: Edouard Hardy <hardy.edouard at gmail.com>
Cc: R help <r-help at r-project.org>; Bert Gunter <gunter.berton at 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.edouard at gmail.com>
To: arun <smartpink111 at yahoo.com> 
Cc: R help <r-help at 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 <smartpink111 at 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.edouard at gmail.com>
>To: arun <smartpink111 at yahoo.com>
>Cc: Bert Gunter <gunter.berton at gene.com>; R help <r-help at 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 <smartpink111 at 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 <smartpink111 at yahoo.com>
>>To: Bert Gunter <gunter.berton at gene.com>
>>Cc: R help <r-help at 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.berton at gene.com>
>>To: arun <smartpink111 at yahoo.com>
>>Cc: R help <r-help at 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 <smartpink111 at 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 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.
>>>
>>
>>
>>--
>>
>>
>>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 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.
>>
>



More information about the R-help mailing list