Сохранение выходных данных из purrr: map_dfr и dplyr :: group_split с циклом while - PullRequest
2 голосов
/ 26 марта 2019

Я хотел бы использовать map_dfr и group_split для запуска групп data.frame через цикл while и сохранения результатов.

Я могу сделать это для такой группы, как эта.

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

Но при попытке сделать функцию с циклом while для использования с map_dfr и group_split я не могу и / или не уверен в том, как сохранить выходные данные.

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

Я пытался rbind или использовать list для сохранения вывода, но мои попытки не были правильными. Если я выведу «res2» на экран, я смогу увидеть желаемый результат по одной строке за раз. Как сохранить выходные данные из fun для каждого 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")

1 Ответ

1 голос
/ 05 апреля 2019

Единственным отсутствующим элементом была ваша отображенная функция fun не возвращала значение.Он был , вычислял и строил временный список, MyList_FF правильно, вы могли видеть при вызовах print(), но без возврата он исчезал.

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
}

Магиянаходится в последней строке, аналогично тому, что вы сделали после своего единственного примера, связав промежуточный список результатов.В R функция return() необходима только в том случае, если вы пытаетесь вернуться раньше, потому что по умолчанию функции R возвращают последнее значение.Так что здесь нам не нужно явно говорить return(do.call("rbind", MyList_FF)), хотя это не повредит, если вы это сделаете.В нерабочем примере не было последнего значения с момента назначения i, поэтому вы не получили никаких объектов обратно, но также не получили никаких ошибок.

Для полного рабочего примера:

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

Примечание: если вы используете do.call("xbind", list), вы можете наслаждаться dplyr::bind_rows(list) и dplyr::bind_cols(list).

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...