Как превратить несколько фреймов данных в список по определенному префиксу

Question

У меня есть несколько фреймов данных. Имена столбцов в этих фреймах данных имеют определенный префикс. Я хотел бы создать список из этих фреймов данных таким образом, чтобы они сохранялись по их префиксу.

---

Для этого примера у меня есть два кадра данных. Каждый с двумя разными префиксами.

dput (head (FEB_gems)) вывод:

structure(list(GAME1_Class = structure(c(2L, 1L, 5L, 4L, 3L), .Label = c("fighter", 
"paladin", "rouge", "sorcerer", "wizard"), class = "factor"), 
GAME1_Race = structure(c(3L, 1L, 4L, 3L, 2L), .Label = c("elf", 
"gnome", "human", "orc"), class = "factor"), GAME1_Alignment = structure(c(4L, 
2L, 1L, 5L, 3L), .Label = c("CE", "CG", "LG", "NE", "NN"), class = "factor"), 
GAME1_Level = c(6, 7, 6, 7, 7), GAME1_Alive = structure(c(1L, 
1L, 1L, 1L, 1L), .Label = "y", class = "factor"), GAME2_Class = structure(c(3L, 
5L, 2L, 4L, 1L), .Label = c("bard", "cleric", "fighter", 
"monk", "wizard"), class = "factor"), GAME2_Race = structure(c(2L, 
3L, 2L, 4L, 1L), .Label = c("dwarf", "elf", "half-elf", "human"
), class = "factor"), GAME2_Alignment = structure(c(4L, 2L, 
1L, 5L, 3L), .Label = c("CE", "CG", "LG", "NE", "NN"), class = "factor"), 
GAME2_Level = c(5, 5, 5, 5, 5), GAME2_Alive = structure(c(1L, 
2L, 2L, 2L, 2L), .Label = c("n", "y"), class = "factor")), row.names = c(NA, 
5L), class = "data.frame")

dput (head (MAR_gems)) вывод:

structure(list(GAME3_Class = structure(c(2L, 1L, 5L, 4L, 3L), .Label = c("barbarian", 
"cleric", "monk", "ranger", "warlock"), class = "factor"), GAME3_Race = structure(c(2L, 
3L, 2L, 4L, 1L), .Label = c("dwarf", "elf", "half-elf", "human"
), class = "factor"), GAME3_Alignment = structure(c(2L, 2L, 1L, 
3L, 2L), .Label = c("CE", "LG", "LN"), class = "factor"), GAME3_Level = c(1, 
1, 1, 1, 1), GAME3_Alive = structure(c(2L, 2L, 2L, 1L, 2L), .Label = c("n", 
"y"), class = "factor"), GAME4_Class = structure(c(2L, 1L, 5L, 
4L, 3L), .Label = c("fighter", "paladin", "rouge", "sorcerer", 
"wizard"), class = "factor"), GAME4_Race = structure(c(2L, 3L, 
2L, 4L, 1L), .Label = c("dwarf", "elf", "half-elf", "human"), class = "factor"), 
GAME4_Alignment = structure(c(1L, 2L, 1L, 4L, 3L), .Label = c("CE", 
"CG", "LG", "LN"), class = "factor"), GAME4_Level = c(5, 
5, 5, 5, 5), GAME4_Alive = structure(c(1L, 2L, 2L, 2L, 2L
), .Label = c("n", "y"), class = "factor")), row.names = c(NA, 
5L), class = "data.frame")

---

Предпринимали попытки сделать это, в том числе:

Разделение информации об игре

CharecterInfo <- function(df){
  names(df) -> rons
  gsub(x=names(df), pattern = '_.*', replacement = '') -> subn
  subn[! duplicated(subn)] -> dupn
  return(dupn)
}

CharecterInfo(FEB_games) -> FCharInfo
CharecterInfo(MAR_games) -> MCharInfo

И затем попытка разделить кадры данных по определенным префиксам.

for (i in FCharInfo) {
  assign(i, FCharInfo[, grep(paste0(i, '\\.'), colnames(FCharInfo), ignore.case = T)])
}

Это не сработало, потому что мои измерения были неправильными, а просто создавали много фреймов данных, а не составляли список

Я также сделал несколько попыток с функцией Map в R, но безуспешно.

---

Мой идеальный вывод будет:

1) Список, содержащий данные «GAME1_», «GAME_2», «GAME_3» и «GAME_4» в качестве отдельных фреймов данных.

2) Желательно в функции, так как мои реальные данные намного больше, чем данные, отображаемые здесь.

