Update elements of nested list with map and fcase

Viewed 114

I would like to use purrr::map() and purrr::pluck() to apply data.table::fcase() rules to elements within a nested list and update the list by reference.

I can accomplish a working output using dplyr::mutate() but this output is in an unnested format and does not update by reference like data.table's := does.

Reproducible example

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"))))

A simplified fcase() rule is to look at column V8 and flag NA values as 9, values < 500 as 3, column V7 values > 500 as 2, otherwise as 1. This produces the results I want, but as a flattened list, and I don't quite understand how to update df retaining the original structure. I need to retain the structure for use within a larger Shiny module.

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

I would like to accomplish using := like this, but using map() on the whole list to update by reference within the larger nested structure if possible. Or if there is an alternative way to accomplish this.

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
1 Answers

Consider updating the object and then return the data

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
      } ) 
Related