Нелинейная дискретная оптимизация в R

Question

У меня простая (действительно стандартная по экономике) нелинейная ограниченная дискретная проблема максимизации для решения в R и у меня проблемы. Я нашел решения для деталей проблемы (нелинейная максимизация, дискретная максимизация), но не для объединения всех проблем.

В этом проблема. Потребитель хочет купить три продукта (ананас, банан, печенье), знает цены и имеет бюджет в 20 €. Ему нравится разнообразие (т. Е. Он хочет иметь все три продукта, если это возможно), и его удовлетворение уменьшается в потребляемом количестве (ему нравится его первый способ печенья больше, чем его 100-й).

Функция он хочет максимизировать это

и, конечно же, так как каждый из них имеет свою цену, и он имеет ограниченный бюджет, он максимизирует эту функцию при ограничении, что

Что я хочу сделать, так это найти оптимальный список покупок (N ananas, M bananas, K cookie), который удовлетворяет ограничению.

Если проблема была линейной, я бы просто использовал linprog :: solveLP(). Но объективная функция нелинейна. Если проблема носила непрерывный характер, то это было бы простым аналитическим решением.

Вопрос дискретный и нелинейный, я не знаю, как действовать.

Ниже приведены некоторые данные о игрушечной игре.

df <- data.frame(rbind(c("ananas",2.17),c("banana",0.75),c("cookie",1.34))) 
names(df) <- c("product","price") 

Я хотел бы иметь оптимизационную процедуру, которая дает мне оптимальный список покупок (N, M, K).

Любые подсказки?

Answer 1

1) нет пакетов Это может быть сделано грубой силой. Используя df с вопросом в качестве входных данных, убедитесь, что price является числовым (это фактор в df) и вычислить наибольшее число mx для каждой переменной. Затем создайте сетку g значений переменных и вычислите total цена каждого и связанного с ним objective, давая gg. Теперь соберите gg в порядке убывания цели и возьмите те решения, удовлетворяющие ограничению. head покажет лучшие решения.

price <- as.numeric(as.character(df$price)) 
mx <- ceiling(20/price) 
g <- expand.grid(ana = 0:mx[1], ban = 0:mx[2], cook = 0:mx[3]) 
gg <- transform(g, total = as.matrix(g) %*% price, objective = sqrt(ana * ban * cook)) 
best <- subset(gg[order(-gg$objective), ], total <= 20) 

дает:

> head(best) # 1st row is best soln, 2nd row is next best, etc. 
    ana ban cook total objective 
1643 3 9 5 19.96 11.61895 
1929 3 7 6 19.80 11.22497 
1346 3 10 4 19.37 10.95445 
1611 4 6 5 19.88 10.95445 
1632 3 8 5 19.21 10.95445 
1961 2 10 6 19.88 10.95445 

2) dplyr Это также может быть хорошо выражена с помощью пакета dplyr. Использование g и price сверху:

library(dplyr) 
g %>% 
    mutate(total = c(as.matrix(g) %*% price), objective = sqrt(ana * ban * cook)) %>% 
    filter(total <= 20) %>% 
    arrange(desc(objective)) %>% 
    top_n(6) 

даяние:

Selecting by objective 
    ana ban cook total objective 
1 3 9 5 19.96 11.61895 
2 3 7 6 19.80 11.22497 
3 3 10 4 19.37 10.95445 
4 4 6 5 19.88 10.95445 
5 3 8 5 19.21 10.95445 
6 2 10 6 19.88 10.95445 

Answer 2

Если вы не возражаете, используя "вручную" решение:

uf=function(x)prod(x)^.5 
bf=function(x,pr){ 
    if(!is.null(dim(x)))apply(x,1,bf,pr) else x%*%pr 
} 
budget=20 
df <- data.frame(product=c("ananas","banana","cookie"), 
       price=c(2.17,0.75,1.34),stringsAsFactors = F) 
