Skip to content

Instantly share code, notes, and snippets.

@ctesta01
Created January 11, 2022 19:54
Show Gist options
  • Select an option

  • Save ctesta01/daac81b9b8b92ecadde52b51d138b735 to your computer and use it in GitHub Desktop.

Select an option

Save ctesta01/daac81b9b8b92ecadde52b51d138b735 to your computer and use it in GitHub Desktop.

Converting Categorical Variables to Dummy Variables and Vice-Versa

This document introduces a pair of functions which should be intuitive to tidyverse users and standardizes the process for converting categorical columns of data back and forth from a set of dummy variables (columns of TRUE/FALSE indicators for each of the categorical levels).

library(tidyverse)

Convert Categorical Variables to Dummy Variables

This function returns a dataframe modified to contain dummy variables (TRUE/FALSE indicator columns) for each level of the variable specified.

The new column names are automatically constructed to be {variable}_{level} where variable is given as a function argument and level is specified as each unique level of the variable given.

@param df the data.frame to modify

@param a tidy-evaluation style expression that names a column to convert into dummy variables

@param drop_categorical (default: true) an indicator to remove the original variable

@return a modified data.frame

@seealso dummies_to_categorical

categories_to_dummies <- function(df, variable, drop_categorical = TRUE) {

  # capture the tidy evaluation style variable name
  variable_orig <- enquo(variable)

  # convert to a character
  variable <- rlang::quo_name(variable_orig)

  # get the unique levels
  unique_levels <- unique(df[[variable]])

  # for each unique level, construct a new dummy variable
  for (level in unique_levels) {
    df[[paste0(variable, '_', level)]] <- (df[[variable]] == level)
  }

  # if drop_categorical is specified, drop the original variable
  if (drop_categorical) { df <- df %>% select(- c(!! variable_orig)) } 

  return(df)
}

Convert Dummy Variables to Categorical Variables

@param df a data.frame or tibble to modify

@param variable_prefix a tidy-evaluation style expression which is both the new variable name to create and the prefix for the existing dummy variables to convert into the new categorical variable.

@param drop_dummies (default: true) an indicator to drop the dummy variables after creating the new categorical variable

@return a modified data.frame with a new categorical variable based on the dummy variables starting with variable_prefix

@seealso categories_to_dummies

dummies_to_categorical <- function(df, variable_prefix, drop_dummies = TRUE) {

  # capture tidy-evaluation style expression
  var_prefix_orig <- enquo(variable_prefix)

  # get the variable_prefix in character format
  variable_prefix <- rlang::quo_name(var_prefix_orig)

  # construct our regular expression to match variable_prefix columns
  variable_prefix_regex <- stringr::str_glue("^{variable_prefix}_")

  # match on the column names
  matching_varnames <- stringr::str_detect(colnames(df), variable_prefix_regex)

  # extract matching column names
  matching_varnames <- colnames(df)[matching_varnames]

  # get the unique levels based on the column names (after the variable_prefix part)
  unique_levels <- stringr::str_remove_all(matching_varnames, variable_prefix_regex)

  # create a new vector to store categorical levels in
  new_vector <- rep(NA, nrow(df))

  # create an indicator for if there were logical inconsistencies -- namely if
  # multiple dummy variables are true at the same time, this means the dummy
  # variables cannot be represented by a categorical vector that takes on
  # discrete values one-at-a-time
  level_conflicts <- FALSE

  for (i in 1:length(unique_levels)) {
    
    # update the new vector to reflect if the i-th dummy variable is TRUE;
    # 
    # if so, set the ith value in the new_vector to the level corresponding to
    # unique_levels[[i]].

    for (j in 1:length(new_vector)) {
      # if the dummy variable is true
      new_vector[[j]] <- if(df[[matching_varnames[[i]]]][[j]]) { 
        # if the new_vector hasn't already been written into in the jth term
        if (is.na(new_vector[[j]])) {
          # write in the appropriate categorical level
          unique_levels[[i]]
        } else {
          # otherwise not a logical conflict with the dummy variables.
          level_conflicts <- TRUE
        }
      # if the dummy variable is false
      } else {
        # leave the new_vector alone
        new_vector[[j]]
      } 
    }
  }

  # raise errors to reflect issues de-dummying the variables
  if (level_conflicts) {
    stop("conflicts in de-dummying variables")
  }

  # create the new variable
  df[[variable_prefix]] <- new_vector

  # if the user specifies, drop the dummy variables
  if (drop_dummies) { 
    df <- df %>% select(-matching_varnames)
  }

  return(df)
}

Demonstrations

library(magrittr)

