我一直在进行大量的研究,我认为在R中嵌套for循环时我遗漏了一些东西。我有两个数据帧 - 一个包含我想写输出的观察和位置,另一个包含我正在循环的变量名称。现在循环工作,但它需要花费14个多小时来循环200行,这似乎有点过分。当然,我正在每行执行12次单独的排列(100次),但我最好还是要做> 1000+排列。是否有更有效的方法为循环执行此操作?当我进行一次观察时,它需要很少的时间才能完成(2秒钟),这让我觉得应该有更好的方法来完成这项任务。您将非常感谢您在优化此代码时提供的任何帮助!谢谢!
附加主数据集(fbfm.xlsx),称为fm.std https://www.dropbox.com/s/vmd8d05yxds93j6/fbfm.xlsx?dl=0
library(rothermel)
u.val<-c(5,10,15,25,35,45,55,65,75,85,95,100)
unames <- data.frame(u=u.val,ros.nam=paste("u",u.val,"_ROS",sep=""), stringsAsFactors = FALSE)
ros.out<-data.frame(fm.std)
for (i in 1:dim(unames)[1]){
ros.out[,unames[i,'ros.nam']]<-999
}
ros.out <- as.vector(ros.out)
fm.std <- as.vector(fm.std)
for (i in 1:dim(ros.out)[1]){
ros.out[i,1:32]
for (u in 1:dim(unames)[1]){
ros.out[i,unames[u,'ros.nam']]<-mean(rosunc(modeltype=fm.std[i,'Fuel_Model_Type'], #Dyanmic or static model
w=fm.std[i,4:8], # fuel loads (1, 10, 100, herb, and shrub)
s=fm.std[i,9:13], # SAV measurements
delta=fm.std[i,14], #fuel bed depth
mx.dead=fm.std[i,15], # dead fuel mositure of extinction
h=fm.std[i,16:20], # heat content for fuel classes
m=fm.std[i,c(25,24,23,26,30)], #percent moisture of fuel classes
u = unames[u,'u'],
slope=0,
sdm=0.3,
nsim=100) ) #wind and slope of 0 }}
答案 0 :(得分:1)
考虑采用更加向量化的sapply()
方法,传递两个向量u.val
和1:nrow(fm.std)
。这将构建一个200行,12列矩阵,您可以将其转换为数据帧,然后cbind
转换为原始数据帧。
ucols <- sapply(u.val,
function(x, y){
mean(rosunc(modeltype=fm.std[y,'Fuel_Model_Type'], # Dyanmic or static model
w=fm.std[y,4:8], # fuel loads (1, 10, 100, herb, and shrub)
s=fm.std[y,9:13], # SAV measurements
delta=fm.std[y,14], # fuel bed depth
mx.dead=fm.std[y,15], # dead fuel mositure of extinction
h=fm.std[y,16:20], # heat content for fuel classes
m=fm.std[y,c(25,24,23,26,30)], # percent moisture of fuel classes
u=x,
slope=0,
sdm=0.3,
nsim=100))
}, 1:nrow(fm.std))
# CONVERT MATRIX TO DATA FRAME
ucols <- data.frame(ucols)
# RENAME COLUMNS
names(test) <- paste("u",u.val,"_ROS",sep="")
# BIND COLUMNS TO ORIGINAL DATA FRAME
ros.out <- cbind(fm.std, ucols)
或者,考虑将outer()
与转置t()
一起使用,以实现200行和12列矩阵。
ucols <- t(outer(u.val, 1:nrow(fm.std),
function(x, y){
mean(rosunc(...))
}
))
...