Автоматическое создание и использование пользовательской функции в R-in для каждого цикла - сохранение результата в одном массиве DF - 3D

Question

несколько дней назад я задал эту тему о вызове пользовательской функции в цикле, которая была хорошо решена комбинацией

 eval(parse(text = Function text))

, вот ссылка: Автоматическое создание и использование пользовательскихсделал функцию в R .Это позволило мне работать с for loop и автоматически вызывать нужную мне функцию из фрейма данных, хранящего тело создаваемой функции.

Теперь я хотел бы перенести вопрос на следующий уровень.Моя проблема - время вычислений.Мне нужно оценить что-то вроде 52 показателей по гиперспектральному изображению.это означает, что в R мое гиперспектральное изображение загружается в виде трехмерного массива 512x512x204 полос.

Я хотел бы параллельно выполнять оценку индексов, чтобы сократить время вычислений.Вот фиктивный пример того, что я хотел бы подражать, но не в параллельных вычислениях.

# create a fake  matrix rappresenting my Hyperpectral image
HYPR_IMG=array(NA,dim=c(5,3,4))
HYPR_IMG[,,1]=1
HYPR_IMG[,,2]=2
HYPR_IMG[,,3]=3
HYPR_IMG[,,4]=4

image.plot(HYPR_IMG[,,1], zlim=c(0,20))
image.plot(HYPR_IMG[,,2], zlim=c(0,20))
image.plot(HYPR_IMG[,,3], zlim=c(0,20))
image.plot(HYPR_IMG[,,4], zlim=c(0,20))




#create a fake DF for simulating my indices stored in the dataframe
IDXname=c("IDX1","IDX2","IDX3","IDX4")
IDXFunc=c("HYPR_IMG[,,1] + 3*HYPR_IMG[,,2]",
          "HYPR_IMG[,,3] + HYPR_IMG[,,2]",
          "HYPR_IMG[,,4] + HYPR_IMG[,,2] - HYPR_IMG[,,3]",
          "HYPR_IMG[,,1] + HYPR_IMG[,,4] + 4*HYPR_IMG[,,2] + HYPR_IMG[,,3]")
IDX_DF=as.data.frame(cbind(IDXname,IDXFunc))


# that was what I did before
Store_DF=data.frame(NA)
for (i in 1: length(IDX_DF$IDXname)) {
  IDX_ID=IDX_DF$IDXname[i]
  IDX_Fun_tmp=IDX_DF$IDXFunc[which(IDX_DF$IDXname==IDX_ID)] #use for extra care to select the right fuction
  IDXFunc_call=paste("IDXfun_tmp=function(HYPR_IMG){",IDX_Fun_tmp,"}",sep="")
  eval(parse(text = IDXFunc_call))
  IDX_VAL=IDXfun_tmp (HYPR_IMG)
  image.plot(IDX_VAL,zlim=c(0,20)); title(main=IDX_ID) 
  temp_DF=as.vector(IDX_VAL)
  Store_DF=cbind(Store_DF,temp_DF)
  names(Store_DF)[i+1] <- as.vector(IDX_ID)
}

Моя конечная цель - получить тот же самый Store_DF, хранящий все значения индексов.Здесь у меня есть цикл for, но использование цикла foreach должно ускорить процесс.При необходимости я работаю с Windows 8 или более как ОС.

Это действительно возможно?Смогу ли я в конце сократить общее вычислительное время, имея тот же Store_DF фрейм данных или что-то похожее на матрицу с именами столбцов?

Большое спасибо !!!

Answer 1

Для конкретного примера может быть более полезным использование параллелизации сборки пакета, такого как data.table или параллельного применения.Ниже приведен минимальный пример того, как достичь результатов, используя parApply из пакета parallel.Обратите внимание, что вывод - это матрица, которая на самом деле дает немного лучшую производительность в базе R (не обязательно в tidyverse или data.table).В случае, если структура data.frame является жизненно важной, вам придется преобразовать ее в data.frame.

cl <- parallel::makeCluster( parallel::detectCores() )
result <- parallel::parApply(cl = cl, X = IDX_DF, MARGIN = 1, FUN = function(x, IMAGES){
  IDX_ID <- x[["IDXname"]]
  eval(parse(text = paste0("IDXfun_tmp <- function(HYPR_IMG){", x[["IDXFunc"]], "}")))
  IDX_VAL <- as.vector(IDXfun_tmp(IMAGES))
  names(IDX_VAL) <- IDX_ID
  IDX_VAL
}, IMAGES = HYPR_IMG)
colnames(result) = IDXname
IDXname
parallel::stopCluster(cl)

. Обратите внимание на stopCluster(cl), что важно для закрытия любых свободных сеансов R.Результаты тестов (4 крошечных ядра):

Unit: milliseconds
     expr      min       lq      mean   median       uq      max neval
     Loop 8.420432 9.027583 10.426565 9.272444 9.943783 26.58623   100
 Parallel 1.382324 1.491634  2.038024 1.554690 1.907728 18.23942   100

