R - lapply over lapply(或其他清理时间序列数据的方法)

Question

我正在尝试从许多格式不整洁的 excel 电子表格中提取一些数据。我想我需要在 lapply 中运行 lapply，但似乎无法使其工作。下面是一个示例：

以下是两个数据帧，其格式与我在 excel 工作表中找到的格式相同：

library('dplyr')
library('tidyr')
library('readxl')
df1 <- data.frame(instance = c('...', 'A', 'B'), 
`1990.1` = c('est', 1, 2), 
`1990.2` = c('val', 2, 3),
`1991.1` = c('est', 3, 4),
`1991.2` = c('val', 4, 5))

df2 <- data.frame(instance = c('...', 'A', 'B'),
`1990.1` = c('est', 5, 6), 
`1990.2` = c('val', 6, 7),
`1991.1` = c('est', 7, 8),
`1991.2` = c('val', 8, 9))
> df1
instance X1990.1 X1990.2 X1991.1 X1991.2
1      ...     est     val     est     val
2        A       1       2       3       4
3        B       2       3       4       5

我创建了一个函数来清理基于以下内容的数据：

df1 %>%  
select(1, which(.[1,] == 'est')) %>%
.[-1,] %>%
gather(key = year, value = score, -instance) %>%
mutate(var = 'est')
instance    year score var
1        A X1990.1     1 est
2        B X1990.1     2 est
3        A X1991.1     3 est
4        B X1991.1     4 est

给：

data_clean <- function(x) {
df1 %>% 
select(1, which(.[1,] == x)) %>%
.[-1,] %>%
gather(key = year, value = score, -instance) %>%
mutate(var = x) 
}

我现在可以生成每个 df 的干净版本，如下所示：

do.call(rbind, lapply(c('est', 'val'), data_clean)) %>% 
mutate(origin = 'df1')
instance    year score var origin
1        A X1990.1     1 est    df1
2        B X1990.1     2 est    df1
3        A X1991.1     3 est    df1
4        B X1991.1     4 est    df1
5        A X1990.2     2 val    df1
6        B X1990.2     3 val    df1
7        A X1991.2     4 val    df1
8        B X1991.2     5 val    df1

我现在需要做的是将其应用于数据帧列表：

list_data <- list(df1, df2)

就我而言，我会从一个函数中生成这个：

data_pull <- function(x) {
read_excel('path/to/file', sheet = x)
}
list_data <- lapply(2:20, data_pull)

但我想不出该怎么做。我需要将data_clean应用于data_pull生成的列表的每个元素。我显然需要在 data_clean 函数中删除对 df 的第一个调用，但是我传递给data_clean什么对象？

我最终想要的是一个数据框，所有数据都集中在一个地方，格式整洁。

对不起，如果我在这里错过了一些简单的东西。我觉得有很多数据是这样的结构，清理它的解决方案应该相当简单。我似乎想不起来。

Answer 1

一种选择是将其保留在list中，并使用map遍历列表。 我们可以通过paste除"实例"之外的所有这些列的第一行来重命名列，slice出第一行，使用pivot_longer将"宽"改形为"长"，separate"name"列一分为二，并根据需要转换type。

library(dplyr)
library(tidyr)
library(purrr)
library(readr)
library(stringr)
f1 <- function(dat) {
names(dat)[-1] <- str_c(names(dat)[-1], unlist(dat[1,-1]), sep="_")
dat %>%
slice(-1) %>%
pivot_longer(cols = -instance, values_to = "seq" ) %>%
mutate_all(as.character) %>%
separate(name, into = c('year', 'var'), sep="_", convert = TRUE) %>%
type_convert()
}


map_dfr(set_names(list_data, c('df1', 'df2')), f1, .id = 'origin')
# A tibble: 16 x 5
#  origin instance year    var     seq
#   <chr>  <chr>    <chr>   <chr> <dbl>
# 1 df1    A        X1990.1 est       1
# 2 df1    A        X1990.2 val       2
# 3 df1    A        X1991.1 est       3
# 4 df1    A        X1991.2 val       4
# 5 df1    B        X1990.1 est       2
# 6 df1    B        X1990.2 val       3
# 7 df1    B        X1991.1 est       4
# 8 df1    B        X1991.2 val       5
# 9 df2    A        X1990.1 est       5
#10 df2    A        X1990.2 val       6
#11 df2    A        X1991.1 est       7
#12 df2    A        X1991.2 val       8
#13 df2    B        X1990.1 est       6
#14 df2    B        X1990.2 val       7
#15 df2    B        X1991.1 est       8
#16 df2    B        X1991.2 val       9

---

如果我们使用函数data_pull

map_dfr(2:20, ~ data_pull(.x) %>%
f1, .id = 'origin')