从sapply/lapply返回多个值

Question

我是R的新手并试图用apply系列中的fuction替换一些for循环.我仍然完全不了解它们是如何工作的,但我设法生成了一段代码:

#create some input data
tech<-data.frame(cbind(c("p1","p2","p3","p4"),c(15,15,15,100),c(10,8,18,100)))
colnames(tech)=c("id","capacity.el","capacity.th")
tech$capacity.el<-as.numeric(tech$capacity.el)
tech$capacity.th<-as.numeric(tech$capacity.th)

heat<-data.frame(cbind(c(2,12,6,20,32,21,25,16,34,0),c(31,18,3,27,30,31,18,4,24,7),c(2,12,6,20,32,21,25,16,34,0),c(31,18,3,27,30,31,18,4,24,7)))
colnames(heat)=c("p1","p2","p3","p4")

> tech
  id capacity.el capacity.th
1 p1           2           1
2 p2           2           4
3 p3           2           3
4 p4           1           2


> heat
   p1 p2 p3 p4
1   2 31  2 31
2  12 18 12 18
3   6  3  6  3
4  20 27 20 27
5  32 30 32 30
6  21 31 21 31
7  25 18 25 18
8  16  4 16  4
9  34 24 34 24
10  0  7  0  7

#the result should be a matrix/list 
pel=matrix(,nrow=nrow(heat),ncol=ncol(heat))
epr=matrix(,nrow=nrow(heat),ncol=ncol(heat))        
result<-list()

#main code    
result<-sapply(colnames(heat),function(x) {
                a<-tech$capacity.th[match(x,tech$id)]
                b<-tech$capacity.el[match(x,tech$id)]
                sapply(heat[,x],function(y) {
                  pel<-a*y
                  return(pel)
                })

              })

我们的想法是"循环"通过"热"data.frame的列,并使用来自"heat"data.frame的值执行一些计算.出于这个原因,我使用第一个sapply功能从技术表中获取热表中每个工厂的相应特征.然后第二个sapply执行计算.输出"结果"正是我想要的.

现在我想计算"热量"(pel和epr)中每行的值.但我不知道如何从sapply功能中提取这些值.我尝试了以下列表,但这会将值提取为一个包含20行的大矩阵.完美的结果就像一个带有两个矩阵或data.frame对象的列表,每个对象有10行和4列,其中包含pel/epr值.

result<-sapply(colnames(heat),function(x) {
                a<-tech$capacity.th[match(x,tech$id)]
                b<-tech$capacity.el[match(x,tech$id)]
                sapply(heat[,x],function(y) {
                  pel<-a*y
                  epr<-b*y
                })
                new<-list(pel,epr)
                return(new)
              })

我将不胜感激任何帮助或评论.

Answer 1

我建议你先整理一下你的数据.有关更多信息,请参阅tidyr包

然后合并两个数据帧,您将不需要任何循环或*apply函数.您只需在此新数据框中进行计算,例如使用dplyr包:

library(tidyr)
library(dplyr)

heat %>%
  gather(id, value) %>%
  left_join(tech, by="id") %>%
  mutate(a = value * capacity.el,
         b = value * capacity.th)