Для копий тестов приведен код ниже:

cl <- parallel::makeCluster( parallel::detectCores() )
microbenchmark::microbenchmark(
  Loop = {
    Store_DF=data.frame(NA)
    for (i in 1: length(IDX_DF$IDXname)) {
      IDX_ID = IDX_DF$IDXname[i]
      IDX_Fun_tmp = IDX_DF$IDXFunc[which(IDX_DF$IDXname == IDX_ID)] #use for extra care to select the right function
      eval(parse(text = paste0("IDXfun_tmp = function(HYPR_IMG){", IDX_Fun_tmp, "}")))
      IDX_VAL = IDXfun_tmp(HYPR_IMG)
      #Plotting in parallel is not a good idea. It will most often not work but might make the R session crash or slow down significantly (at best the latter at worst the prior)
      #image.plot(IDX_VAL, zlim = c(0,20)); title(main = IDX_ID) 
      temp_DF = as.vector(IDX_VAL)
      Store_DF = cbind(Store_DF,temp_DF)
      names(Store_DF)[i+1] <- as.vector(IDX_ID)
    }
    rm(Store_DF)
  },
  Parallel = {
    result <- parallel::parApply(cl = cl, X = IDX_DF, MARGIN = 1, FUN = function(x, IMAGES){
      IDX_ID <- x[["IDXname"]]
      eval(parse(text = paste0("IDXfun_tmp <- function(HYPR_IMG){", x[["IDXFunc"]], "}")))
      IDX_VAL <- as.vector(IDXfun_tmp(IMAGES))
      names(IDX_VAL) <- IDX_ID
      IDX_VAL
    }, IMAGES = HYPR_IMG)
    colnames(result) = IDXname
    rm(result)
  }
)
parallel::stopCluster(cl)

Редактировать: Использование пакета foreach

ПослеНесколько комментариев о проблемах производительности (возможно, из-за памяти), я решил сделать иллюстрацию того, как можно получить тот же результат, используя пакет foreach.Несколько замечаний:

1. Пакет foreach использует итераторы.Стандартно его можно использовать как цикл for, где он будет перебирать каждый столбец в data.frame
2. Как и в других параллельных реализациях в R, если вы работаете в Windows, часто вам придется экспортировать данныеиспользуется для расчетов.Иногда этого можно избежать с помощью некоторой путаницы, и foreach иногда позволит вам не экспортировать данные.Если это так, неясно из документации.
3. Вывод foreach будет объединен либо в виде списка, либо как определено аргументом .combine, который может быть rbind, cbind или любой другой функцией.
4. Существует множество комментариев, благодаря которым код кажется намного длиннее, чем он есть на самом деле.Удаляя комментарии и пустые строки, это на 9 строк длиннее.

Ниже приведен код, который даст тот же результат, что и выше.Обратите внимание, что я использовал пакет data.table.Для получения дополнительной информации об этом пакете я предлагаю их википедию на github.

cl <- parallel::makeCluster( parallel::detectCores() )
#Foeach uses doParallel for the parallization
doParallel::registerDoParallel(cl)
#To iterate over the rows, we need to use iterators 
# if foreach is given a matrix it will be converted to a column iterators
rowIterator <- iterators::iter(IDX_DF, by = "row") 
library(foreach)
result <- 
  foreach(
        #Supply the iterator
        row = rowIterator, 

        #Specify if the calculations needs to be in order. If not then we can get better performance not doing so
        .inorder = FALSE, 

        #In most foreach loops you will have to export the data you need for the calculations
        # it worked without doing so for me, in which case it is faster if the exported stuff is large
        #.export = c("HYPR_IMG"), 

        #We need to say how the output should be merged. If nothing is given it will be output as a list
        #data.table rbindlist is faster than rbind (returns a data.table)

        .combine = function(...)data.table::rbindlist(list(...)) ,
        #otherwise we could've used:
        #.combine = rbind 

        #if we dont use rbind or cbind (i used data.table::rbindlist for speed)
        # we will have to tell if it can take more than 1 argument 
        .multicombine = TRUE

        ) %dopar% #Specify how to do the calculations. %do% loop. %dopar% parallel loop. %:% nested loops (next foreach tells how we do the loop)
{ #to do stuff in parallel we use the %dopar%. Alternative %do%. For multiple foreach we split each of them by %:%

  IDX_ID <- row[["IDXname"]]
  eval(parse(text = paste0("IDXfun_tmp <- function(HYPR_IMG){", row[["IDXFunc"]], "}")))
  IDX_VAL <- as.vector(IDXfun_tmp(HYPR_IMG))
  data.frame(ID = IDX_ID, IDX_VAL)
}
#output is saved in result
result
result_reformatted <- dcast(result[,indx := 1:.N, by = ID], 
                            indx~ID, 
                            value.var = "IDX_VAL")
#if we dont want to use data.table we could use unstack instead
unstack(test, IDX_VAL ~ ID)