Ограничение балансировки сетевого потока в R - PullRequest
Новая
       2

Ограничение балансировки сетевого потока в R

0 голосов
/ 11 декабря 2018

Я немного растерялся, начав с задачи о минимальном потоке затрат в R. На мой взгляд, приведенное ниже ограничение является «классическим» (сумма входов минус сумма выходов равна вектору спроса-предложения) и не должна бытьтрудно найти - в разреженной нотации (я бы хотел избежать матрицы перехода, как здесь: Поток минимальной стоимости - оптимизация сети в R ).У меня вопрос, как это ограничение баланса потока может быть реализовано в R или есть пример кодирования, который я упустил?

enter image description here

1 Ответ

0 голосов
/ 11 декабря 2018

Вот пример потока минимальных затрат с использованием igraph и Rsymphony с разреженной матрицей (пакет slam):

С учетом этого ввода: 

library(igraph)
nodes <- data.frame(name=paste0("N",1:8),
                    supply=c(10,20,0,-5,0,0,-15,-10))

edges <- data.frame(nodefrom = paste0("N",c( 1, 2, 2, 2, 3, 3, 4, 5, 5, 6, 7)),
                    nodeto   = paste0("N",c( 4, 1, 3, 6, 4, 5, 7, 6, 7, 8, 8)),
                    cost     = c( 2, 1, 0, 6, 1, 4, 5, 2, 7, 8, 9),
                    capacity = c(15,10,10,10, 5,10,10,20,15,10,15),
                    name     = paste0("E",1:11))
G <- graph.data.frame(edges)
V(G)$supply <- nodes$supply[match(V(G)$name,nodes$name)]
# plot the graph
set.seed(3)
par(mar=c(0,0,0,0))
plot(G, vertex.size=30,
     vertex.label=paste0(V(G)$name,' (',V(G)$supply,')'),
     vertex.color='lightblue', edge.arrow.size=0.5,
     edge.label=paste0(E(G)$name,' (',E(G)$cost,',',E(G)$capacity,')')
     )

Input Graph

library(Rsymphony)
library(slam)

nVars <- ecount(G)
obj <- E(G)$cost
bounds <- list(upper=list(1:nVars,E(G)$capacity),lower=list(1:nVars,rep(0,nVars)))
types <- rep('C',ecount(G))

mat <- simple_triplet_zero_matrix(nrow=nrow(nodes),ncol=nrow(edges))
colnames(mat) <- E(G)$name
rownames(mat) <- V(G)$name
rhs <- -V(G)$supply
dir <- rep('==',vcount(G))
for(v in V(G)){
  outEdges <- E(G)[from(v)]$name
  inEdges <- E(G)[to(v)]$name
  mat[v,match(inEdges,colnames(mat))] <- 1
  mat[v,match(outEdges,colnames(mat))] <- -1
}

output <- Rsymphony_solve_LP(obj=obj,
                   mat=mat,
                   dir=dir,
                   rhs=rhs,
                   bounds=bounds,
                   types=types,
                   max=FALSE,
                   write_lp = TRUE)

# plot the solution
set.seed(3)
par(mar=c(0,0,0,0))
plot(G, vertex.size=30,
     vertex.label=paste0(V(G)$name,' (',V(G)$supply,')'),
     vertex.color='lightblue', edge.arrow.size=0.5,
     edge.label=paste0(E(G)$name,' flow = ',output$solution))

Output Graph

О разреженной матрице, здесь мы используем simple_triplet_zero_matrix, которая создает матрицу со всеми нулями (и занимает в основном никакой памяти, так какв разреженных матрицах сохраняются только ненули) размера nrow x ncol, и затем мы заменяем некоторые индексы на некоторые ненулевые коэффициенты.

Вероятно, в случае огромных входов это может быть не очень эффективно.
Вероятно, более эффективно использовать функцию simple_triplet_matrix(i,j,v), где i,j,v - это 3 вектора одинаковой длины, указывающие ненулевое значениекоэффициенты;в частности, i - это индексы строк, j - это индексы столбцов, а v - это ненулевые коэффициенты в позиции i,j.

.
...