1

スケジューリングの問題を解決するために、lpSolveAPI と R を使用して線形計画法ソリューションをセットアップしようとしています。以下は、データの小さなサンプルです。各セッション ID に必要な分数と、それらの「優先」順序/重み。

id <- 1:100
min <- sample(0:500, 100)
weight <- (1:100)/sum(1:100)
data <- data.frame(id, min, weight)

私がやりたいことは、これらのセッション ID を調整/スケジュールして、1 日に最大数のセッションがあり、できればその重みで、1 日が合計 400 分に制限されるようにすることです。

これは、現在Rで設定した方法です：

require(lpSolveAPI)

#Set up matrix to hold results; each row represents day
r <- 5
c <- 10
row <- 1

results <- matrix(0, nrow = r, ncol = c)
rownames(results) <- format(seq(Sys.Date(), by = "days", length.out = r), "%Y-%m-%d")

for (i in 1:r){
    for(j in 1:c){  
        lp <- make.lp(0, nrow(data)) 
        set.type(lp, 1:nrow(data), "binary")
        set.objfn(lp, rep(1, nrow(data)))
        lp.control(lp, sense = "max")
        add.constraint(lp, data$min, "<=", 400)
        set.branch.weights(lp, data$weight)

        solve(lp)
        a <- get.variables(lp)*data$id
        b <- a[a!=0]

        tryCatch(results[row, 1:length(b)] <- b, error = function(x) 0)

        if(dim(data[!data$id == a,])[1] > 0) {
            data <- data[!data$id== a,]
            row <- row + 1
        }
        break

    }
}

sum(results > 0)    

barplot(results) #View of scheduled IDs

結果のマトリックスをざっと見てみると、セットアップはセッション数を最大化して 1 日の合計時間が 400 分にできるだけ近くなるように機能しますが、セットアップは与えられた重みに従っていないことがわかります。結果マトリックスは、増加するセッション ID で満たされることを期待しています。

さまざまな重み、逆の順序などの重みを割り当てようとしましたが、何らかの理由で、セットアップが「set.branch.weights」を強制していないようです。

「set.branch.weights」のドキュメントを読みましたが、lpSolveAPIここで何か間違っていると思います。

例 - データ:

   id   min weight
    1   67  1
    2   72  2
    3   36  3
    4   91  4
    5   80  5
    6   44  6
    7   76  7
    8   58  8
    9   84  9
    10  96  10
    11  21  11
    12  1   12
    13  41  13
    14  66  14
    15  89  15
    16  62  16
    17  11  17
    18  42  18
    19  68  19
    20  25  20
    21  44  21
    22  90  22
    23  4   23
    24  33  24
    25  31  25

する必要があります

    Day 1   67  72  36  91  80  44  76          
    Day 2   58  84  96  21  1   41  66  89      
    Day 3   62  11  42  68  25  44  90  4   33  31

毎日の累積合計は <= 480m です。

4

2 に答える 2

1

私の単純なアプローチ：

df = read.table(header=T,text="
 id   min weight
  1   67  1
  2   72  2
  3   36  3
  4   91  4
  5   80  5
  6   44  6
  7   76  7
  8   58  8
  9   84  9
  10  96  10
  11  21  11
  12  1   12
  13  41  13
  14  66  14
  15  89  15
  16  62  16
  17  11  17
  18  42  18
  19  68  19
  20  25  20
  21  44  21
  22  90  22
  23  4   23
  24  33  24
  25  31  25")
# assume sorted by weight 

daynr = 1
daymax = 480
dayusd = 0
for (i in 1:nrow(df))
{
  v = df$min[i]
  dayusd = dayusd + v
  if (dayusd>daymax)
  {
    daynr = daynr + 1
    dayusd = v
  }
  df$day[[i]] = daynr
}

これにより、次のようになります。

 > df
    id min weight day
 1   1  67      1   1
 2   2  72      2   1
 3   3  36      3   1
 4   4  91      4   1
 5   5  80      5   1
 6   6  44      6   1
 7   7  76      7   1
 8   8  58      8   2
 9   9  84      9   2
 10 10  96     10   2
 11 11  21     11   2
 12 12   1     12   2
 13 13  41     13   2
 14 14  66     14   2
 15 15  89     15   2
 16 16  62     16   3
 17 17  11     17   3
 18 18  42     18   3
 19 19  68     19   3
 20 20  25     20   3
 21 21  44     21   3
 22 22  90     22   3
 23 23   4     23   3
 24 24  33     24   3
 25 25  31     25   3
 >
于 2016-01-18T12:07:57.360 に答える
0

最初の解決に集中します。基本的に、ナップザック問題 (目的 + 1 つの制約) を解決します。

ここに画像の説明を入力

このモデルをそのまま実行すると、次のようになります。

> solve(lp)
[1] 0
> x <- get.variables(lp)
> weightx <- data$weight * x
> sum(x)
[1] 14
> sum(weightx)
[1] 0.5952381

今、目的を変更すると

ここに画像の説明を入力

私は得る：

> solve(lp)
[1] 0
> x <- get.variables(lp)
> weightx <- data$weight * x
> sum(x)
[1] 14
> sum(weightx)
[1] 0.7428571

つまり、カウントは 14 にとどまりましたが、重量は改善されました。

于 2016-01-14T05:37:13.547 に答える