У меня есть большая проблема двухэтапной оптимизации, которую я попытался упростить для этого вопроса.Первый шаг - выбрать 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, так как я на самом деле не пытаюсь максимизировать что-либо (Фактор здоровья не слишком важен),Моя настоящая «функция потерь» - это количество раз, когда каждый фрукт поднимается выше / ниже минимальной / максимальной экспозиции, но я не могу придумать, как настроить что-то подобное.Может ли мой текущий подход работать или мне нужно сделать что-то совсем другое?