简体   繁体   中英

R: apply function over multiple columns by condition (like with aggregate)

I had a hard time describing this one but here is my example:

n=20
years= c(rep(2000,n), rep(2001,n), rep(2002,n), rep(2003,n), rep(2004,n))
val1= c(rep(7,n), rep(8,n), rep(9,n), rep(10,n), rep(11,n))
val2= c(rep(1:20,5))

tmp= cbind(val1,val2,years)

test= array(dim=c(2,100,3), dimnames= list(c("site1","site2"),NULL,c("val1","val2","years")))
test[1,,]= tmp
test[2,,]= tmp

So what I want to do is (val1*val2)/sum(val1) for every year, and in the end I want the output to be

site1 2000 value
site1 2001 value
.......
site2 2000 value
site2 2001 value
site2 2002 value
... and so on

Declare a function which perform the operation required in a given dimension

library(dplyr)

getValues<-function(name){
temp<-data.frame(test[name,,])
values<- temp %>% group_by(years) %>% mutate(value=val1*val2/sum(val1)) %>% select(years,value)
data.frame(cbind(values,name)
}

Apply the function on any matrix in the first dimension

listTemp<-lapply(dimnames(test)[[1]],getValues)

Use the function in the data.table package to efficiently bind data frames

library(data.table)
allData<-rbindlist(listTemp)

You can use tapply() to do this:

tapply(seq_len(prod(dim(test)[1:2])),list(rownames(test)[row(test[,,1L])],test[,,'years']),function(g) sum(test[,,'val1'][g]*test[,,'val2'][g])/sum(test[,,'val1'][g]));
##       2000 2001 2002 2003 2004
## site1 10.5 10.5 10.5 10.5 10.5
## site2 10.5 10.5 10.5 10.5 10.5

You can reshape afterward to get the required output. I figured out how to use reshape() to do this, but it's ugly. I had to use nearly every argument accepted by the function to customize the result to match the required output. Assuming you store the above result as res , we have:

reshape(data.frame(res,site=rownames(res),stringsAsFactors=F,check.names=F),dir='l',idvar='site',varying=seq_len(ncol(res)),times=colnames(res),v.names='value',timevar='year',new.row.names=seq_len(prod(dim(res))));
##     site year value
## 1  site1 2000  10.5
## 2  site2 2000  10.5
## 3  site1 2001  10.5
## 4  site2 2001  10.5
## 5  site1 2002  10.5
## 6  site2 2002  10.5
## 7  site1 2003  10.5
## 8  site2 2003  10.5
## 9  site1 2004  10.5
## 10 site2 2004  10.5

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM