RStudio не отвечает большой линейной оптимизацией

У меня есть большая проблема двухэтапной оптимизации, которую я попытался упростить для этого вопроса. Первый шаг — выбрать 10 элементов, чтобы максимизировать полезность при определенных ограничениях. Мне нужно 200 таких наборов, но из-за характера того, что я пытаюсь сделать, нужно сгенерировать 600, чтобы можно было проявить правильные комбинации.

Обертывание этих проблем мини-оптимизации является большим ограничением, когда каждый отдельный элемент может использоваться только в определенном диапазоне. Первая оптимизация настраивает полезность каждого элемента так, чтобы каждый из них был относительно близок к границам, но невозможно, чтобы все они находились в пределах своих границ. Поэтому вторым шагом является выбор 200 из 600 наборов таким образом, чтобы удовлетворялось минимальное/максимальное использование каждого отдельного элемента. Вот в чем мне нужна помощь.

Я сделал функцию, используя lpSolve, которая работает, но более чем в 80% случаев она зависает в RStudio, и это становится слишком хлопотным — мне нужно либо улучшить мой текущий подход, либо мне нужен совершенно новый подход. Я не знаю, действительно ли lpSolve является лучшим подходом для начала. Хотя у меня есть общая оценка набора, которую я могу максимизировать, все, о чем я действительно забочусь, это чтобы каждый элемент находился в пределах границ. Я сделал упрощенный пример, чтобы понять суть моей проблемы.

Я отвечаю за приготовление 200 блюд из набора из 80 разных фруктов. В каждом приеме пищи используется 10 фруктов и не может быть более 1 одного и того же фрукта. Я ограничен в количестве фруктов, которые у меня есть (и мой босс заставляет меня использовать минимум каждого фрукта, иначе они испортятся), поэтому они должны быть в определенных пределах. У меня есть список из 600 уже созданных блюд (Meals), и у каждого из них есть свой уникальный показатель здоровья. В идеале я хотел бы максимизировать показатель здоровья, но, очевидно, наиболее важным моментом является то, что каждый фрукт используется правильное количество раз, иначе еда не может быть приготовлена ​​в первую очередь.

Вот мой код: 1) Настроить 600 приемов пищи (случайно) 2) Установить минимальное/максимальное время использования каждого фрукта (случайно) 3) Запустить линейную оптимизацию, чтобы выбрать 200 из 600 приемов пищи, чтобы выполнялись ограничения по отдельным фруктам. . Программа пытается выбрать 200 из 600, но если ограничения не позволяют этого, то она ослабляет ограничения (например, если решатель не работает в первый раз, я уменьшу минимальное количество раз, которое Apple можно использовать, и увеличьте максимальное количество раз, которое можно использовать). Он делает это по одному фрукту за раз, а не все сразу. В конце концов, ограничения должны быть ослаблены настолько, чтобы работали любые 200 из 600 (т. е. когда minPercent всех фруктов меньше 0, а maxPercent всех фруктов больше 100), но это не имеет значения, потому что R зависает.

library(stringr)
library(dplyr)
library(lpSolve)

# Inputs
MealsNeeded <- 200
Buffer <- 3

# Setup the meals (this is the output of another optimizer in my actual program. Considered "Step 1" as I mentioned above)
Meals <- data.frame()
for(i in 1:(MealsNeeded*Buffer)){

  run <- i
  meal <- sample(fruit, 10)
  healthFactor <- round(runif(1, 10, 30), 0) #(Health factor for the entire meal)

  df <- data.frame(Run = run, Fruit = meal, healthFactor = healthFactor, stringsAsFactors = FALSE)

  Meals <- rbind(Meals, df)

}

# The minimum/maximum number of times each fruit must be used across all 200 meals (these would be inputs in my program)
set.seed(11)
fruitDF <- data.frame(Name = fruit, minSelectPct = round(runif(length(fruit), .05, .1)*100, 0), stringsAsFactors = FALSE) %>% 
  mutate(maxSelectPct = round(minSelectPct/2 + runif(length(fruit), .05, .1)*100, 0))

#### Actual Program Start

# Get objective
obj <- Meals %>% 
  distinct(Run, healthFactor) %>% 
  ungroup() %>% 
  select(healthFactor) %>% 
  pull()

