使用 while 循环存储来自 purrr:map_dfr 和 dplyr::group_split 的输出

Question

I would like to use map_dfr and group_split to run groups of a data.frame through a while loop and store the results.

I can do this for one group like this.

# df dput below
# this code finds the closet match for DIFF for Sample.x in Sample.y, then finds the next closest match, until 
df_f <- df %>% filter(grp == "AB" & VAR == "Var1")
HowMany <- length(unique(df_f$Sample.y))
i <- 1
MyList <- list()

while (i <= HowMany){
  res1 <- df_f %>%
    group_by(grp, VAR, Sample.x) %>%
    filter(DIFF == min(DIFF)) %>%
    ungroup() %>%
    mutate(Rank1 = dense_rank(DIFF))

  res2 <- res1 %>% group_by(grp, VAR) %>% filter(rank(Rank1, ties.method="first")==1)

  SY <- as.numeric(res2$Sample.y)
  SX <- as.numeric(res2$Sample.x)
  res3 <- df_f %>% filter(Sample.y != SY)
  res4 <- res3 %>% filter(Sample.x != SX)
  df_f <- res4

  MyList[[i]] <- res2

  i <- i + 1
}
df.result <- do.call("rbind", MyList)

But when trying to make a function with the while loop to use with map_dfr and group_split I am unable and/or unsure on how to store the output.

MyResult <- df %>%
      dplyr::group_split(grp, VAR) %>%
      map_dfr(fun) # fun below

df.store <- data.frame() # attempt to store results

fun <- function(df){
  HowMany <- length(unique(df$Sample.y))
  i <- 1
  MyList_FF <- list()
  ThisDF <- df
  while (i <= HowMany){

    res1 <- ThisDF %>%
      group_by(grp, VAR, Sample.x) %>%
      filter(DIFF == min(DIFF)) %>%
      ungroup() %>%
      mutate(Rank1 = dense_rank(DIFF))
    res2 <- res1 %>% group_by(grp, VAR) %>% filter(rank(Rank1, ties.method="first")==1)
    # print(res2) # when printed to screen the desired output looks correct
    SY <- as.numeric(res2$Sample.y)
    SX <- as.numeric(res2$Sample.x)

    res3 <- ThisDF %>% filter(Sample.y != SY)
    res4 <- res3 %>% filter(Sample.x != SX)

    # df.store <- rbind(df.store, res4)
    # MyList_FF[[i]] <- res2
    ThisDF <- res4
    i <- i + 1
  }
}

I've tried to rbind or use a list to store the output, but my attempts have not been correct. If I print "res2" to screen, I can see the desired output one row at a time. How do I store the output from fun from each group_split ?

# df dput
df <- structure(list(Location.x = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L), .Label = c("A", "C", "B"), class = "factor"), 
    Sample.x = c(6L, 6L, 10L, 10L, 9L, 9L, 6L, 6L, 10L, 10L, 
    9L, 9L, 6L, 6L, 6L, 10L, 10L, 10L, 9L, 9L, 9L, 6L, 6L, 6L, 
    10L, 10L, 10L, 9L, 9L, 9L, 1L, 1L, 1L, 9L, 9L, 9L, 1L, 1L, 
    1L, 9L, 9L, 9L), VAR = c("Var1", "Var1", "Var1", "Var1", 
    "Var1", "Var1", "Var2", "Var2", "Var2", "Var2", "Var2", "Var2", 
    "Var1", "Var1", "Var1", "Var1", "Var1", "Var1", "Var1", "Var1", 
    "Var1", "Var2", "Var2", "Var2", "Var2", "Var2", "Var2", "Var2", 
    "Var2", "Var2", "Var1", "Var1", "Var1", "Var1", "Var1", "Var1", 
    "Var2", "Var2", "Var2", "Var2", "Var2", "Var2"), value.x = c(56.48, 
    56.48, 57.03, 57.03, 55.04, 55.04, 6, 6, 10, 10, 9, 9, 56.48, 
    56.48, 56.48, 57.03, 57.03, 57.03, 55.04, 55.04, 55.04, 6, 
    6, 6, 10, 10, 10, 9, 9, 9, 55.62, 55.62, 55.62, 55.65, 55.65, 
    55.65, 1, 1, 1, 9, 9, 9), Location.y = structure(c(2L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
    3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("A", 
    "C", "B"), class = "factor"), Sample.y = c(1L, 9L, 1L, 9L, 
    1L, 9L, 1L, 9L, 1L, 9L, 1L, 9L, 3L, 7L, 9L, 3L, 7L, 9L, 3L, 
    7L, 9L, 3L, 7L, 9L, 3L, 7L, 9L, 3L, 7L, 9L, 3L, 7L, 9L, 3L, 
    7L, 9L, 3L, 7L, 9L, 3L, 7L, 9L), value.y = c(55.62, 55.65, 
    55.62, 55.65, 55.62, 55.65, 1, 9, 1, 9, 1, 9, 1.4, 111.6, 
    111.8, 1.4, 111.6, 111.8, 1.4, 111.6, 111.8, 10.2, 14.4, 
    20.9, 10.2, 14.4, 20.9, 10.2, 14.4, 20.9, 1.4, 111.6, 111.8, 
    1.4, 111.6, 111.8, 10.2, 14.4, 20.9, 10.2, 14.4, 20.9), DIFF = c(0.859999999999999, 
    0.829999999999998, 1.41, 1.38, 0.579999999999998, 0.609999999999999, 
    5, 3, 9, 1, 8, 0, 55.08, 55.12, 55.32, 55.63, 54.57, 54.77, 
    53.64, 56.56, 56.76, 4.2, 8.4, 14.9, 0.199999999999999, 4.4, 
    10.9, 1.2, 5.4, 11.9, 54.22, 55.98, 56.18, 54.25, 55.95, 
    56.15, 9.2, 13.4, 19.9, 1.2, 5.4, 11.9), grp = c("AC", "AC", 
    "AC", "AC", "AC", "AC", "AC", "AC", "AC", "AC", "AC", "AC", 
    "AB", "AB", "AB", "AB", "AB", "AB", "AB", "AB", "AB", "AB", 
    "AB", "AB", "AB", "AB", "AB", "AB", "AB", "AB", "CB", "CB", 
    "CB", "CB", "CB", "CB", "CB", "CB", "CB", "CB", "CB", "CB"
    )), row.names = c(NA, -42L), class = "data.frame")

