在R中優化循環

Question

我一直在做很多研究，我想我在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 }} 

Answer 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(...)) 
        } 
      )) 
...