使用R的ompr或其他優化功能進行分配

Question

想知道是否可以使用ompr R package （或任何其他優化package ）解決此問題。

我有n治療方法和m細胞系，對於每種治療方法：細胞系對，我進行了一項實驗，其中讀數是細胞系對治療的敏感性。

現在，我需要進行驗證性實驗，在這里我需要選擇i治療方法，每種治療方法都需要選擇j敏感和j非敏感細胞系（在我的情況下， i = 40， j = 4）。 在此驗證性實驗中，我將治療和細胞系放在同一板上運行，因此我的目標是最大程度地減少細胞系的總數。

我想知道這是否可以翻譯成R ompr可以解決的分配問題 ？

Answer 1

鑒於我正確解釋了您的問題，因此我使用ompr對其進行了ompr 。 如果我對您的理解正確，則希望將治療的子集與細胞系進行匹配。 每種處理應與兩個敏感細胞系和兩個非敏感細胞系匹配。 我進一步假設，細胞系可在治療之間共享，否則無需最小化細胞系的數量。

首先，我們需要為模型創建輸入數據。 我使用您在問題中選擇的表示法。

# For testing I chose small numbers.
# Number of treatments
n <- 10
# Number of cell lines
m <- 10
# Number of treatments for confirmatory experiment
i <- 4

# simulation of treatment results
# a data.frame with a sensitivity result for each treatment/cell_line combination.
# the result is either TRUE (sensitive) or FALSE (not sensitive)
treatment_results <- expand.grid(treatment = 1:n, cell_line = 1:m)
treatment_results$result <- runif(nrow(treatment_results)) < 0.3

另外，我創建了兩個輔助函數，這些函數將在以后制定模型時派上用場。

# helper function to identify positive or negative 
# treatment/cell_line combinations in order to make the modelling easier to read
is_sensitive <- function(k, j) {
  purrr::map_lgl(j, function(j) {
    record <- treatment_results$treatment == k & treatment_results$cell_line == j
    treatment_results[record, "result"]
  })
}
is_not_sensitive <- function(k, j) {
  !is_sensitive(k, j)
}

現在是模型。 我添加了內聯注釋來描述約束/決策變量。 請使用ompr最新版本。

library(ompr)
library(magrittr)
model <- MIPModel() %>%

  # 1 if treatment k is applied to cell_line j
  add_variable(x[k, j], k = 1:n, j = 1:m, type = "binary") %>%

  # 1 if treatment k is selected for confirmatory experiment
  add_variable(y[k], k = 1:n, type = "binary") %>%

  # 1 if cell_line j is used
  add_variable(z[j], j = 1:m, type = "binary") %>%

  # minimize the number of assigned cell lines
  set_objective(sum_expr(z[j], j = 1:m), direction = "min") %>%

  # we want to test i treatments
  add_constraint(sum_expr(y[k], k = 1:n) == i) %>%

  # each tested treatment has to have 2 sensitive and 2 non-sensitive cell lines
  # 2 sensitives
  add_constraint(sum_expr(x[k, j], j = 1:m, is_sensitive(k, j)) == 2 * y[k]
                 , k = 1:n) %>%
  # 2 not sensitives
  add_constraint(sum_expr(x[k, j], j = 1:m, is_not_sensitive(k, j)) == 2 * y[k]
                 , k = 1:n) %>%

  # last constraint is to mark cell lines as being assigned for the obj. fun.
  add_constraint(sum_expr(x[k, j], k = 1:n) <= n * z[j], j = 1:m)

給定模型，我們可以使用GLPK進行求解。 請注意，使用較大參數的模型可能需要很長時間。

# you can solve the model using GLPK for example
library(ompr.roi)
library(ROI.plugin.glpk)
result <- solve_model(model, with_ROI("glpk", verbose = TRUE))

# let's examine the solution
library(dplyr)
# this is the list of treatments selected for testing
filter(get_solution(result, y[k]), value > 0)$k

# this is the list of cell_lines selected for testing
filter(get_solution(result, z[j]), value > 0)$j

# the actual matching of treatment and cell_line is in the x variable
get_solution(result, x[k, j]) %>%
  filter(value > 0) %>%
  inner_join(treatment_results, by = c("k" = "treatment", "j" = "cell_line"))