Чтобы попытаться проиллюстрировать идеальный список, он бы выглядел следующим образом (я знаю, что отступы / серые прямоугольники предназначены только для кода, но я не знал, как еще проиллюстрировать этот список в стеке потока):

GameInfo

        Game1_
              GAME1_Class
              GAME1_Race
              GAME1_Alignment
              GAME1_Level
              GAME1_Alive
        Game2_
              GAME2_Class
              GAME2_Race
              GAME2_Alignment
              GAME2_Level
              GAME2_Alive
        Game3_
              GAME3_Class
              GAME3_Race
              GAME3_Alignment
              GAME3_Level
              GAME3_Alive
        Game4_
              GAME4_Class
              GAME4_Race
              GAME4_Alignment
              GAME4_Level
              GAME4_Alive

---

Мои префиксы немного сложны, они могут включать:

GAME_1.Class
GAME_10.Class
GAME_100.Class

Я пытался (основываясь на ответе Julian_hn)

Gems <- list(FEB_gems = FEB_games, MAR_gems = MAR_games)
Gems.split <- lapply(Gems, function(df)
{
  Games <- unique(str_extract(names(df),"[:alnum:]+..."))
  List <- lapply(Games,function(name){return(df[,grep(name,names(df))])})
  names(List) <- Games
  return(List)
})  

Но это не делает различий между 1, 100 или 1000. Могу ли я отделить префикс после «.» условное обозначение?

Answer 1

Это работает для меня, если ваши FEB_gem и MAR_gem data.frames структурированы как список.

library(stringr)
Gems <- list(FEB_gems=FEB_gems,MAR_gems=MAR_gems)
Gems.Split <- lapply(Gems,function(df)
{
  #old solution, requires GAME as name
  #Games <- unique(str_extract(names(df),"GAME[0-9]+"))

  #old solution 2: splits at "_"
  #Games <- unique(str_sub(str_extract(names(df),"[:alnum:]+_"),end=-2))

  #new solution: splits at "."
  Games <- unique(str_extract(names(df),"\\S+\\."))
  List <- lapply(Games,function(name){return(df[,grep(name,names(df),fixed=T)])})
  names(List) <- Games
  return(List)
})

Answer 2

Вот способ использования tidyverse :

fseq <- . %>%
  rowid_to_column() %>%
  gather(,,-rowid) %>%
  separate(key,c("game","col")) %>%
  spread(col,value) %>%
  select(-rowid)

map_dfr(list(FEB_gems, MAR_gems), fseq) %>%
  {split(.[-1],.$game)}

# $GAME1
# Alignment Alive    Class Level  Race
# 1        NE     y  paladin     6 human
# 3        CG     y  fighter     7   elf
# 5        CE     y   wizard     6   orc
# 7        NN     y sorcerer     7 human
# 9        LG     y    rouge     7 gnome
# 
# $GAME2
# Alignment Alive   Class Level     Race
# 2         NE     n fighter     5      elf
# 4         CG     y  wizard     5 half-elf
# 6         CE     y  cleric     5      elf
# 8         NN     y    monk     5    human
# 10        LG     y    bard     5    dwarf
# 
# $GAME3
# Alignment Alive     Class Level     Race
# 11        LG     y    cleric     1      elf
# 13        LG     y barbarian     1 half-elf
# 15        CE     y   warlock     1      elf
# 17        LN     n    ranger     1    human
# 19        LG     y      monk     1    dwarf
# 
# $GAME4
# Alignment Alive    Class Level     Race
# 12        CE     n  paladin     5      elf
# 14        CG     y  fighter     5 half-elf
# 16        CE     y   wizard     5      elf
# 18        LN     y sorcerer     5    human
# 20        LG     y    rouge     5    dwarf
# 
# Warning messages:
#   1: attributes are not identical across measure variables;
# they will be dropped 
# 2: attributes are not identical across measure variables;
# they will be dropped 

Answer 3

Другое возможное (вложенное) tidyverse решение:

library(tidyverse)

t_tib <- function(df) {
  as_tibble(cbind(nms = names(df), t(df)))
}

GameInfo <- t_tib(FEB_gems) %>% 
  bind_rows(t_tib(MAR_gems)) %>% 
  gather(rowid, val, -nms) %>% 
  separate(nms, into = c("Game", "var")) %>% 
  spread(var, val) %>% 
  select(-rowid) %>%
  select(1, 4, 6, 2, 5, 3) %>% 
  nest(-Game)

(удалено bind_cols за предложение Moody_Mudskipper.)