Как я могу запускать циклы по двум спискам с двумя векторами в r?

Question

У меня есть два списка (lp и lpara) с 12000 фреймов данных (те же имена: числа от 1 до 12000). Каждый фрейм данных имеет столбец с месяцами от 1 до 12, длина разная: lp содержит 468 и lpara 12 строк. Я хочу запустить код в течение 12 месяцев для каждого фрейма данных из списков и записать результат в список.

Сначала я написал код для одного образца списков (lp [[79]] и lpara[[79]]) . Сработал следующий код:

    results <- data.frame(matrix(vector(), nrow = 12, ncol= 5,dimnames=list(c(), 
                     c("longitude", "latitude", "time", "A", "p.value"))),
                     stringsAsFactors=F)
    #Loop over 12 months for AD
    for(i in 1:12){
      P <- subset(lp[[79]], month == month[i], select = P)
      P <- P[,1]
      sh <- as.numeric(subset(lpara[[79]], time == time[i], select = shape))
      sc <- as.numeric(subset(lpara[[79]], time == time[i], select = scale))
      AD <- ad.test(P, "pgamma", shape= sh, rate = sc)
      results$A[i]<- AD[[1]]
      results$p.value[i] <- AD[[2]]
      
      results$longitude <- lpara[[79]][,1]
      results$latitude <- lpara[[79]][,2]
      results$time <- as.numeric(c(1:12))
    }

Теперь я хочу запустить l oop более чем на выборке списка и написать второй l oop:

    results <- lapply(seq_len(12000), function(x, nr = 12, nc = 5) {data.frame(matrix(,nrow=nr,      ncol=nc, dimnames=list(c(), c("longitude", "latitude", "time", "A", "p.value")))) })
    #Loop over 12000 Grids
    for(j in 1:12000){
    #Loop over 12 months for AD
    for(i in 1:12){
    P <- subset(lp[[j]], month == month[i], select = P)
    P <- P[,1]
    sh <- as.numeric(subset(lpara[[j]], time == time[i], select = shape))
    sc <- as.numeric(subset(lpara[[j]], time == time[i], select = scale))
    AD <- ad.test(P, "pgamma", shape= sh, rate = sc)
    
    results[[j]]$A[i]<- AD[[1]]
    results[[j]]$p.value[i] <- AD[[2]]
    
    results[[j]]$longitude <- lpara[[j]][,1]
    results[[j]]$latitude <- lpara[[j]][,2]
    results[[j]]$time <- as.numeric(c(1:12))
    }
    }

Это не работает, и я не знаю почему. Может кто мне поможет? Было бы здорово!

Answer 1

Рассмотрим поэлементный элемент l oop семейства apply , mapply (или его оболочку Map) с базовым lapply (заменяющим for) для построения фрейма данных. Вы также можете использовать tryCatch для учета исключений без остановки выполнения кода.

proc_adresults <- function(lp_df, lpara_df){    
   # BUILD LIST OF DATA FRAMES
   df_list <- lapply(1:12, function(i) {
      tryCatch({
          P  <- subset(lp_df, month == month[i])$P         # RETURN VECTOR FROM COL PICK 
          sh <- subset(lpara_df, time == time[i])$shape    # RETURN VECTOR FROM COL PICK
          sc <- subset(lpara_df, time == time[i])$scale    # RETURN VECTOR FROM COL PICk

          AD <- ad.test(P, "pgamma", shape= sh, rate = sc)

          data.frame(A = AD[[1]],                          # USE OBJ NAME AND NOT NUMBER
                     p.value   = AD[[2]],                  # USE OBJ NAME AND NOT NUMBER
                     longitude = lpara_df[,1][1],          # USE COL NAME AND NOT NUMBER
                     latitude  = lpara_df[,2][1],          # USE COL NAME AND NOT NUMBER
                     time = i,
                     error = NA)
      }, error = function(e)
           data.frame(A = NA, p.value = NA, 
                      longitude = lpara_df[,1][1], 
                      latitude  = lpara_df[,2][1],
                      time = i, error = as.character(e))  
      )  
   })

   # CONCATENATE ALL 12 ONE-ROW DFs INTO SINGLE DF
   do.call(rbind, df_list)
}

# EQUIVALENT CALLS
adresults_df_list <- Map(proc_adresults, lp, lpara)
adresults_df_list <- mapply(proc_adresults, lp, lpara, SIMPLIFY=FALSE)     

В качестве альтернативы рассмотрите by (объектно-ориентированная оболочка для tapply) после merge и избегайте subset звонков. То же самое выше Map / mapply звонки.

proc_adresults <- function(lp_df, lpara_df){ 
   # MERGE TO DATA FRAMES BY MONTH
   mdf <- merge(lp_df, lpara_df, by.x="month", by.y="time")

   # BUILD LIST OF DATA FRAMES
   df_list <- by(mdf, mdf$month, function(sub) {    
      tryCatch({
          AD <- ad.test(sub$P, "pgamma", shape= sub$sh[1], rate = sub$sc[1])

          data.frame(A = AD$statistic,
                     p.value   = AD$pv.value,
                     longitude = sub$longitude[1],
                     latitude  = sub$latitude[1],
                     time = sub$time[1],
                     error = NA)
      }, error = function(e)
           data.frame(A = NA, p.value = NA, 
                      longitude = sub$longitude[1], 
                      latitude  = sub$latitude[1],
                      time = sub$time[1], error = as.character(e))  
      )  
   })

   # CONCATENATE ALL 12 ONE-ROW DFs INTO SINGLE DF
   do.call(rbind, df_list)
}