r - 使用map和fcase更新嵌套列表的元素

Question

我想使用 purrr::map() 和 purrr::pluck() 来应用 data.table::fcase() code> 规则嵌套列表中的元素并通过引用更新列表。

我可以使用 dplyr::mutate() 完成工作输出，但此输出采用非嵌套格式，并且不会像 data.table 那样通过引用进行更新:= 确实如此。

可重现的示例

library(purrr)
library(data.table)
library(dplyr)

df <- list(out1 = list(e1 = c(1, 2, 3), e2 = c(TRUE, FALSE, TRUE), 
    parm = list(a = structure(list(V1 = c(515L, 228L, 232L, 219L, 
    597L), V2 = c(628L, 454L, 889L, 769L, 783L), V3 = c(798L, 
    789L, 294L, 566L, 591L), V4 = c(480L, 198L, 749L, 543L, 119L
    ), V5 = c(311L, 141L, 286L, 225L, 449L), V6 = c(712L, 812L, 
    930L, 501L, 286L), V7 = c(329L, 907L, 880L, 635L, 442L), 
        V8 = c(721L, 373L, 299L, 713L, 302L)), class = "data.frame", row.names = c(NA, 
    -5L)), b = structure(list(V1 = c(664L, 495L, 429L, 169L, 
    506L), V2 = c(795L, 207L, 452L, 931L, 759L), V3 = c(803L, 
    477L, 982L, 889L, 641L), V4 = c(411L, 802L, 595L, 216L, 721L
    ), V5 = c(540L, 301L, 931L, 399L, 628L), V6 = c(367L, 811L, 
    261L, 297L, 754L), V7 = c(417L, 600L, 260L, 948L, 685L), 
        V8 = c(855L, 522L, 612L, 274L, 356L), flag = c(0, 0, 
        0, 0, 0)), class = "data.frame", row.names = c(NA, -5L
    )), stand = structure(list(V1 = c(105L, 157L, 244L, 400L, 
    982L), V2 = c(838L, 894L, 793L, 525L, 272L), V3 = c(203L, 
    300L, 707L, 815L, 367L), V4 = c(148L, 189L, 490L, 396L, 290L
    ), V5 = c(672L, 924L, 599L, 780L, 160L), V6 = c(158L, 651L, 
    879L, 598L, 688L), V7 = c(930L, 162L, 996L, 162L, 255L), 
        V8 = c(230L, 731L, 765L, 695L, 145L), flag = c(0, 0, 
        0, 0, 0)), class = "data.frame", row.names = c(NA, -5L
    )))), out2 = list(e1 = c(3, 4, 5), e2 = c(TRUE, FALSE, TRUE
), parm = list(a = structure(list(V1 = c(253L, 179L, 994L, 441L, 
775L), V2 = c(257L, 877L, 273L, 838L, 467L), V3 = c(398L, 738L, 
348L, 421L, 284L), V4 = c(637L, 960L, 126L, 401L, 439L), V5 = c(796L, 
695L, 537L, 847L, 680L), V6 = c(212L, 855L, 565L, 843L, 265L), 
    V7 = c(529L, 560L, 360L, 213L, 638L), V8 = c(143L, 165L, 
    656L, 106L, 352L)), class = "data.frame", row.names = c(NA, 
-5L)), b = structure(list(V1 = c(832L, 929L, 785L, 193L, 359L
), V2 = c(512L, 567L, 618L, 512L, 513L), V3 = c(955L, 512L, 182L, 
124L, 565L), V4 = c(172L, 142L, 269L, 144L, 551L), V5 = c(432L, 
267L, 503L, 956L, 635L), V6 = c(159L, 894L, 175L, 504L, 553L), 
    V7 = c(112L, 793L, 411L, 674L, 135L), V8 = c(919L, 254L, 
    733L, 189L, 772L), flag = c(0, 0, 0, 0, 0)), class = "data.frame", row.names = c(NA, 
-5L)), stand = structure(list(V1 = c(370L, 789L, 898L, 255L, 
574L), V2 = c(417L, 595L, 595L, 986L, 650L), V3 = c(324L, 774L, 
377L, 704L, 125L), V4 = c(860L, 290L, 668L, 343L, 287L), V5 = c(466L, 
108L, 964L, 437L, 686L), V6 = c(173L, 214L, 229L, 856L, 740L), 
    V7 = c(700L, 167L, 361L, 186L, 524L), V8 = c(329L, 951L, 
    405L, 659L, 316L), flag = c(0, 0, 0, 0, 0)), class = "data.frame", row.names = c(NA, 
-5L)))), out3 = list(e1 = c(1, 2, 3), e2 = c(TRUE, FALSE, TRUE
), parm = list(a = structure(list(V1 = c(867L, 773L, 261L, 944L, 
674L), V2 = c(176L, 775L, 840L, 605L, 816L), V3 = c(936L, 392L, 
694L, 119L, 794L), V4 = c(874L, 780L, 840L, 809L, 517L), V5 = c(943L, 
821L, 612L, 184L, 336L), V6 = c(240L, 621L, 923L, 556L, 315L), 
    V7 = c(627L, 599L, 447L, 128L, 306L), V8 = c(690L, 799L, 
    989L, 151L, 752L)), class = "data.frame", row.names = c(NA, 
-5L)), b = structure(list(V1 = c(684L, 666L, 209L, 736L, 323L
), V2 = c(658L, 571L, 537L, 614L, 109L), V3 = c(198L, 548L, 858L, 
961L, 947L), V4 = c(920L, 912L, 698L, 131L, 566L), V5 = c(943L, 
593L, 646L, 183L, 413L), V6 = c(364L, 997L, 679L, 758L, 328L), 
    V7 = c(313L, 808L, 298L, 540L, 563L), V8 = c(220L, 901L, 
    258L, 439L, 246L), flag = c(0, 0, 0, 0, 0)), class = "data.frame", row.names = c(NA, 
-5L)), stand = structure(list(V1 = c(892L, 221L, 103L, 518L, 
603L), V2 = c(332L, 753L, 354L, 504L, 799L), V3 = c(190L, 714L, 
416L, 780L, 576L), V4 = c(481L, 938L, 192L, 540L, 869L), V5 = c(568L, 
301L, 900L, 201L, 187L), V6 = c(836L, 222L, 478L, 209L, 569L), 
    V7 = c(105L, NA, 998L, 896L, 905L), V8 = c(414L, 676L, NA, 
    183L, 643L), flag = c(0, 0, 0, 0, 0)), row.names = c(NA, 
-5L), class = "data.frame"))))

