在R中递归函数中使用Map()

6mw9ycah  于 2023-03-05  发布在  其他
关注(0)|答案(1)|浏览(172)

下面是我的BOM表与数据结构的方法:

dput(df2)
structure(list(product_id = c("P1", "P1", "P1", "P1", "P1", "P1", 
"P1", "P1", "P1", "P2", "P2", "P2", "P2", "P2", "P2", "P2", "P2", 
"P2"), item_id = c("i1", "i2", "i3", "i4", "i5", "i6", "i7", 
"i8", "i9", "i10", "i11", "i12", "i13", "i14", "i15", "i16", 
"i17", "i18"), sup_item_id = c("i6", "i6", "i6", "i6", "i8", 
"i8", "i9", "i9", NA, "i15", "i15", "i15", "i15", "i17", "i17", 
"i18", "i18", NA), quantity = c(2, 2, 5, 1, 1, 2, 4, 1, 1, 2, 
2, 5, 1, 1, 2, 4, 1, 1), price = c(2, 5, 3, 7, 10, 0, 4, 0, 0, 
2, 5, 3, 7, 20, 0, 2, 0, 0), itemtype = c("A", "A", "A", "A", 
"A", "B", "A", "B", "C", "A", "A", "A", "A", "A", "B", "A", "B", 
"C")), class = "data.frame", row.names = c(NA, -18L))

要定义项目级别(从上到下),下面是内部带有循环的递归函数:

change_df <- function(df, changed = TRUE, idx = which(df$production_level == 1)) {
  
  for (i in idx) {
    descendants <- which(df$sup_item_id == df$item_id[i])
    
    if (length(descendants) > 0) {
      new_levels <- df$production_level[i] + 1
      
      if (any(df$production_level[descendants] < new_levels)) {
        df$production_level[descendants] <- new_levels
        df <- change_df(df, idx = idx)
      }
      
    }
  }
  return(df)
}

我这样称呼它:

df2 %>%
  arrange(product_id, item_id) %>%
  mutate(production_level = ifelse(is.na(sup_item_id), 0, 1)) %>% 
  change_df(df2)

这是我的代码的输出:

product_id item_id sup_item_id quantity price itemtype production_level
1          P1      i1          i6        2     2        A          3
2          P1      i2          i6        2     5        A          3
3          P1      i3          i6        5     3        A          3
4          P1      i4          i6        1     7        A          3
5          P1      i5          i8        1    10        A          2
6          P1      i6          i8        2     0        B          2
7          P1      i7          i9        4     4        A          1
8          P1      i8          i9        1     0        B          1
9          P1      i9        <NA>        1     0        C          0
10         P2     i10         i15        2     2        A          3
11         P2     i11         i15        2     5        A          3
12         P2     i12         i15        5     3        A          3
13         P2     i13         i15        1     7        A          3
14         P2     i14         i17        1    20        A          2
15         P2     i15         i17        2     0        B          2
16         P2     i16         i18        4     2        A          1
17         P2     i17         i18        1     0        B          1
18         P2     i18        <NA>        1     0        C          0

我不想改变输出。现在我想在R中使用map()函数而不是循环来使我的代码更紧凑。我也想知道idx方法是否好或者其他方法是否更好。如果你有任何建议,请分享!

w46czmvw

w46czmvw1#

如果您考虑使用 * tidygraph / igraph *,请尝试一下这是否可以工作,并根据您的实际数据进行缩放。
item_idsup_item_id被用作创建 * tidygraph * 对象的起始/终止边缘列。有一个关于"NA"字符串的警告,因为tidygraph添加了一个名为"NA"的节点,过滤会处理它。
igraph提供eccentricity measure
一个顶点的偏心率是它到图中最远的另一个节点的最短路径距离。
而这应该正是您所追求的,尽管请使用共享item_id s等极端情况进行测试。

library(dplyr)
library(tidygraph)

# to_from_df, a 2-column data.frame for igraph edges
# returns node eccentricity measure vector
node_level <- function(from_to_df){
  as_tbl_graph(from_to_df) %>% 
    activate(nodes)  %>% 
    filter(name != "NA") %>% 
    mutate(eccentricity = node_eccentricity()) %>% 
    pull(eccentricity)
}

df %>% mutate(production_level = node_level(pick(item_id, sup_item_id)))

#> Warning: There was 1 warning in `mutate()`.
#> ℹ In argument: `production_level = node_level(pick(item_id, sup_item_id))`.
#> Caused by warning in `graph_from_data_frame()`:
#> ! In `d' `NA' elements were replaced with string "NA"
#>    product_id item_id sup_item_id quantity price itemtype production_level
#> 1          P1      i1          i6        2     2        A                3
#> 2          P1      i2          i6        2     5        A                3
#> 3          P1      i3          i6        5     3        A                3
#> 4          P1      i4          i6        1     7        A                3
#> 5          P1      i5          i8        1    10        A                2
#> 6          P1      i6          i8        2     0        B                2
#> 7          P1      i7          i9        4     4        A                1
#> 8          P1      i8          i9        1     0        B                1
#> 9          P1      i9        <NA>        1     0        C                0
#> 10         P2     i10         i15        2     2        A                3
#> 11         P2     i11         i15        2     5        A                3
#> 12         P2     i12         i15        5     3        A                3
#> 13         P2     i13         i15        1     7        A                3
#> 14         P2     i14         i17        1    20        A                2
#> 15         P2     i15         i17        2     0        B                2
#> 16         P2     i16         i18        4     2        A                1
#> 17         P2     i17         i18        1     0        B                1
#> 18         P2     i18        <NA>        1     0        C                0

示例数据:

df <- structure(list(product_id = c(
  "P1", "P1", "P1", "P1", "P1", "P1",
  "P1", "P1", "P1", "P2", "P2", "P2", "P2", "P2", "P2", "P2", "P2",
  "P2"
), item_id = c(
  "i1", "i2", "i3", "i4", "i5", "i6", "i7",
  "i8", "i9", "i10", "i11", "i12", "i13", "i14", "i15", "i16",
  "i17", "i18"
), sup_item_id = c(
  "i6", "i6", "i6", "i6", "i8",
  "i8", "i9", "i9", NA, "i15", "i15", "i15", "i15", "i17", "i17",
  "i18", "i18", NA
), quantity = c(
  2, 2, 5, 1, 1, 2, 4, 1, 1, 2,
  2, 5, 1, 1, 2, 4, 1, 1
), price = c(
  2, 5, 3, 7, 10, 0, 4, 0, 0,
  2, 5, 3, 7, 20, 0, 2, 0, 0
), itemtype = c(
  "A", "A", "A", "A",
  "A", "B", "A", "B", "C", "A", "A", "A", "A", "A", "B", "A", "B",
  "C"
)), class = "data.frame", row.names = c(NA, -18L))

创建于2023年3月1日,使用reprex v2.0.2

相关问题