清理 R 脚本，使其更加精简

Question

我有一些代码被复制了 24 次，以考虑到一天中的不同时间。我想知道简化此代码的可能性：

SBS00<-colSums(subset(Total[c(14:54)],Total$Hour=="00:00:00"|Total$Group=="SBS"))
SBS01<-colSums(subset(Total[c(14:54)],Total$Hour=="01:00:00"|Total$Group=="SBS"))
SBS02<-colSums(subset(Total[c(14:54)],Total$Hour=="02:00:00"|Total$Group=="SBS"))
SBS03<-colSums(subset(Total[c(14:54)],Total$Hour=="03:00:00"|Total$Group=="SBS"))
...
SBS23<-colSums(subset(Total[c(14:54)],Total$Hour=="23:00:00"|Total$Group=="SBS"))

所以大意是得到24个新变量SBS00到SBS23

当我有运行那个代码时，我需要使用这个代码将它们组合成一个数据框：

SBS <- data.frame(SBS00,SBS01,SBS02,SBS03,...,SBS23)

是否也可以清理它？

我也有这段代码需要精简：

SlopeSBS00<-lm(SBSNy$SBS00[c(1:10,17:41)] ~ Numbers[c(1:10,17:41)])$coeff[2]
SlopeSBS01<-lm(SBSNy$SBS01[c(1:10,17:41)] ~ Numbers[c(1:10,17:41)])$coeff[2]
SlopeSBS02<-lm(SBSNy$SBS02[c(1:10,17:41)] ~ Numbers[c(1:10,17:41)])$coeff[2]
SlopeSBS03<-lm(SBSNy$SBS03[c(1:10,17:41)] ~ Numbers[c(1:10,17:41)])$coeff[2]
...
SlopeSBS23<-lm(SBSNy$SBS23[c(1:10,17:41)] ~ Numbers[c(1:10,17:41)])$coeff[2]

这里的 SBSNy 是之前 SBS 的转换版本，而 Numbers 是来自 1:41 的数字向量，所以这段代码对每一行所做的基本上是对每个 SBS00 到 SBS23 的 SBSNy 进行线性回归，对于列 1:10 和 17:41。 Coeff[2] 只导出这里需要的斜率。

最后我还有一段不同的代码需要清理，看起来像这样：

Total$Base00 <- (Total$base + Total$base*dataval*11)
Total$Base01 <- (Total$base + Total$base*dataval*12)
Total$Base02 <- (Total$base + Total$base*dataval*13)
Total$Base03 <- (Total$base + Total$base*dataval*14)
...
Total$Base30 <- (Total$base + Total$base*dataval*41)

从 00 到 30 总共给我 31 个基本变量。

这也是随后的代码：

Total$Uplift00 <- (Total$cols11 - Total$Base00)
Total$Uplift01 <- (Total$cols12 - Total$Base01)
Total$Uplift02 <- (Total$cols13 - Total$Base02)
Total$Uplift03 <- (Total$cols14 - Total$Base03)
...
Total$Uplift30 <- (Total$cols41 - Total$Base30)

我希望你能提供帮助，因为这会大大简化我的代码！

Answer 1

您可以使用 sapply/lapply 对多列执行此操作

 Hr <- sprintf('%02d:00:00',0:23)
 SBS <- do.call(cbind,lapply(Hr, function(x)
       colSums(subset(Total[14:54], Total$Hour==x & Total$Group=='SBS'))))
 colnames(SBS) <- sprintf('SBS%02d', 0:23)

或使用dplyr

 library(dplyr)
 Total %>% 
      filter(Group=='SBS') %>% 
      group_by(Hour) %>%
      summarise_each(funs(sum),14:54) %>% 
      select(-Hour) %>% 
      t()

或使用 base R aggregate

 T1 <- cbind(Total[c(14:54)], Total['Hour'])
 t(aggregate(.~Hour, T1, subset=Total$Group=='SBS', FUN=sum)[,-1])

对于第二种情况

 nm1 <- sprintf('Base%02d', 0:30) 
 Total[nm1] <- lapply(11:41, function(x) with(Total, base + base*dataval*x))

第三次

 nm2 <- sprintf('Uplift%02d', 0:30)
 Total[nm2] <- Total[paste0('cols',11:41)]-Total[nm1]

数据

set.seed(24)
df1 <- as.data.frame(matrix(sample(0:9, 54*100, replace=TRUE), ncol=54))
set.seed(39)
Total <- cbind(df1, Hour=sample(sprintf('%02d:00:00', 0:23), 100, 
   replace=TRUE), Group= sample(c('SBS', 'SBT', 'SBI'), 100, 
      replace=TRUE), stringsAsFactors=FALSE)
 dataval <- 5
 colnames(Total)[1] <- 'base'
  colnames(Total)[11:41] <- paste0('cols', 11:41)

清理 R 脚本，使其更加精简

Clean R script to make it more streamlined

r

code-cleanup

数据