R 图中的多级制造和销售模型

这是一个简化的、可复制的公司制造和销售流程模型示例，图为R

library(igraph)

# Create graph
graph= graph.formula(
  R --+ P1,
  P1 --+ M1,
  R --+ P2,
  P2 --+ M2,
  P1 --+ P3,
  P2 --+ P3,
  P3 --+ M2,
  R --+ P4,
  P3 --+ P5,
  P4 --+ P5,
  P5 --+ M3,
  P5 --+ M4
  )

# Change colors for pretty plot
V(graph)$color= "gray"
V(graph)[name== "R"]$color= "cyan"
V(graph)[grepl(x= name, pattern= "M")]$color= "green"
V(graph)[name %in% c("P1", "P2", "P4")]$color= "red"

# Add sales volume as attribute and add to edge label in plot
E(graph)[4]$sales= 100
E(graph)[4]$label= paste("Sales:\n", E(graph)[4]$sales, "tons")
E(graph)[6]$sales= 200
E(graph)[6]$label= paste("Sales:\n", E(graph)[6]$sales, "tons")
E(graph)[8]$sales= 500
E(graph)[8]$label= paste("Sales:\n", E(graph)[8]$sales, "tons")
E(graph)[11]$sales= 1000
E(graph)[11]$label= paste("Sales:\n", E(graph)[11]$sales, "tons")
E(graph)[12]$sales= 2000
E(graph)[12]$label= paste("Sales:\n", E(graph)[12]$sales, "tons")

# Add bill of material share as attribute and add to edge label in plot
E(graph)[1:3]$share= 1.0
E(graph)[1:3]$label= paste("Share:\n", E(graph)[1:3]$share*100, "%")
E(graph)[7]$share= 0.8
E(graph)[7]$label= paste("Share:\n", E(graph)[7]$share*100, "%")
E(graph)[5]$share= 1 - 0.8
E(graph)[5]$label= paste("Share:\n", E(graph)[5]$share*100, "%")
E(graph)[9]$share= 0.4
E(graph)[9]$label= paste("Share:\n", E(graph)[9]$share*100, "%")
E(graph)[10]$share= 1 - 0.4
E(graph)[10]$label= paste("Share:\n", E(graph)[10]$share*100, "%")

# Add preliminary NA vol attribute to nodes and add label in plot
V(graph)$vol= NA
V(graph)$label= paste(V(graph)$name, "\nVolume:\n", V(graph)$vol, "tons")

# Plot
E(graph)$label.cex=0.8
V(graph)$label.cex=0.8
V(graph)$size=20
layout= layout.reingold.tilford(graph, root=1)
layout[3,2]=0
layout[5,2]=0
plot(graph, layout= layout)

模型网络由以下组件组成：

• R

  ：生产产品所需的青色原材料

  P1、P2、P4

• P1…P5

  ：红色产品是直接从

  R

  中一步生产出来的（

  P1、P2、P4

  ），或作为多阶段制造的产品（

  P3、P5

  ）。每种产品都有一份带有配方的物料清单

• M.

  ：产品

  P1…5

  销售到的绿色市场。唯一的例外是未出售的

  P4

  ，它只是作为

  P5

  的前身（与

  P3

  组合使用）

此网络中边的已知属性包括：

• 销售额

  ：P1、P2、P3、P5到市场的销售量（吨）

  M1、M2、M3、M4

• 配方

  Share

  ：生产特定产品所需的前体含量，单位为%。示例：要生产1吨

  P1、P2、P4

  1吨原材料（因此共享100%）。制造10吨

  P3

  8吨（=80%）

  P2

  和2吨（=20%）

  P1

  ）

我正在寻找一个解决方案来计算节点产品

P1的卷属性
vol
。。。P5

和原材料

R

。目前，它们被设置为

NA

<代码>数量应与销售量和产品配方份额一致。

---

注释：我正在寻找一个通用的解决方案，它适用于这个简化的示例，也适用于更复杂（更多节点和更多制造阶段）的真实世界模型。我在考虑一种多级传播算法。首先，

sales

数据将被聚合，以生成销售到市场的产品的产品顶点

vol

属性。然后，另一个步骤将根据

共享

使产品产生上一步产量的要求计算上游，依此类推。广义解决方案超出了我的

R

知识。如何完成这项任务有什么想法吗？

经过大量的实验，我似乎有了第一个解决方案。可再现的例子可以用它来解决。到目前为止还没有在现实世界复杂的情况下进行测试

1。稍微重新编码任务：

library(igraph)

# Create graph
graph= graph.formula(
  R --+ P1,
  P1 --+ M1,
  R --+ P2,
  P2 --+ M2,
  P1 --+ P3,
  P2 --+ P3,
  P3 --+ M2,
  R --+ P4,
  P3 --+ P5,
  P4 --+ P5,
  P5 --+ M3,
  P5 --+ M4
  )

