Affectation avec l'ompr de R ou une autre fonction d'optimisation

Question

Vous vous demandez si cela peut être résolu avec le omprRpackage (ou toute autre optimisation package). J'ai des traitements n et m lignes de cellules, et pour chaque traitement: paire de cellules j'ai effectué une expérience où la lecture est la sensibilité de la lignée cellulaire au traitement.

Maintenant je dois lancer une expérience de confirmation où je dois choisir i traitements où pour chaque que je dois prendre j sensible et j lignées cellulaires non sensibles (dans mon cas i = 40 et j = 4). Dans cette expérience de confirmation, je cours les traitements et les lignées cellulaires sur la même plaque, donc mon objectif est de minimiser le nombre total de lignées cellulaires.

Je me demande si cela peut être traduit en termes d'un assignment problem que le R ompr peut résoudre?

Answer 1

Étant donné que j'ai interprété votre problème correctement, je l'ai modélisé en utilisant ompr. Si je vous ai bien compris, vous voulez faire correspondre un sous-ensemble de traitements aux lignées cellulaires. Chaque traitement doit être adapté à deux lignées cellulaires sensibles et à deux lignées cellulaires non sensibles. Je suppose en outre, que les lignées cellulaires peuvent être partagées entre les traitements, sinon il n'y a pas besoin de minimiser le nombre de lignées cellulaires.

Tout d'abord, nous devons créer les données d'entrée pour le modèle. J'utilise la notation que vous avez choisie dans votre question.

# 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 

En outre, je crée deux fonctions d'aide qui seront utiles plus tard lors de la formulation du modèle.

# 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) 
} 

Maintenant le modèle. J'ai ajouté des commentaires en ligne pour décrire les contraintes/variables de décision. S'il vous plaît utilisez la version la plus récente de ompr. Étant donné le modèle, nous pouvons le résoudre en utilisant GLPK par exemple.

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) 

Étant donné le modèle, nous pouvons le résoudre en utilisant GLPK par exemple. Veuillez noter que le modèle peut prendre beaucoup de temps avec les paramètres les plus grands.

# 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"))