Answer 1

The only piece missing was your mapped function fun wasn't returning a value. It was computing and building the temporary list, MyList_FF properly, you could see with the print() calls, but without a return, it was disappearing.

fun <- function(df) {
    HowMany <- length(unique(df$Sample.y))
    i <- 1
    MyList_FF <- list()
    df_f <- df
    while (i <= HowMany){
        res1 <- df_f %>%
            group_by(grp, VAR, Sample.x) %>%
            filter(DIFF == min(DIFF)) %>%
            ungroup() %>%
            mutate(Rank1 = dense_rank(DIFF))

        res2 <- res1 %>% group_by(grp, VAR) %>% filter(rank(Rank1, ties.method="first")==1)

        SY <- as.numeric(res2$Sample.y)
        SX <- as.numeric(res2$Sample.x)
        res3 <- df_f %>% filter(Sample.y != SY)
        res4 <- res3 %>% filter(Sample.x != SX)
        df_f <- res4

        MyList_FF[[i]] <- res2

        i <- i + 1
    }
    # this is the magic line
    do.call("rbind", MyList_FF)
    # this returns the list built inside of the function
}

The magic is in that last line, similar to what you did after your single example, binding up the intermediate results list. In R the return() function is only needed if you are trying to return early, because by default R functions will return the last value. So here we don't need to explicitly say return(do.call("rbind", MyList_FF)) , although it wouldn't hurt anything if you did. In the non-working example there wasn't a last value since i was being assigned, so you were not getting any objects back, but were not getting any errors either.

For a full working example:

MyResult <- df %>%
    dplyr::group_split(grp, VAR) %>%
    map_df(fun)

MyResult
# A tibble: 16 x 10
# Groups:   grp, VAR [1]
   Location.x Sample.x VAR   value.x Location.y Sample.y value.y  DIFF grp   Rank1
   <fct>         <int> <chr>   <dbl> <fct>         <int>   <dbl> <dbl> <chr> <int>
 1 A                 9 Var1     55.0 B                 3     1.4  53.6 AB        1
 2 A                10 Var1     57.0 B                 7   112.   54.6 AB        1
 3 A                 6 Var1     56.5 B                 9   112.   55.3 AB        1
 4 A                 9 Var1     55.0 B                 3     1.4  53.6 AB        1
 5 A                10 Var1     57.0 B                 7   112.   54.6 AB        1
 6 A                 6 Var1     56.5 B                 9   112.   55.3 AB        1
 7 A                 9 Var1     55.0 B                 3     1.4  53.6 AB        1
 8 A                10 Var1     57.0 B                 7   112.   54.6 AB        1
 9 A                 9 Var1     55.0 B                 3     1.4  53.6 AB        1
10 A                10 Var1     57.0 B                 7   112.   54.6 AB        1
11 A                 9 Var1     55.0 B                 3     1.4  53.6 AB        1
12 A                10 Var1     57.0 B                 7   112.   54.6 AB        1
13 A                 6 Var1     56.5 B                 9   112.   55.3 AB        1
14 A                 9 Var1     55.0 B                 3     1.4  53.6 AB        1
15 A                10 Var1     57.0 B                 7   112.   54.6 AB        1
16 A                 6 Var1     56.5 B                 9   112.   55.3 AB        1

Side note if you use do.call("xbind", list) a lot you might enjoy dplyr::bind_rows(list) and dplyr::bind_cols(list) .