# Change colors for pretty plot
V(graph)$color= "gray"
V(graph)[name== "R"]$color= "cyan"
V(graph)[grepl(x= name, pattern= "M")]$color= "green"
V(graph)[name %in% c("P1", "P2", "P4")]$color= "red"

# Add sales volume as attribute and add to edge label in plot
E(graph)$vol= NA # prefill
E(graph)[4]$vol= 100
E(graph)[6]$vol= 200
E(graph)[8]$vol= 500
E(graph)[11]$vol= 1000
E(graph)[12]$vol= 2000

# Add bill of material share as attribute and add to edge label in plot
E(graph)[1:3]$share= 1.0
E(graph)[7]$share= 0.8
E(graph)[5]$share= 1 - 0.8
E(graph)[9]$share= 0.4
E(graph)[10]$share= 1 - 0.4

# Add preliminary NA vol attribute to nodes and add label in plot
V(graph)$vol= 0

# Plot
update.labels= function(graph){
  E(graph)[4]$label= paste("Vol:\n", E(graph)[4]$vol, "tons")
  E(graph)[6]$label= paste("Vol:\n", E(graph)[6]$vol, "tons")
  E(graph)[8]$label= paste("Vol:\n", E(graph)[8]$vol, "tons")
  E(graph)[11]$label= paste("Vol:\n", E(graph)[11]$vol, "tons")
  E(graph)[12]$label= paste("Vol:\n", E(graph)[12]$vol, "tons")
  E(graph)[1:3]$label= paste("Share:\n", E(graph)[1:3]$share*100, "%", "\nVol:\n", E(graph)[1:3]$vol, "tons")
  E(graph)[7]$label= paste("Share:\n", E(graph)[7]$share*100, "%", "\nVol:\n", E(graph)[7]$vol, "tons")
  E(graph)[5]$label= paste("Share:\n", E(graph)[5]$share*100, "%", "\nVol:\n", E(graph)[5]$vol, "tons")
  E(graph)[9]$label= paste("Share:\n", E(graph)[9]$share*100, "%", "\nVol:\n", E(graph)[9]$vol, "tons")
  E(graph)[10]$label= paste("Share:\n", E(graph)[10]$share*100, "%", "\nVol:\n", E(graph)[10]$vol, "tons")
  V(graph)$label= paste(V(graph)$name, "\nVolume:\n", V(graph)$vol, "tons")
  graph
}
graph= update.labels(graph)
E(graph)$label.cex=0.8
V(graph)$label.cex=0.8
V(graph)$size=20
layout= layout.reingold.tilford(graph, root=1)
layout[3,2]=0
layout[5,2]=0
plot(graph, layout= layout)

# Aggregate sales volumes to markets
this.vertices.names= V(graph)[grepl(x=name, pattern = "M")]$name
for (i in this.vertices.names) {
  V(graph)[name== i]$vol= sum(E(graph)[to(i)]$vol, na.rm=T)
}

# Calculate volumes along the network
# do stepwise from farthest nodes to nearest (origin is "R")
# 1.step: aggregate "from" edge vol attributes to product node vol attribute
# 2.step: distribute node vol attribute to "to" edge vol attribute by vol of node * share of edge 

# Function to sort nodes even if they have same distance from root
max.out.edges= function(graph, from.node.name) {
  max(shortest.paths(graph= graph, v= V(graph)[name==from.node.name], mode="out")
      [is.finite(shortest.paths(graph= graph, v= V(graph)[name==from.node.name], mode="out"))]) 
}

# Function to create a list of nodes lists sorted with decending distance from root
list.farthest.nodes= function(graph, from.node.name) {
  ans= list()
  sp= shortest.paths(graph= graph, v= V(graph)[name==from.node.name], mode="out")
  max.distance= max(sp[is.finite(sp)])  
  for (i in 0:max.distance-1) {
    nodes= sapply(dimnames(sp)[[2]][which(sp==max.distance-i)], function(x) max.out.edges(graph, x), simplify= T)
    ans= c(ans, list (names(nodes[order(nodes)])))
  }
  ans[[1]]= NULL
  ans[[max.distance+1]]= "R"
  ans
}


farthest.nodes= list.farthest.nodes(graph, "R")

for (i in farthest.nodes) {
  print(paste("Levels:", i))
  for (j in i) {
    print(paste("Single Level",j))
    if (!grepl(x=j, pattern="M")) {
      V(graph)[name== j]$vol= V(graph)[name== j]$vol + sum(E(graph)[from(j)]$vol, na.rm=T)
      if (!grepl(x=j, pattern="R")) {
        E(graph)[to(j)]$vol= E(graph)[to(j)]$share * V(graph)[name== j]$vol        
      }
    }
  }  
}

graph= update.labels(graph); plot(graph, layout=layout)

解决方案：

library(igraph)

# Create graph
graph= graph.formula(
  R --+ P1,
  P1 --+ M1,
  R --+ P2,
  P2 --+ M2,
  P1 --+ P3,
  P2 --+ P3,
  P3 --+ M2,
  R --+ P4,
  P3 --+ P5,
  P4 --+ P5,
  P5 --+ M3,
  P5 --+ M4
  )

