Как использовать R для обратного решения, какие числа суммируются до итога (как бинарный Солвер в Excel) - PullRequest
Новая
       13

Как использовать R для обратного решения, какие числа суммируются до итога (как бинарный Солвер в Excel)

0 голосов
/ 23 апреля 2019

У меня есть некоторые данные о продажах по продуктам и странам.

У меня также есть промежуточный итог, описанный как «Другие продукты». Я хотел бы решить и определить, какие продукты были включены в промежуточный итог «Другие продукты».

Эту проблему можно решить с помощью функции Solver в Excel. Однако набор данных слишком велик, что приводит к сбою Excel.

Я надеюсь, что есть какой-то способ решить это в R?

Некоторые примеры данных: 

data <- matrix(c(0,10,0,5,0,3,6,2,0,1), nrow = 5)
rownames(data) <- c("A", "B", "C", "D", "E")
colnames(data) <- c("USA", "Canada")

Затем с промежуточными итогами 10 и 8 для США и Канады ответом будут продукты B и C.

У меня есть еще одно осложнение: мои промежуточные итоги представляют собой округленные числа, а необработанные данные не обоснованы. Поэтому в идеале нужно решение, которое допускает некоторую погрешность.

Обновление (моя попытка использовать CVXR): 

data <- data.matrix(read.csv("goalseek.csv", header=TRUE, row.names = 1))
goal <- as.numeric(t(read.csv("target.csv", header=TRUE)))

nr <- nrow(data)
nc <- ncol(data)

'Quadratic Optimisation'
b <- Bool(nr)
objective <- Minimize( sum((t(data) %*% b - goal)^2) )
problem <- Problem(objective)
soln <- solve(problem)

rownames(data)[round(soln$getValue(b)) == 1]

1 Ответ

1 голос
/ 23 апреля 2019

1) lpSolve Используйте следующую задачу смешанного целочисленного программирования.Обратите внимание, что мы добавляем фиктивные переменные для каждого столбца, каждый из которых находится между 0 и 0,5, и дополнительные фиктивные переменные, которые находятся между 0 и -0,5, для обработки округления. 

library(lpSolve)

nr <- nrow(data)
nc <- ncol(data)

objective <- c(numeric(nr), rep(1, nc + nc))

const.mat <- rbind(cbind(t(data), diag(nc), -diag(nc)),
                   cbind(0 * t(data), diag(nc), 0 * diag(nc)),
                   cbind(0 * t(data), 0 * diag(nc), diag(nc)))
const.dir <- c(rep("=", nr), rep("<=", 2 * nc))
const.rhs <- c(10, 8, rep(.5, nc + nc))

res <- lp(objective.in = objective, const.mat = const.mat, const.dir = "=", 
  const.rhs = const.rhs, binary.vec = 1:nc)
rownames(data)[res$solution == 1]
## [1] "B" "C"

2) CVXR При этом используется квадратичная оптимизация по двоичным переменным: 

library(CVXR)

b <- Bool(nr)
objective <- Minimize( sum((t(data) %*% b - c(10, 8))^2) )
problem <- Problem(objective)
soln <- solve(problem)

rownames(data)[round(soln$getValue(b)) == 1]
## [1] "B" "C"

Обновление

Добавлена ​​возможность в (1) для обработки округления.Добавлено (2).

...