Как сгенерировать несколько строк из каждой строки в фрейме данных с помощью функции (ий), а затем объединить / объединить их обратно?

Question

Я начинаю с фрейма данных, где в каждой строке есть длинная строка, представляющая 2D-среду (назовем ее ландшафтом) в 1D. В реальном случае это приблизительно 6 значений высотой и 80 значений длиной, и, таким образом, в 1D строки имеют длину 480 символов. Я сократил это в примере. У каждой строки также есть уникальное имя, которое является сокращенным идентификатором для каждого ландшафта.

У меня есть функция, которая берет каждую строку, разрезает строку на 6 полос и выполняет анализ каждой. В этом примере основным действием функции является сжатие полос и получение длины сжатия. Эта функция приводит к 6-строчному фрейму данных, который мне нужно объединить с исходным фреймом данных, в результате чего получается конечный фрейм данных, содержащий 6 строк на каждую 1 строку оригинала.

library(dplyr)
library(tibble)

master_df <- tribble(~land_id, ~land_string,
                     "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab",
                     "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb")

compress_it <- function(txt) {
  len.raw <- sum(nchar(txt))
  len.gz <- length(memCompress(txt, "g"))
  return(list("len_raw" = len.raw,
              "len_gz" = len.gz))
}

get_strip_data <- function(land_id, land_string) {
    with_spaces <- gsub("(.{5})", "\\1 ", land_string)
    chars_on_lines <- str_replace_all(with_spaces, pattern = " ", "\n")
    prob_matrix <- read.table(text = chars_on_lines, header=FALSE, sep = " ",
                              stringsAsFactors = FALSE)
    prob_matrix <- mutate(prob_matrix, 
                          land_id = land_id,
                          substr_id = 1:nrow(prob_matrix) )
    prob_matrix <- rename(prob_matrix, land_substring = V1)

    mutate(prob_matrix, new = map(land_substring, compress_it)) %>%
    unnest_wider(c(new))
}

get_strip_data(master_df$land_id[[2]], master_df$land_string[[2]]) # to test the above function

Вот где мы попадаем в псевдокод / ​​кодекс для того, что я пытаюсь сделать.

Сначала я создаю пустой фрейм данных.

subchunks_df <- 
  tribble(~land_id, ~land_string, ~land_substring, ~substr_id, ~len_raw, ~len_gz,
          "", "", "", NA, NA, NA)

Попытка a для l oop:

for ( i in 1:nrow(master_df) ) {
  subchunks_df[i, ] <- get_strip_data(master_df$land_id[[i]], master_df$land_string[[i]])
}

Вместо этого попробуйте mapply:

subchunks_df <- mapply(get_strip_data, 
                       land_id = master_df$land_id, 
                       land_string = master_df$land_string)

Нет. Мои попытки, быть щедрыми, «закрыть, но без сигары».

Если бы я мог получить subchunks_df в правильной форме, я бы затем right_join:

final_df <- right_join(master_df, subchunks_df, by = "land_id")

Это желаемый результат учитывая master_df, проходящий через функции:

final_df <- 
  tribble(~land_id, ~land_string, ~land_substring, ~substr_id, ~len_raw, ~len_gz, 
          "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab", "aaaaa", 1, 5, 11,     
          "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab", "aaaaa", 2, 5, 11,     
          "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab", "baaaa", 3, 5, 11,     
          "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab", "abaaa", 4, 5, 13,     
          "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab", "babab", 5, 5, 13,     
          "v1-few_bs", "aaaaaaaaaabaaaaabaaabababaabab", "aabab", 6, 5, 13,
          "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb", "aaaaa", 1, 5, 11,        
          "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb", "aaaaa", 2, 5, 11,        
          "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb", "babba", 3, 5, 13,        
          "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb", "bbbab", 4, 5, 13,        
          "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb", "babab", 5, 5, 13,        
          "v2-more_bs", "aaaaaaaaaababbabbbabbababaabbb", "aabbb", 6, 5, 13)

Как всегда, я был бы признателен как за dplyr, так и за основание R на этом. Я не убежден, что моя функция брать полоски и получать длину сжатия тоже так хороша. Я не мог найти ничего проще. Но эта последняя миля была настоящей проблемой.

Answer 1

Вы можете использовать Map, а затем связать данные вместе с do.call + rbind

subchunks_df <- do.call(rbind, Map(get_strip_data, master_df$land_id, 
                                    master_df$land_string))

Или, если вы предпочитаете tidyverse, вы можете использовать map2_df

subchunks_df <- purrr::map2_df(master_df$land_id, master_df$land_string, 
                               get_strip_data)

# A tibble: 12 x 5
#   land_substring land_id    substr_id len_raw len_gz
#   <chr>          <chr>          <int>   <int>  <int>
# 1 aaaaa          v1-few_bs          1       5     11
# 2 aaaaa          v1-few_bs          2       5     11
# 3 baaaa          v1-few_bs          3       5     11
# 4 abaaa          v1-few_bs          4       5     13
# 5 babab          v1-few_bs          5       5     13
# 6 aabab          v1-few_bs          6       5     13
# 7 aaaaa          v2-more_bs         1       5     11
# 8 aaaaa          v2-more_bs         2       5     11
# 9 babba          v2-more_bs         3       5     13
#10 bbbab          v2-more_bs         4       5     13
#11 babab          v2-more_bs         5       5     13
#12 aabbb          v2-more_bs         6       5     13

, а затем right_join:

final_df <- dplyr::right_join(master_df, subchunks_df, by = "land_id")

Answer 2

Функциональность карты - это версия Tidyverse семейства apply. Функция map_dfr использует вектор master_df $ land_id index. Думайте об этом как о для l oop. Он дает вам фрейм данных, который вы ищете для вызова right_join.

library(tidyverse)
subchunks_df <- map_dfr(seq_along(master_df$land_id), function(i){
                     get_strip_data(master_df$land_id[[i]], 
                                    master_df$land_string[[i]])})

final_df <- right_join(master_df, subchunks_df, by = "land_id")