an=0:(budget/df$price[1]) #include 0 for all possibilities 
bn=0:(budget/df$price[2]) 
co=0:(budget/df$price[3]) 
X=expand.grid(an,bn,co) 
colnames(X)=df$product 
EX=apply(X,1,bf,pr=df$price) 
psX=X[which(EX<=budget),] #1st restrict 
psX=psX[apply(psX,1,function(z)sum(z==0))==0,] #2nd restrict 
Ux=apply(psX,1,uf) 
cbind(psX,Ux) 
(sol=psX[which.max(Ux),]) 
uf(sol) # utility 
bf(sol,df$price) #budget 

> (sol=psX[which.max(Ux),]) 
    ananas banana cookie 
1444  3  9  5 
> uf(sol) # utility 
[1] 11.61895 
> bf(sol,df$price) #budget 
1444 
19.96 

Answer 3

Я думаю, что эта проблема очень похожа по своей природе на этот вопрос (Solve indeterminate equation system in R). Ответ на Richie Cotton послужил основой для этого возможного решения:

df <- data.frame(product=c("ananas","banana","cookie"), 
       price=c(2.17,0.75,1.34),stringsAsFactors = F) 

FUN <- function(w, price=df$price){ 
    total <- sum(price * w) 
    errs <- c((total-20)^2, -(sqrt(w[1]) * sqrt(w[2]) * sqrt(w[3]))) 
    sum(errs) 
} 

init_w <- rep(10,3) 
res <- optim(init_w, FUN, lower=rep(0,3), method="L-BFGS-B") 
res 
res$par # 3.140093 9.085182 5.085095 
sum(res$par*df$price) # 20.44192 

Обратите внимание, что общая стоимость (т.е. цена) для решения составляет $ 20,44. Чтобы решить эту проблему, мы можем взвешивать условие ошибки, чтобы уделять больше внимания на 1-й сроке, который относится к общей стоимости:

### weighting of error terms 
FUN2 <- function(w, price=df$price){ 
    total <- sum(price * w) 
    errs <- c(100*(total-20)^2, -(sqrt(w[1]) * sqrt(w[2]) * sqrt(w[3]))) # 1st term weighted by 100 
    sum(errs) 
} 

init_w <- rep(10,3) 
res <- optim(init_w, FUN2, lower=rep(0,3), method="L-BFGS-B") 
res 
res$par # 3.072868 8.890832 4.976212 
sum(res$par*df$price) # 20.00437 

Answer 4

Как LyzandeR заметил нет нелинейного целочисленного программирования решателя доступен в R. Вместо этого, вы можете использовать пакет R rneos, который отправляет данные одному из решателей NEOS и возвращает результаты в ваш процесс R.

Выберите один из решателей для «Смешанная целая нелинейная ограниченная оптимизация» на странице NEOS Solvers, например, Bonmin или Couenne.Для примера выше, отправить следующие файлы на языке моделирования AMPL к одному из этих решателей:

[Обратите внимание, что максимизация продукта x1 * x2 * x3 такого же, как максимизация продукта sqrt(x1) * sort(x2) * sqrt(x3).] Файл

Модели:

param p{i in 1..3}; 
var x{i in 1..3} integer >= 1; 
maximize profit: x[1] * x[2] * x[3]; 
subject to restr: sum{i in 1..3} p[i] * x[i] <= 20; 

файл данных:

param p:= 1 2.17 2 0.75 3 1.34 ; 

Командный файл:

solve; 
display x; 

и вы получите следующее решение:

x [*] := 
1 3 
2 9 
3 5 
; 

Этот подход будет работать для более протяженных примеров были решения «вручную» не являются разумными и закругленные optim решения не являются правильными.

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

Найти целочисленный вектор х = (X_i), г = 1, ..., 10, что максимизирует x1 * ... * x10, так что p1 * x1 + ... + p10 * x10 < = 10, где р = (p_i), г = 1, ..., 10, следующий вектор цен

p <- c(0.85, 0.22, 0.65, 0.73, 0.91, 0.11, 0.31, 0.47, 0.93, 0.71) 

Использование constrOptim для этой задачи нелинейной оптимизации с linear ограничение неравенства, я получаю решения типа 900 для разных начальных точек, но никогда не оптимальные решения это 960!