# if we copy mtcars into a new object
df <- mtcars 
head(df)
##                    mpg cyl disp  hp drat    wt  qsec vs am gear carb
## Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
## Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
## Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
## Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
## Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
## Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1
# we can convert the cyl variable to dummy variables
df %<>% categories_to_dummies(cyl)
head(df)
##                    mpg disp  hp drat    wt  qsec vs am gear carb cyl_6 cyl_4 cyl_8
## Mazda RX4         21.0  160 110 3.90 2.620 16.46  0  1    4    4  TRUE FALSE FALSE
## Mazda RX4 Wag     21.0  160 110 3.90 2.875 17.02  0  1    4    4  TRUE FALSE FALSE
## Datsun 710        22.8  108  93 3.85 2.320 18.61  1  1    4    1 FALSE  TRUE FALSE
## Hornet 4 Drive    21.4  258 110 3.08 3.215 19.44  1  0    3    1  TRUE FALSE FALSE
## Hornet Sportabout 18.7  360 175 3.15 3.440 17.02  0  0    3    2 FALSE FALSE  TRUE
## Valiant           18.1  225 105 2.76 3.460 20.22  1  0    3    1  TRUE FALSE FALSE
# and we can convert it back 
df %<>% dummies_to_categorical(cyl) 

# if we want to specify the original ordering, we can
df %<>% select(mpg, cyl, everything())

# pay attention that the version converted back will be a character vector
df$cyl %<>% as.numeric()
head(df)
##                    mpg cyl disp  hp drat    wt  qsec vs am gear carb
## Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
## Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
## Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
## Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
## Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
## Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1
# that said, now the version that went through dummy variable creation and
# dummy variable conversion back to a categorical variable is identical with
# the original
identical(df, mtcars)
## [1] TRUE
# similarly we can do this with the palmerpenguins dataset on a factor variable
library(palmerpenguins)
df <- penguins
head(df)
## # A tibble: 6 × 8
##   species island    bill_length_mm bill_depth_mm flipper_length_mm body_mass_g sex     year
##   <fct>   <fct>              <dbl>         <dbl>             <int>       <int> <fct>  <int>
## 1 Adelie  Torgersen           39.1          18.7               181        3750 male    2007
## 2 Adelie  Torgersen           39.5          17.4               186        3800 female  2007
## 3 Adelie  Torgersen           40.3          18                 195        3250 female  2007
## 4 Adelie  Torgersen           NA            NA                  NA          NA <NA>    2007
## 5 Adelie  Torgersen           36.7          19.3               193        3450 female  2007
## 6 Adelie  Torgersen           39.3          20.6               190        3650 male    2007
# convert to dummy variables
df %<>% categories_to_dummies(species)
head(df)
## # A tibble: 6 × 10
##   island    bill_length_mm bill_depth_mm flipper_length_mm body_mass_g sex     year species_Adelie
##   <fct>              <dbl>         <dbl>             <int>       <int> <fct>  <int> <lgl>         
## 1 Torgersen           39.1          18.7               181        3750 male    2007 TRUE          
## 2 Torgersen           39.5          17.4               186        3800 female  2007 TRUE          
## 3 Torgersen           40.3          18                 195        3250 female  2007 TRUE          
## 4 Torgersen           NA            NA                  NA          NA <NA>    2007 TRUE          
## 5 Torgersen           36.7          19.3               193        3450 female  2007 TRUE          
## 6 Torgersen           39.3          20.6               190        3650 male    2007 TRUE          
## # … with 2 more variables: species_Gentoo <lgl>, species_Chinstrap <lgl>
# convert back to a categorical variable
df %<>% dummies_to_categorical(species)

# specify the original ordering
df %<>% select(species, everything())

# specify that we want a factor variable
df$species %<>% factor()
head(df)
## # A tibble: 6 × 8
##   species island    bill_length_mm bill_depth_mm flipper_length_mm body_mass_g sex     year
##   <fct>   <fct>              <dbl>         <dbl>             <int>       <int> <fct>  <int>
## 1 Adelie  Torgersen           39.1          18.7               181        3750 male    2007
## 2 Adelie  Torgersen           39.5          17.4               186        3800 female  2007
## 3 Adelie  Torgersen           40.3          18                 195        3250 female  2007
## 4 Adelie  Torgersen           NA            NA                  NA          NA <NA>    2007
## 5 Adelie  Torgersen           36.7          19.3               193        3450 female  2007
## 6 Adelie  Torgersen           39.3          20.6               190        3650 male    2007
# we can confirm that the converted & un-converted data matches the original 
identical(df, penguins)
## [1] TRUE
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment