How to assign data frame column classes based on column names?

Question

I am stuck trying to figure out how to set classes for columns of a data frame based on their names.

Let's assume I have a named data frame, and I want to add a class to a column via a function. The class is determined in another function using the name of the column:

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")
  }
}

Both of these things work as intended, separately:

> 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"   

But I'd like to figure out how to combine them. This doesn't work:

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)
}

The name assignment still works, but it doesn't seem to be able to add the custom class.

> 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"

What is the problem here?

Also, I'd be interested if there's a way to do it within a dplyr pipeline, instead of the for (i in 1:length(classes_df$name)) {...} part. The problem here is, there doesn't seem to be any function that you can use to mutate a data frame column using the column name as an argument, but my get_class_by_column_name needs the name.

Answer 1

It can be done in a pipeline using the purrr package:

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)

The trick is in purrr::imap, which performs an apply-type operation over a list, and additionally passes the list's names as the second argument. This means it's easy to get the names inside the custom function. The _dfc suffix converts the output (a list of lists) back to a dataframe.

Answer 2

You can use mutate_at, combined with dplyr functions such as starts_with, ends_with, and 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

Here is an attempt modifying your second function:

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))

Result:

$hello
[1] "character" "greeting" 

$world
[1] "character"             "probably_not_greeting"