[R] data

[arun]

Hi,
Try this:
final3New<-read.table(file="real_data_cecilia.txt",sep="\t")
dim(final3New)
#[1] 5369    5

#Inside the split within split, dummy==1 for the first row.  For lists that have many rows, I selected the row with dummy==0 (from the rest) using the #condition that the absolute difference between the dimensions of those rows and the first row dimension was minimum (after I applied the first #constraint).  I guess you wanted to select only a pair of rows (dummy=0 and dummy=1) for each lists.

fun1<- function(dat,percent,number){    
    lst1<- split(dat,list(dat$year,dat$industry))
    lst1New<- lapply(lst1,function(x) x[!(all(x$dummy==0)|all(x$dummy==1)),])
    lst2<- lst1New[lapply(lst1New,nrow)>0]
    lst3<- lapply(lst2,function(x){
                lapply(x$dimension,function(y){
                  x1<- x[(y < (x$dimension+(x$dimension*percent))) & (y > (x$dimension-(x$dimension*percent))),]        
                })    
                })
    lst4<- lapply(lst3,function(x){
                    lst<- lapply(x,function(y){
                            y[!all(y$dummy==0),]
                                 })
                   lstNew<- lst[lapply(lst,nrow)>1]
                   lstNew1<- unique(lstNew)
                   })
         lst5<- lst4[lapply(lst4,length)>0]
     lst6<- lapply(lst5,function(x) {
                    lst<- lapply(x,function(y){
                          y[!all(y$dummy==1),]
                           })
                    lst[lapply(lst,nrow)>0]
                    })
         lst7<- lapply(lst6,function(x){
                    lst<- lapply(x,function(y) {
                        x1<- y[1,]
                        x2<- y[-1,]
                        x3<- subset(x2,dummy==0)
                        x4<- x3[which.min(abs(x1$dimension-x3$dimension)),]
                        rbind(x1,x4)
                        })
                    lstNew<-unique(lst)
                    lstNew1<- lapply(lstNew,function(x){
                        x[abs(diff(x$dimension)) < number,] 
                        })
                     lstNew1[lapply(lstNew1,nrow)>0]
                        })
     lst8<- lst7[lapply(lst7,length)>0]
     res<- do.call(rbind,lapply(lst8,function(x){
                         do.call(rbind,x)
                            })
                                )
     row.names(res)<- 1:nrow(res)
     res}                             

res10Percent<- fun1(final3New,0.1,200)
dim(res10Percent)
#[1] 508   5
 nrow(subset(res10Percent,dummy==0))
#[1] 254
 nrow(subset(res10Percent,dummy==1))
#[1] 254
 head(res10Percent)
#       firm year industry dummy dimension
#1 500622043 2004        1     1      1198
#2 501611886 2004        1     0      1208
#3 501164600 2005        1     1      1332
#4 504243349 2005        1     0      1455
#5 500862893 2006        1     1      5324
#6 501744860 2006        1     0      5453



res5Percent<- fun1(final3New,0.05,200)
 dim(res5Percent)
#[1] 548   5

 nrow(subset(res5Percent,dummy==0))
#[1] 274
  nrow(subset(res5Percent,dummy==1))
#[1] 274

res5percent1<-fun1(final3New,0.05,50)
 dim(res5percent1)
#[1] 302   5
 nrow(subset(res5percent1,dummy==0))
#[1] 151
 nrow(subset(res5percent1,dummy==1))
#[1] 151

Hope it helps.

A.K.



________________________________
From: Cecilia Carmo <cecilia.carmo at ua.pt>
To: arun <smartpink111 at yahoo.com> 
Sent: Friday, June 7, 2013 7:30 PM
Subject: data




I'm sending the data.
Thank you very much.
Cecília

The code

final3<-read.table(file="real data cecilia.txt",sep="\t")

lst1<-split(final3,list(final3$year,final3$industry))
lst2<-lst1[lapply(lst1,nrow)>0]
lst3<-lapply(lst2,function(x) lapply(x$dimension,function(y) x[(y< (x$dimension+x$dimension*0.10)) & (y> (x$dimension-x$dimension*0.10)),]))
lst4<-lapply(lst3,function(x) x[lapply(x,nrow)==2])
lst5<-lapply(lst4,function(x)x[!duplicated(x)])
lst6<-lst5[lapply(lst5,length)>0]
lst7<-lapply(lst6,function(x) {lst<-lapply(x,function(y) y[sum(y$dummy)==1,]);lst[lapply(lst,nrow)>0]})
res<-do.call(rbind,lapply(lst7,function(x) do.call(rbind,x)))
row.names(res)<-1:nrow(res)
nrow(subset(res,res$dummy==1))
nrow(subset(res,res$dummy==0))