# Dummy LU - for each fruit give 1/0 whether or not they were in the meal
dummyLUInd <- data.frame(FruitName = fruitDF$Name, stringsAsFactors = FALSE)
for(i in unique(Meals$Run)){

  selectedFruit <- Meals %>%
    filter(Run == i) %>% 
    select(Fruit) %>% 
    mutate(Indicator = 1)

  dummyLUIndTemp <- fruitDF %>% 
    left_join(selectedFruit, by = c('Name' = 'Fruit')) %>% 
    mutate(Indicator = ifelse(is.na(Indicator), 0, Indicator)) %>% 
    select(Indicator)

  dummyLUInd <- cbind(dummyLUInd, dummyLUIndTemp)
}

## Table create
dummyLUInd <- rbind(dummyLUInd, dummyLUInd)[,-1]
dummyLUInd <- as.data.frame(t(dummyLUInd))
dummyLUInd$Total = 1

## Directions
dirLT <- c(rep('<=', (ncol(dummyLUInd)-1)/2))
dirGT <- c(rep('>=', (ncol(dummyLUInd)-1)/2))
## Multiply percentages by total Meals
MinExp = round(fruitDF$minSelectPct/100 * MealsNeeded - 0.499, 0) 
MaxExp = round(fruitDF$maxSelectPct/100 * MealsNeeded + 0.499, 0)

# Setup constraints like # of tries
CounterMax <- 10000
LPSum = 0
Counter = 0

# Create DF to make it easier to change constraints for each run
MinExpDF <- data.frame(Place = 1:length(MinExp), MinExp = MinExp)
MaxExpDF <- data.frame(Place = 1:length(MaxExp), MaxExp = MaxExp)
cat('\nStarting\n')
Sys.sleep(2)

# Try to get the 200 of 600 Meals that satisfy the constraints for the individual Fruit.
# If the solution doesn't exist, loosen the constraints for each fruit (one at a time) until it does work
while (LPSum == 0 & Counter <= CounterMax) {
  rowUse <- Counter %% length(MaxExp)

  # Knock one of minimum, starting with highest exposure, one at a time
  MinExpDF <- MinExpDF %>%
    mutate(Rank = rank(-MinExp, na.last = FALSE, ties.method = "first"),
           MinExp = ifelse(Rank == rowUse, MinExp - 1, MinExp)
    )
  MinExp <- MinExpDF$MinExp

  # Add one of maximum, starting with highest exposure, one at a time
  MaxExpDF <- MaxExpDF %>%
    mutate(Rank = rank(-MaxExp, na.last = FALSE, ties.method = "first"),
           MaxExp = ifelse(Rank == rowUse, MaxExp + 1, MaxExp))
  MaxExp <- MaxExpDF$MaxExp


  # Solve
  dir <- 'max'
  f.obj <- obj
  f.mat <- t(dummyLUInd)
  f.dir <- c(dirGT, dirLT, '==')
  f.rhs <- c(MinExp, MaxExp, MealsNeeded)
  Sol <- lp(dir, f.obj, f.mat, f.dir, f.rhs, all.bin = T)$solution
  LPSum <- sum(Sol)

  Counter = Counter + 1
  if(Counter %% 10 == 0) cat(Counter, ', ', sep = '')
}

# Get the Run #'s from the lpSolve
if(Counter >= CounterMax){
  cat("Unable to find right exposure, returning all Meals\n")
  MealsSolved <- Meals
} else {
  MealsSolved <- data.frame(Run = unique(Meals$Run))
  MealsSolved$selected <- Sol
  MealsSolved <- MealsSolved[MealsSolved$selected == 1,]
}
# Final Meals
FinalMeals <- Meals %>% 
  filter(Run %in% MealsSolved$Run)

Если вы запустите этот код достаточное количество раз, в конечном итоге RStudio зависнет (по крайней мере, для меня, если не для вас, я полагаю, увеличьте количество приемов пищи). Это происходит во время фактического lp, поэтому вы мало что можете сделать, так как это действительно код C. Вот где я потерялся.

Часть меня думает, что на самом деле это не проблема lpSolve, поскольку я на самом деле не пытаюсь максимизировать что-либо (Фактор здоровья не так уж важен). Моя реальная «функция потерь» — это количество раз, когда каждый фрукт поднимается выше/ниже своей минимальной/максимальной экспозиции, но я не могу придумать, как настроить что-то подобное. Может ли мой текущий подход работать, или мне нужно сделать что-то совершенно другое?