如何对data.table中不同组的数据使用不同的间隔执行线性回归?我目前正在使用plyr进行此操作,但是对于大型数据集,它变得非常慢。非常感谢您对加快该过程的任何帮助。
我有一个数据表,其中包含10个地块和3个围栏在10天内的10个CO2测量值。如下所述,不同的日期属于不同的时间段。
我想执行线性回归,以确定每个周期内使用不同计数间隔的每个围栏,地块和日组合的二氧化碳变化率。在计数1-5期间,期间1应该减少二氧化碳排放,在期间2中使用1-7减少二氧化碳排放,在期间3中使用1-9减少二氧化碳排放。
CO2 <- rep((runif(10, 350,359)), 300) # 10 days, 10 plots, 3 fences
count <- rep((1:10), 300) # 10 days, 10 plots, 3 fences
DOY <-rep(rep(152:161, each=10),30) # 10 measurements/day, 10 plots, 3 fences
fence <- rep(1:3, each=1000) # 10 days, 10 measurements, 10 plots
plot <- rep(rep(1:10, each=100),3) # 10 days, 10 measurements, 3 fences
flux <- as.data.frame(cbind(CO2, count, DOY, fence, plot))
flux$period <- ifelse(flux$DOY <= 155, 1, ifelse(flux$DOY > 155 & flux$DOY < 158, 2, 3))
flux <- as.data.table(flux)
我希望得到一个输出,该输出为我提供每个图,围栏和DOY的R2拟合度和直线的斜率。
我提供的数据是一个小的子样本,我的真实数据有1 * 10 ^ 6行。以下工作,但是很慢:
model <- function(df)
{lm(CO2 ~ count, data = subset(df, ifelse(df$period == 1,count>1 &count<5,
ifelse(df$period == 2,count>1 & count<7,count>1 & count<9))))}
model_flux <- dlply(flux, .(fence, plot, DOY), model)
rsq <- function(x) summary(x)$r.squared
coefs_flux <- ldply(model_flux, function(x) c(coef(x), rsquare = rsq(x)))
names(coefs_flux)[1:5] <- c("fence", "plot", "DOY", "intercept", "slope")
这是一种“ data.table”方法:
library(data.table)
flux <- as.data.table(flux)
setkey(flux,count)
flux[,include:=(period==1 & count %in% 2:4) |
(period==2 & count %in% 2:6) |
(period==3 & count %in% 2:8)]
flux.subset <- flux[(include),]
setkey(flux.subset,fence,plot,DOY)
model <- function(df) {
fit <- lm(CO2 ~ count, data = df)
return(list(intercept=coef(fit)[1],
slope=coef(fit)[2],
rsquare=summary(fit)$r.squared))
}
coefs_flux <- flux.subset[,model(.SD),by="fence,plot,DOY"]
除非我缺少任何内容,否则在每次调用中model(...)
都不需要进行子设置。您可以从一开始就按周期将计数细分。该代码产生与您相同的结果,除了dlply(...)
返回一个数据帧并且此代码生成一个数据表。在这个测试数据集上并没有快得多。
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句