Reputation: 23
I am trying to change the format of my current data set to one that has 1 user per row, and which splits all the unique values (dynamic number of values) in the Color and Food columns into their own columns with Yes and No. Each user has a unique ID.
Current format:
ID | Name | Color | Food
1 | John | Blue | Pizza
1 | John | Red | Pizza
1 | John | Yellow | Pizza
1 | John | Blue | Ice Cream
1 | John | Red | Ice Cream
1 | John | Yellow | Ice Cream
2 | Kelly | Blue | Pizza
2 | Kelly | Red | Pizza
Desired format:
ID | Name | Color_Blue | Color_Red | Color_Yellow | Food_Pizza | Food_Ice Cream |
1 | John | Yes | Yes | Yes | Yes | Yes |
2 | Kelly | Yes | Yes | No | Yes | No |
Upvotes: 2
Views: 1334
Reputation: 66490
library(dplyr); library(tidyr)
df %>%
pivot_longer(-c(ID:Name)) %>%
unite("col", c(name, value)) %>%
distinct(ID, Name, col) %>%
mutate(val = "Yes") %>%
pivot_wider(names_from = col, values_from = "val", values_fill = "No")
# A tibble: 2 x 7
ID Name Color_Blue Food_Pizza Color_Red Color_Yellow `Food_Ice Cream`
<chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 1 John Yes Yes Yes Yes Yes
2 2 Kelly Yes Yes Yes No No
If you want a base R equivalent, here's one using the same steps. (Can someone please help me figure out how to remove the rownames and the "val." that gets appended to the final column names?)
df2 <- reshape(df,
direction = "long",
varying = c("Color", "Food"),
v.names = "Value",
timevar = "col_name",
times = c("Color", "Food"))
df2$col = paste(df2$col_name, df2$Value, sep = "_")
df3 <- unique(df2[c("ID", "Name", "col")])
df3$val = "Yes"
df4 <- reshape(df3,
direction = "wide",
idvar = c("ID", "Name"),
timevar = "col")
df4[is.na(df4)] <- "No"
> df4
ID Name val.Color_Blue val.Color_Red val.Color_Yellow val.Food_Pizza val.Food_Ice Cream
1.Color 1 John Yes Yes Yes Yes Yes
7.Color 2 Kelly Yes Yes No Yes No
sample data
df <- tribble(~ID , ~Name , ~Color , ~Food,
"1" , "John", "Blue", "Pizza",
"1" , "John" , "Red", "Pizza",
"1" , "John", "Yellow", "Pizza",
"1" , "John" , "Blue", "Ice Cream",
"1" , "John", "Red", "Ice Cream",
"1" , "John" , "Yellow", "Ice Cream",
"2" , "Kelly", "Blue", "Pizza",
"2" , "Kelly", "Red", "Pizza")
Upvotes: 8
Reputation: 5788
Cleaned up base R script:
# Data to import: df => data.frame
df <- structure(list(ID = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L), Name = c("John",
"John", "John", "John", "John", "John", "Kelly", "Kelly"), Color = c("Blue",
"Red", "Yellow", "Blue", "Red", "Yellow", "Blue", "Red"), Food = c("Pizza",
"Pizza", "Pizza", "Ice Cream", "Ice Cream", "Ice Cream", "Pizza",
"Pizza")), class = "data.frame", row.names = c(NA, -8L))
# Function to extract the column names of data.frame
# not contained in a character vector:
# resolve_other_vec_names => function
resolve_other_vec_names <- function(df, vec_names){
# Explicitly define returned object: character vector => env
return(
colnames(df)[!(
colnames(df) %in% vec_names
)
]
)
}
# Create a formula to aggregate a data.frame by:
# resolve_agg_formula => function()
resolve_agg_formula <- function(keep_vecs){
# Formula object to aggregate data.frame by:
# res => formula object
res <- as.formula(
paste(
".",
paste0(
keep_vecs,
collapse = "+"
),
sep = "~"
)
)
# Explicitly define returned object: formula => env
return(res)
}
# Function required to aggregate vector by:
# agg_func => function
agg_func <- function(df, agg_formula){
# Function to agg by: .agg_vec_by => function
.agg_vec_by <- function(x){
ifelse(
any(x),
"Yes",
"No"
)
}
# Aggregate data.frame: res => data.frame
res <- aggregate(
agg_formula,
df,
FUN = .agg_vec_by
)
# Explicitly define the returned object:
# data.frame => env
return(res)
}
# Function to spread a data.frame's vector,
# from unique row-values to column vectors:
# spread_func => function()
spread_func <- function(df, vec_name){
# Extract the unique values of a given vector:
# y => vector
y <- unique(df[,vec_name])
# Determine if a row contains a given value in y:
# row_contains_value_df => boolean data.frame
row_contains_value_df <- data.frame(
outer(
df[,vec_name],
y,
`==`
),
row.names = NULL
)
# Create the data.frame vector names:
# df_vec_names => character vector
df_vec_names <- paste(
vec_name,
y,
sep = "_"
)
# Rename the data.frame vectors: res => data.frame
res <- setNames(
row_contains_value_df,
df_vec_names
)
# Explicitly define the returned object: data.frame => env
return(res)
}
# Function to combine list of data.frames into df:
# df_list_2_df => function
df_list_2_df <- function(df_list, cmb_func = c(rbind, cbind)){
# Resolve the desired combination function:
# cmb_func_resolved => character scalar
cmb_func_resolved <- match.fun(cmb_func)
# Combine list of data.frames into a data.frame
# using a given combination function: res => data.frame
res <- data.frame(
do.call(
cmb_func_resolved,
df_list
),
row.names = NULL
)
# Explicitly define the returned object:
# data.frame => Env
return(res)
}
# Define the main function: main => function
main <- function(){
# Vectors to spread values to columns:
# spread_vecs => character vector
spread_vecs <- c("Color", "Food")
# Vectors to keep as columns: keep_vecs => character vector
keep_vecs <- resolve_other_vec_names(df, spread_vecs)
# Formula to aggregate the data.frame by:
# agg_formula => formula object
agg_formula <- resolve_agg_formula(keep_vecs)
# Resolve if person/id has observed value:
# res => data.frame
res <- agg_func(
cbind(
df[,keep_vecs],
df_list_2_df(
lapply(
spread_vecs,
function(x){
spread_func(df, x)
}
),
cbind
)
),
agg_formula
)
# Print data.frame to console: data.frame => stdout(console)
res
}
# Execute main if called:
if (sys.nframe() == 0){
# Execute the main function: data.frame => stdout(console)
main()
}
Upvotes: 1