将多个 sub-headers 转置为 R 中的因子列
Transpose multiple sub-headers into factor column in R
structure(list(
fecha = c("Fuente:La Nueva Viga, DF", "20/02/2020",
"20/02/2020", "20/02/2020", "20/02/2020", "Fuente:Monterrey, Nuevo León",
"20/02/2020", "20/02/2020", "20/02/2020", "20/02/2020", "17/02/2020",
"17/02/2020"),
producto = c("Fuente:La Nueva Viga, DF", "Aleta de raya",
"Bandera", "Besugo", "Cazón con cabeza", "Fuente:Monterrey, Nuevo León",
"Huachinango Golfo", "Pampano", "Sargo", "Trucha marina", "Huachinango Golfo",
"Pampano"), origen = c("Fuente:La Nueva Viga, DF", "Tabasco",
"Campeche", "Veracruz", "Veracruz", "Fuente:Monterrey, Nuevo León",
"Tamaulipas", "Tamaulipas", "Tamaulipas", "Tamaulipas", "Tamaulipas",
"Tamaulipas"),
pmin = c("Fuente:La Nueva Viga, DF", "23.00",
"35.00", "15.00", "60.00", "Fuente:Monterrey, Nuevo León", "165.00",
"--", "--", "--", "210.00", "--"), pmax = c("Fuente:La Nueva Viga, DF",
"27.00", "39.00", "19.00", "65.00", "Fuente:Monterrey, Nuevo León",
"200.00", "--", "--", "--", "220.00", "--"),
pfrec = c("Fuente:La Nueva Viga, DF",
"25.00", "37.00", "17.00", "63.00", "Fuente:Monterrey, Nuevo León",
"190.00", "195.00", "84.00", "98.00", "215.00", "195.00"),
obs = c("Fuente:La Nueva Viga, DF",
"", "", "", "", "Fuente:Monterrey, Nuevo León", "OBS", "OBS",
"OBS", "OBS", "OBS", "OBS"),
category = c("pescado", "pescado",
"pescado", "pescado", "pescado", "pescado", "pescado", "pescado",
"pescado", "pescado", "pescado", "pescado")),
row.names = c(2L, 3L, 4L, 5L, 6L, 341L, 342L, 343L, 344L, 345L, 346L, 347L), class = "data.frame")
上面的数据集有 6 列，但是 table 带有 sub-header（例如，Fuente: La Nueva Viga, DF）。
完整的数据集要大得多（> 9000 行）；每个 sub-header.
下的行数不同
我想转置 sub-header 以创建一个名为“Fuente”的新列，该列显示“:”之后的文本。
由于 data.frame 中的行数和每个 sub-header 之间的列数不一致，我不能轻易使用 rep() 或类似的东西（或在至少我不知道怎么做）。
我正在寻找的输出示例如下：
fecha producto origen pmin pmax pfrec obs category Fuente
1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 pescado La Nueva Viga, DF
2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 pescado La Nueva Viga, DF
3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 pescado La Nueva Viga, DF
4 20/02/2020 Cazón con cabeza Veracruz 60.00 65.00 63.00 pescado La Nueva Viga, DF
5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 OBS pescado Monterrey, Nuevo León
6 20/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado Monterrey, Nuevo León
这里有一种可能性（假设所有sub-headers都以Fuente开头）使用tidyverse。在这里，我通过收集所有行直到 Fuente 出现在后续行中来创建分组列 (idx)。然后，我将它们分成单独的数据框并放入列表中。然后，我使用 map 将函数应用于该列表。我在 Fuente 之后提取文本，然后将其复制到该数据框中的所有行。最后，我将数据帧列表重新绑定在一起。
Tidyverse
library(tidyverse)
df %>%
group_by(idx = cumsum(str_detect(fecha, "Fuente"))) %>%
group_split(., .keep = FALSE) %>%
map(., function(x)
x %>%
mutate(Fuente = sub('.*:\s*', "", fecha)[1]) %>%
slice(-1)) %>%
bind_rows()
或者，如果您除了 Fuente 之外还有其他 sub-headers，那么您可以在 group_by(idx = cumsum(str_detect(fecha, "[a-z]")) 中使用“[a-z]”，而不是“Fuente”。
Data.table
使用 data.table 的另一个选项：
setDT(dt)[, Fuente := ifelse(grepl(':', df$fecha, fixed = TRUE),
sub('.*:\s*', "", df$fecha), NA)]
dt[, Fuente := Fuente[nafill(replace(.I, is.na(Fuente), NA), "locf")]]
dt <- dt[!grepl("Fuente", dt$fecha),]
输出
fecha producto origen pmin pmax pfrec obs category Fuente
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 "" pescado La Nueva Viga, DF
2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 "" pescado La Nueva Viga, DF
3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 "" pescado La Nueva Viga, DF
4 20/02/2020 Cazón con cabeza Veracruz 60.00 65.00 63.00 "" pescado La Nueva Viga, DF
5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 "OBS" pescado Monterrey, Nuevo León
6 20/02/2020 Pampano Tamaulipas -- -- 195.00 "OBS" pescado Monterrey, Nuevo León
7 20/02/2020 Sargo Tamaulipas -- -- 84.00 "OBS" pescado Monterrey, Nuevo León
8 20/02/2020 Trucha marina Tamaulipas -- -- 98.00 "OBS" pescado Monterrey, Nuevo León
9 17/02/2020 Huachinango Golfo Tamaulipas 210.00 220.00 215.00 "OBS" pescado Monterrey, Nuevo León
10 17/02/2020 Pampano Tamaulipas -- -- 195.00 "OBS" pescado Monterrey, Nuevo León
基准
data.table 比任何 tidyverse 选项都快
library(tidyverse)
df %>%
mutate(grp = str_detect(string = fecha, pattern = ":"),
fuente = ifelse(grp, sub('.*:', '', fecha), NA_real_)) %>%
fill(fuente) %>%
filter(!grp) %>%
select(-grp)
#> fecha producto origen pmin pmax pfrec obs category
#> 1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 pescado
#> 2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 pescado
#> 3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 pescado
#> 4 20/02/2020 Cazon con cabeza Veracruz 60.00 65.00 63.00 pescado
#> 5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 OBS pescado
#> 6 20/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado
#> 7 20/02/2020 Sargo Tamaulipas -- -- 84.00 OBS pescado
#> 8 20/02/2020 Trucha marina Tamaulipas -- -- 98.00 OBS pescado
#> 9 17/02/2020 Huachinango Golfo Tamaulipas 210.00 220.00 215.00 OBS pescado
#> 10 17/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado
#> fuente
#> 1 La Nueva Viga, DF
#> 2 La Nueva Viga, DF
#> 3 La Nueva Viga, DF
#> 4 La Nueva Viga, DF
#> 5 Monterrey, Nuevo Leon
#> 6 Monterrey, Nuevo Leon
#> 7 Monterrey, Nuevo Leon
#> 8 Monterrey, Nuevo Leon
#> 9 Monterrey, Nuevo Leon
#> 10 Monterrey, Nuevo Leon
由 reprex package (v2.0.1)
创建于 2022-01-22
这是另一种 tidyverse 方法，要点是添加新列 add_column 来自 tibble 包和数据整理：
- 过滤所有包含
Fuente 的行
- 绑定到原始 df 以获得相等的列长度！
- 通过获取长格式的 df 过滤和整理来添加新列
- 使用过滤器
! 删除包含 Fuente: 的行
library(tidyverse)
df %>%
filter(if_any(everything(), ~str_detect(., "Fuente"))) %>%
bind_rows(df) %>%
add_column(df %>%
pivot_longer(everything(), values_to = "Fuente") %>%
filter(str_detect(Fuente, "Fuente")) %>%
mutate(Fuente = sub('.*:', '', Fuente)) %>%
select(-name)
)%>%
filter(!if_any(everything(), ~str_detect(fecha, "Fuente:")))
fecha producto origen pmin pmax pfrec obs category Fuente
1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 pescado La Nueva Viga, DF
2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 pescado La Nueva Viga, DF
3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 pescado La Nueva Viga, DF
4 20/02/2020 Cazón con cabeza Veracruz 60.00 65.00 63.00 pescado La Nueva Viga, DF
5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 OBS pescado Monterrey, Nuevo León
6 20/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado Monterrey, Nuevo León
7 20/02/2020 Sargo Tamaulipas -- -- 84.00 OBS pescado Monterrey, Nuevo León
8 20/02/2020 Trucha marina Tamaulipas -- -- 98.00 OBS pescado Monterrey, Nuevo León
9 17/02/2020 Huachinango Golfo Tamaulipas 210.00 220.00 215.00 OBS pescado Monterrey, Nuevo León
10 17/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado Monterrey, Nuevo León
structure(list(
fecha = c("Fuente:La Nueva Viga, DF", "20/02/2020",
"20/02/2020", "20/02/2020", "20/02/2020", "Fuente:Monterrey, Nuevo León",
"20/02/2020", "20/02/2020", "20/02/2020", "20/02/2020", "17/02/2020",
"17/02/2020"),
producto = c("Fuente:La Nueva Viga, DF", "Aleta de raya",
"Bandera", "Besugo", "Cazón con cabeza", "Fuente:Monterrey, Nuevo León",
"Huachinango Golfo", "Pampano", "Sargo", "Trucha marina", "Huachinango Golfo",
"Pampano"), origen = c("Fuente:La Nueva Viga, DF", "Tabasco",
"Campeche", "Veracruz", "Veracruz", "Fuente:Monterrey, Nuevo León",
"Tamaulipas", "Tamaulipas", "Tamaulipas", "Tamaulipas", "Tamaulipas",
"Tamaulipas"),
pmin = c("Fuente:La Nueva Viga, DF", "23.00",
"35.00", "15.00", "60.00", "Fuente:Monterrey, Nuevo León", "165.00",
"--", "--", "--", "210.00", "--"), pmax = c("Fuente:La Nueva Viga, DF",
"27.00", "39.00", "19.00", "65.00", "Fuente:Monterrey, Nuevo León",
"200.00", "--", "--", "--", "220.00", "--"),
pfrec = c("Fuente:La Nueva Viga, DF",
"25.00", "37.00", "17.00", "63.00", "Fuente:Monterrey, Nuevo León",
"190.00", "195.00", "84.00", "98.00", "215.00", "195.00"),
obs = c("Fuente:La Nueva Viga, DF",
"", "", "", "", "Fuente:Monterrey, Nuevo León", "OBS", "OBS",
"OBS", "OBS", "OBS", "OBS"),
category = c("pescado", "pescado",
"pescado", "pescado", "pescado", "pescado", "pescado", "pescado",
"pescado", "pescado", "pescado", "pescado")),
row.names = c(2L, 3L, 4L, 5L, 6L, 341L, 342L, 343L, 344L, 345L, 346L, 347L), class = "data.frame")
上面的数据集有 6 列，但是 table 带有 sub-header（例如，Fuente: La Nueva Viga, DF）。
完整的数据集要大得多（> 9000 行）；每个 sub-header.
我想转置 sub-header 以创建一个名为“Fuente”的新列，该列显示“:”之后的文本。
由于 data.frame 中的行数和每个 sub-header 之间的列数不一致，我不能轻易使用 rep() 或类似的东西（或在至少我不知道怎么做）。
我正在寻找的输出示例如下：
fecha producto origen pmin pmax pfrec obs category Fuente
1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 pescado La Nueva Viga, DF
2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 pescado La Nueva Viga, DF
3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 pescado La Nueva Viga, DF
4 20/02/2020 Cazón con cabeza Veracruz 60.00 65.00 63.00 pescado La Nueva Viga, DF
5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 OBS pescado Monterrey, Nuevo León
6 20/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado Monterrey, Nuevo León
这里有一种可能性（假设所有sub-headers都以Fuente开头）使用tidyverse。在这里，我通过收集所有行直到 Fuente 出现在后续行中来创建分组列 (idx)。然后，我将它们分成单独的数据框并放入列表中。然后，我使用 map 将函数应用于该列表。我在 Fuente 之后提取文本，然后将其复制到该数据框中的所有行。最后，我将数据帧列表重新绑定在一起。
Tidyverse
library(tidyverse)
df %>%
group_by(idx = cumsum(str_detect(fecha, "Fuente"))) %>%
group_split(., .keep = FALSE) %>%
map(., function(x)
x %>%
mutate(Fuente = sub('.*:\s*', "", fecha)[1]) %>%
slice(-1)) %>%
bind_rows()
或者，如果您除了 Fuente 之外还有其他 sub-headers，那么您可以在 group_by(idx = cumsum(str_detect(fecha, "[a-z]")) 中使用“[a-z]”，而不是“Fuente”。
Data.table
使用 data.table 的另一个选项：
setDT(dt)[, Fuente := ifelse(grepl(':', df$fecha, fixed = TRUE),
sub('.*:\s*', "", df$fecha), NA)]
dt[, Fuente := Fuente[nafill(replace(.I, is.na(Fuente), NA), "locf")]]
dt <- dt[!grepl("Fuente", dt$fecha),]
输出
fecha producto origen pmin pmax pfrec obs category Fuente
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 "" pescado La Nueva Viga, DF
2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 "" pescado La Nueva Viga, DF
3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 "" pescado La Nueva Viga, DF
4 20/02/2020 Cazón con cabeza Veracruz 60.00 65.00 63.00 "" pescado La Nueva Viga, DF
5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 "OBS" pescado Monterrey, Nuevo León
6 20/02/2020 Pampano Tamaulipas -- -- 195.00 "OBS" pescado Monterrey, Nuevo León
7 20/02/2020 Sargo Tamaulipas -- -- 84.00 "OBS" pescado Monterrey, Nuevo León
8 20/02/2020 Trucha marina Tamaulipas -- -- 98.00 "OBS" pescado Monterrey, Nuevo León
9 17/02/2020 Huachinango Golfo Tamaulipas 210.00 220.00 215.00 "OBS" pescado Monterrey, Nuevo León
10 17/02/2020 Pampano Tamaulipas -- -- 195.00 "OBS" pescado Monterrey, Nuevo León
基准
data.table 比任何 tidyverse 选项都快
library(tidyverse)
df %>%
mutate(grp = str_detect(string = fecha, pattern = ":"),
fuente = ifelse(grp, sub('.*:', '', fecha), NA_real_)) %>%
fill(fuente) %>%
filter(!grp) %>%
select(-grp)
#> fecha producto origen pmin pmax pfrec obs category
#> 1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 pescado
#> 2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 pescado
#> 3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 pescado
#> 4 20/02/2020 Cazon con cabeza Veracruz 60.00 65.00 63.00 pescado
#> 5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 OBS pescado
#> 6 20/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado
#> 7 20/02/2020 Sargo Tamaulipas -- -- 84.00 OBS pescado
#> 8 20/02/2020 Trucha marina Tamaulipas -- -- 98.00 OBS pescado
#> 9 17/02/2020 Huachinango Golfo Tamaulipas 210.00 220.00 215.00 OBS pescado
#> 10 17/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado
#> fuente
#> 1 La Nueva Viga, DF
#> 2 La Nueva Viga, DF
#> 3 La Nueva Viga, DF
#> 4 La Nueva Viga, DF
#> 5 Monterrey, Nuevo Leon
#> 6 Monterrey, Nuevo Leon
#> 7 Monterrey, Nuevo Leon
#> 8 Monterrey, Nuevo Leon
#> 9 Monterrey, Nuevo Leon
#> 10 Monterrey, Nuevo Leon
由 reprex package (v2.0.1)
创建于 2022-01-22这是另一种 tidyverse 方法，要点是添加新列 add_column 来自 tibble 包和数据整理：
- 过滤所有包含
Fuente的行
- 绑定到原始 df 以获得相等的列长度！
- 通过获取长格式的 df 过滤和整理来添加新列
- 使用过滤器
!删除包含Fuente: 的行
library(tidyverse)
df %>%
filter(if_any(everything(), ~str_detect(., "Fuente"))) %>%
bind_rows(df) %>%
add_column(df %>%
pivot_longer(everything(), values_to = "Fuente") %>%
filter(str_detect(Fuente, "Fuente")) %>%
mutate(Fuente = sub('.*:', '', Fuente)) %>%
select(-name)
)%>%
filter(!if_any(everything(), ~str_detect(fecha, "Fuente:")))
fecha producto origen pmin pmax pfrec obs category Fuente
1 20/02/2020 Aleta de raya Tabasco 23.00 27.00 25.00 pescado La Nueva Viga, DF
2 20/02/2020 Bandera Campeche 35.00 39.00 37.00 pescado La Nueva Viga, DF
3 20/02/2020 Besugo Veracruz 15.00 19.00 17.00 pescado La Nueva Viga, DF
4 20/02/2020 Cazón con cabeza Veracruz 60.00 65.00 63.00 pescado La Nueva Viga, DF
5 20/02/2020 Huachinango Golfo Tamaulipas 165.00 200.00 190.00 OBS pescado Monterrey, Nuevo León
6 20/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado Monterrey, Nuevo León
7 20/02/2020 Sargo Tamaulipas -- -- 84.00 OBS pescado Monterrey, Nuevo León
8 20/02/2020 Trucha marina Tamaulipas -- -- 98.00 OBS pescado Monterrey, Nuevo León
9 17/02/2020 Huachinango Golfo Tamaulipas 210.00 220.00 215.00 OBS pescado Monterrey, Nuevo León
10 17/02/2020 Pampano Tamaulipas -- -- 195.00 OBS pescado Monterrey, Nuevo León