# Change colors for pretty plot
V(graph)$color= "gray"
V(graph)[name== "R"]$color= "cyan"
V(graph)[grepl(x= name, pattern= "M")]$color= "green"
V(graph)[name %in% c("P1", "P2", "P4")]$color= "red"

# Add sales volume as attribute and add to edge label in plot
E(graph)$vol= NA # prefill
E(graph)[4]$vol= 100
E(graph)[6]$vol= 200
E(graph)[8]$vol= 500
E(graph)[11]$vol= 1000
E(graph)[12]$vol= 2000

# Add bill of material share as attribute and add to edge label in plot
E(graph)[1:3]$share= 1.0
E(graph)[7]$share= 0.8
E(graph)[5]$share= 1 - 0.8
E(graph)[9]$share= 0.4
E(graph)[10]$share= 1 - 0.4

# Add preliminary NA vol attribute to nodes and add label in plot
V(graph)$vol= 0

# Plot
update.labels= function(graph){
  E(graph)[4]$label= paste("Vol:\n", E(graph)[4]$vol, "tons")
  E(graph)[6]$label= paste("Vol:\n", E(graph)[6]$vol, "tons")
  E(graph)[8]$label= paste("Vol:\n", E(graph)[8]$vol, "tons")
  E(graph)[11]$label= paste("Vol:\n", E(graph)[11]$vol, "tons")
  E(graph)[12]$label= paste("Vol:\n", E(graph)[12]$vol, "tons")
  E(graph)[1:3]$label= paste("Share:\n", E(graph)[1:3]$share*100, "%", "\nVol:\n", E(graph)[1:3]$vol, "tons")
  E(graph)[7]$label= paste("Share:\n", E(graph)[7]$share*100, "%", "\nVol:\n", E(graph)[7]$vol, "tons")
  E(graph)[5]$label= paste("Share:\n", E(graph)[5]$share*100, "%", "\nVol:\n", E(graph)[5]$vol, "tons")
  E(graph)[9]$label= paste("Share:\n", E(graph)[9]$share*100, "%", "\nVol:\n", E(graph)[9]$vol, "tons")
  E(graph)[10]$label= paste("Share:\n", E(graph)[10]$share*100, "%", "\nVol:\n", E(graph)[10]$vol, "tons")
  V(graph)$label= paste(V(graph)$name, "\nVolume:\n", V(graph)$vol, "tons")
  graph
}
graph= update.labels(graph)
E(graph)$label.cex=0.8
V(graph)$label.cex=0.8
V(graph)$size=20
layout= layout.reingold.tilford(graph, root=1)
layout[3,2]=0
layout[5,2]=0
plot(graph, layout= layout)

# Aggregate sales volumes to markets
this.vertices.names= V(graph)[grepl(x=name, pattern = "M")]$name
for (i in this.vertices.names) {
  V(graph)[name== i]$vol= sum(E(graph)[to(i)]$vol, na.rm=T)
}

# Calculate volumes along the network
# do stepwise from farthest nodes to nearest (origin is "R")
# 1.step: aggregate "from" edge vol attributes to product node vol attribute
# 2.step: distribute node vol attribute to "to" edge vol attribute by vol of node * share of edge 

# Function to sort nodes even if they have same distance from root
max.out.edges= function(graph, from.node.name) {
  max(shortest.paths(graph= graph, v= V(graph)[name==from.node.name], mode="out")
      [is.finite(shortest.paths(graph= graph, v= V(graph)[name==from.node.name], mode="out"))]) 
}

# Function to create a list of nodes lists sorted with decending distance from root
list.farthest.nodes= function(graph, from.node.name) {
  ans= list()
  sp= shortest.paths(graph= graph, v= V(graph)[name==from.node.name], mode="out")
  max.distance= max(sp[is.finite(sp)])  
  for (i in 0:max.distance-1) {
    nodes= sapply(dimnames(sp)[[2]][which(sp==max.distance-i)], function(x) max.out.edges(graph, x), simplify= T)
    ans= c(ans, list (names(nodes[order(nodes)])))
  }
  ans[[1]]= NULL
  ans[[max.distance+1]]= "R"
  ans
}


farthest.nodes= list.farthest.nodes(graph, "R")

for (i in farthest.nodes) {
  print(paste("Levels:", i))
  for (j in i) {
    print(paste("Single Level",j))
    if (!grepl(x=j, pattern="M")) {
      V(graph)[name== j]$vol= V(graph)[name== j]$vol + sum(E(graph)[from(j)]$vol, na.rm=T)
      if (!grepl(x=j, pattern="R")) {
        E(graph)[to(j)]$vol= E(graph)[to(j)]$share * V(graph)[name== j]$vol        
      }
    }
  }  
}

graph= update.labels(graph); plot(graph, layout=layout)