Как назначить классы столбцов данных на основе имен столбцов?

Question

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

Давайте предположим, что у меня есть именованный фрейм данных, и я хочудобавить класс в столбец с помощью функции.Класс определяется в другой функции, используя имя столбца:

library(dplyr)

df1 <- data.frame(hello = 1:4, world = 2:5)

add_class <- function(x, my_class) {
  structure(x, class = c(class(x), my_class))
}

get_class_by_column_name <- function(column_name) {
  if(grepl("hello", tolower(column_name))) {
    return("greeting")
  } else {
    return("probably_not_greeting")
  }
}

Обе эти вещи работают по назначению, отдельно:

> class(df1$hello)
[1] "integer"

> df1$hello <- add_class(df1$hello, "class_added_manually")
> class(df1$hello)
[1] "integer"              "class_added_manually"

> df1$hello <- add_class(df1$hello, get_class_by_column_name("hello"))
> class(df1$hello)
[1] "integer"              "class_added_manually" "greeting"   

Но я хотел бы выяснить,как их объединить.Это не работает:

set_classes_by_column_names <- function(df) {

  classes_df <- data.frame(name = names(df), class = '') %>%
    rowwise %>%
    mutate(class = get_class_by_column_name(name))

  print(classes_df)

  for (i in 1:length(classes_df$name)) {
    add_class(my_column = df[,classes_df$name[i]],  # select column by name
              my_class = classes_df$class[i])       # use column name as function argument to find class
  }

  return(df)
}

Назначение имени все еще работает, но кажется, что он не может добавить пользовательский класс.

> df2 <- data.frame(hello = 1:4, world = 2:5)
> class(df2$hello)
[1] "integer"

> df2 <- set_classes_by_column_names(df2)
Source: local data frame [2 x 2]
Groups: <by row>

# A tibble: 2 x 2
  name  class                
  <fct> <chr>                
1 hello greeting             
2 world probably_not_greeting
> class(df2$hello)
[1] "integer"

В чем здесь проблема?

Кроме того, мне было бы интересно, если есть способ сделать это в конвейере dplyr вместо for (i in 1:length(classes_df$name)) {...} часть.Проблема здесь в том, что, похоже, не существует какой-либо функции, которую можно использовать для изменения столбца фрейма данных с использованием имени столбца в качестве аргумента, но моему get_class_by_column_name нужно имя.

Answer 1

Это можно сделать в конвейере с использованием пакета purrr:

library(dplyr)
library(purrr)

set_class_by_name <- function(col, name) {
  if (grepl("hello", name)) {
    new_class <- "greeting"
  } else {
    new_class <- "probably_not_greeting"
  }

  return(structure(col, class = c(class(col), new_class)))
}

df2 <- df1 %>%
  imap_dfc(set_class_by_name)

Трюк в purrr::imap, который выполняет операцию применения типа над списком и дополнительно передает списокимена в качестве второго аргумента.Это означает, что легко получить имена внутри пользовательской функции.Суффикс _dfc преобразует выходные данные (список списков) обратно в фрейм данных.

Answer 2

Вы можете использовать mutate_at в сочетании с функциями dplyr, такими как starts_with, ends_with и contains

df1 <- data.frame(hello = 1:4, world = 2:5, 
                  cello = c('a', 'b'), sword = c(T, F))

df2 <- 
  df1 %>% 
    mutate_at(vars(starts_with('h')), add_class, 'zebra') %>% 
    mutate_at(vars(ends_with('d')), add_class, 'cow') %>% 
    mutate_at(vars(contains('cel')), add_class, 'giraffe')

lapply(df2, class)

# 
# $`hello`
# [1] "integer" "zebra"  
# 
# $world
# [1] "integer" "cow"    
# 
# $cello
# [1] "factor"  "giraffe"
# 
# $sword
# [1] "logical" "cow"    

Answer 3

Вот попытка изменить вашу вторую функцию:

EDIT ::

get_class_by_column_name <- function(column_name) {
  if(tolower(column_name)%in%c("hello")){
    class(column_name)<-append(class(column_name),"greeting")[[2]]
    #return(column_name)
  } else {
    class(column_name)<-append(class(column_name),"probably_not_greeting")[[2]]
    #return(class(column_name))
  }
}
unlist(Map(get_class_by_column_name,names(df1)))
                  hello                   world 
             "greeting" "probably_not_greeting" 

ORIGINAL ::

get_class_by_column_name <- function(column_name) {
  if(grepl("hello", tolower(column_name))) {
    class(column_name)<-append(class(column_name),"greeting")
    return(class(column_name))
  } else {
    class(column_name)<-append(class(column_name),"probably_not_greeting")
    return(class(column_name))
  }
}
Map(get_class_by_column_name,names(df1))

Результат:

$hello
[1] "character" "greeting" 

$world
[1] "character"             "probably_not_greeting"