Loop через набор элементов в R

Question

Я пытаюсь сделать симуляцию проблемы линейного программирования. Модель имеет функцию obj и некоторые ограничения. В этом случае я вводил 2 значения, которые случайным образом вытягиваются из нормального распределения.

Затем я моделирую модель оптимизации 10.000 раз, используя for-loop. Я знаю, что это плохая практика R для использования for-loops, но скорость в этом случае не является моей проблемой.

#List of 10000 random, normally distributed observations: 
Demand = rnorm(10000, mean=5, sd=2.5) 
Demand 

Performance = rnorm(10000, mean=100, sd=6) 
Performance 

Optimas = NULL 

#combined_list = c(Demand, Performance) 

for (i in Performance){ 
    op <- OP(objective = c(2.5, 4, i),    #Performance value[i]: works fine 
      L_constraint(L = matrix(c(1, 0, 0,  #LHS 
             0, 1, 0,  
             0, 0, 1),  
             ncol=3, nrow = 3, 
             byrow = TRUE), 
          dir = c("<=", "<=", "<="), 
          rhs = c(50, 70, Demand)), #Demand value[i]: should go here 
       maximum = TRUE, 
       types = c("B", "I", "I")) 

    Optima <- ROI_solve(op, solver = "glpk") #solve 
    print(Optima) 
    print(i) 
    Optimas = rbind(Optimas, Optima) 
} 


Optimas <- as.data.frame(Optimas) 
Optimas$objval <- as.numeric(Optimas$objval) 
hist(Optimas$objval) 

Как показано выше, мой цикл не только идти корыто одну переменную (Performance), где я хочу значение спроса на ряд (I) в векторе Demand ввести в модель, в то же время, значение производительности для строки (i) в векторе производительности.

Общая цель состоит в том, чтобы иметь 10.000 симуляций модели LP, где как значения производительности, так и значения спроса появляются только один раз (в качестве другого цикла за пределами того, который у меня уже есть, будет производиться декартово произведение два списка).

Любая помощь будет высоко оценена.

Answer 1

Обратите внимание, что ваши Performance и Demand векторы содержат ровно столько же элементов. Следовательно, вы можете просто просто перебрать векторные индексы и использовать соответствующие значения индекса для извлечения соответствующих элементов.

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

dummyFunction <- function(perf, dem){ return (perf+dem)} 

В вашем конкретном случае использования, то dummyFunction будет содержать логику оптимизации. Далее, вы можете получить искомое решение следующим образом, перебора векторных индексов:

Optimas = vector(mode="numeric", length=length(Performance)) 
for(idx in 1:length(Performance)){ 
    Optimas[idx] <- dummyFunction(Performance[idx], Demand[idx]) 
} 

В качестве альтернативы, вы можете избежать определения функции, просто поместив вашу логику оптимизации внутри цикла for. Для более «R как решение» рассмотреть использование sapply функций типа/lapply:

Optimas <- sapply(1:length(Performance), function(idx) dummyFunction(Performance[idx], Demand[idx])) 

Обратите внимание, что в данном конкретном примере вы можете просто сделать следующее:

Optimas <- dummyFunction(Performance, Demand) 

Наконец, если производительность становится проблемой, рассмотрите возможность использования пакетов 10 и doparallel для одновременной работы оптимизаций на нескольких ядрах:

library(doParallel) 
library(foreach) 
nrCores <- detectCores() 
cl <- makeCluster(nrCores); registerDoParallel(cl) 
clusterExport(cl,c("Demand", "Performance", "dummyFunction"), envir=environment()) 
Optimas <- foreach(idx=1:length(Performance), .combine="rbind") %dopar%{ 
    dummyFunction(Performance[idx], Demand[idx]) 
} 
stopCluster(cl) 

Answer 2

Рассмотрите подход mapply(), примените функцию, которая выполняет итерацию по нескольким спискам/векторам, передающим соответствующие элементы. Сначала перенесите все операции в функцию, а затем вызовите ее в mapply(), передав два аргумента для векторов. В конце используйте lapply() для переноса в длинный список фреймов данных, которые привязаны к строке с помощью do.call(rbind...).

Performance = rnorm(10000, mean=100, sd=6) 
Demand = rnorm(10000, mean=5, sd=2.5) 

optimizefct <- function(p, d){ 
    op <- OP(objective = c(2.5, 4, p),    # Performance 
      L_constraint(L = matrix(c(1, 0, 0,  # LHS 
            0, 1, 0,  
            0, 0, 1),  
            ncol=3, nrow = 3, 
            byrow = TRUE), 
         dir = c("<=", "<=", "<="), 
         rhs = c(50, 70, d)),  # Demand 
      maximum = TRUE, 
      types = c("B", "I", "I")) 

    Optima <- ROI_solve(op, solver = "glpk") #solve 
    print(Optima) 
    print(i) 

    return(Optima) 
} 

# WIDE FORMAT 
dfList <- mapply(optimizefct, Performance, Demand) 

# LONG FORMAT 
dfList <- lapply(1:10000, function(i) data.frame(dfList[,i])) 

# BIND TO FINAL DF 
Optimas <- do.call(rbind, dfList) 
Optimas$objval <- as.numeric(Optimas$objval)