简化的 fcase() 规则是查看列 V8 并将 NA 值标记为 9，值 < 500 为 3，列 V7 值 > 500 为 2，否则为 1。这会产生我想要的结果，但作为一个扁平列表，我不太明白如何更新 df 并保留原始结构。我需要保留该结构以便在更大的 Shiny 模块中使用。

map(df, pluck, "parm", "stand") %>% 
    map(~dplyr::mutate(., flag = data.table::fcase(is.na(V8), 9L, V8 < 500, 3L, V7 > 500, 2L, default = 1L)))

$out1
   V1  V2  V3  V4  V5  V6  V7  V8 flag
1 105 838 203 148 672 158 930 230    3
2 157 894 300 189 924 651 162 731    1
3 244 793 707 490 599 879 996 765    2
4 400 525 815 396 780 598 162 695    1
5 982 272 367 290 160 688 255 145    3

$out2
   V1  V2  V3  V4  V5  V6  V7  V8 flag
1 370 417 324 860 466 173 700 329    3
2 789 595 774 290 108 214 167 951    1
3 898 595 377 668 964 229 361 405    3
4 255 986 704 343 437 856 186 659    1
5 574 650 125 287 686 740 524 316    3

$out3
   V1  V2  V3  V4  V5  V6  V7  V8 flag
1 892 332 190 481 568 836 105 414    3
2 221 753 714 938 301 222  NA 676    1
3 103 354 416 192 900 478 998  NA    9
4 518 504 780 540 201 209 896 183    3
5 603 799 576 869 187 569 905 643    2

我想像这样使用 := 来完成，但如果可能的话，在整个列表上使用 map() 来通过更大的嵌套结构中的引用进行更新。或者是否有其他方法可以实现此目的。

df2 <- df$out3$parm$stand
setDT(df2)[, flag := data.table::fcase(is.na(V8), 9L, V8 < 500, 3L, V7 > 500, 2L, default = 1L)][]
    V1  V2  V3  V4  V5  V6  V7  V8 flag
1: 892 332 190 481 568 836 105 414    3
2: 221 753 714 938 301 222  NA 676    1
3: 103 354 416 192 900 478 998  NA    9
4: 518 504 780 540 201 209 896 183    3
5: 603 799 576 869 187 569 905 643    2

Answer 1

考虑更新对象然后返回数据

df2 <- map(df, ~ {
    .x$parm$stand <- .x$parm$stand %>% 
        mutate(flag = data.table::fcase(is.na(V8), 9L,
                                   V8 < 500, 3L,
                    V7 > 500, 2L, default = 1L))
           .x
      } )