Restructuring data using apply family of functions - r

I have inherited a data set that is 23 attributes measured for each of 13 names (between-subjects--each participant only rated one name on all of these attributes). Right now it's structured such that the attributes are the fastest-moving factor, followed by the name. So the the data look like this:
Sub# N1-item1 N1-item2 N1-item3 […] N2-item1 N2-item2 N2-item3
1 3 5 3 NA NA NA
2 NA NA NA 1 5 3
3 3 5 3 NA NA NA
4 NA NA NA 2 2 1
It needs to be restructured it such that it's collapsed over name, and all of the item1 entries are the same column (subjects don't matter for this purpose), as below (bearing in mind that there are 23 items not 3 and 13 names not 2):
Name item1 item2 item3
N1 3 5 3
N2 1 5 3
I can do this with loops and, but I'd rather do it in a manner more natural to R, which I'm guessing would be one of the apply family of functions, but I can't quite wrap my head around it--what is the smart way to do this?

Here's an answer using dplyr and tidyr:
library(dplyr)#loads libraries
library(tidyr)
dat %>% #name of your dataframe
gather(key, val, -Sub) %>% #gathers to long data, with id as Sub
filter(!is.na(val)) %>% #removes rows with NA for the value
separate(key, c("Name", "item")) %>% #split the column key into Name and item
spread(item, val) #spreads the data into wide format, with item as the columns
Sub Name item1 item2 item3
1 1 N1 3 5 3
2 2 N2 1 5 3
3 3 N1 3 5 3
4 4 N2 2 2 1

Spin the column names around to be itemX-NY and then let reshape sort it out:
names(dat)[-1] <- gsub("(^.+?)-(.+?$)", "\\2-\\1", names(dat)[-1])
na.omit(reshape(dat, direction="long", idvar="Sub", varying=-1, sep="-"))
# Sub time item1 item2 item3
#1.N1 1 N1 3 5 3
#3.N1 3 N1 3 5 3
#2.N2 2 N2 1 5 3
#4.N2 4 N2 2 2 1
Where the data was:
dat <- structure(list(Sub = 1:4, `item1-N1` = c(3L, NA, 3L, NA), `item2-N1` = c(5L,
NA, 5L, NA), `item3-N1` = c(3L, NA, 3L, NA), `item1-N2` = c(NA,
1L, NA, 2L), `item2-N2` = c(NA, 5L, NA, 2L), `item3-N2` = c(NA,
3L, NA, 1L)), .Names = c("Sub", "item1-N1", "item2-N1", "item3-N1",
"item1-N2", "item2-N2", "item3-N2"), row.names = c(NA, -4L), class = "data.frame

Related

R Merge duplicate columns that have different values in one dataframe

I currently have survey data where a set of Likert-type questions appears twice in the dataset and the set of questions a participant answered depends on an initial response to a binary "check" question. My goal is to merge the sets of duplicate questions. The data looks something like this:
Check
Q1
Q2
Q3
Q1.1
Q2.1
Q3.1
1
5
5
4
1
2
5
3
2
4
6
3
2
4
2
1
...where Q1.1 is a duplicate of Q1, and so on for Q2 and Q3
And I'd like my final output to look like this:
Check
Q1
Q2
Q3
1
5
5
4
1
2
5
3
2
4
6
3
2
4
2
1
I've been testing out a variety of ideas using things like for-loops, sapply, paste, and cbind. I've run into walls with each of them, particularly because I need to somehow match questions (ex. Q1 gets Q1.1's value when check==2) and run this over a set of multiple columns in one dataset.
Any help on this would be greatly appreciated!
If the missing elements are NA, pivot_longer can be used
library(tidyr)
pivot_longer(df1, cols = -Check, names_pattern = "^(Q\\d+).*",
names_to = ".value", values_drop_na = TRUE)
-output
# A tibble: 4 × 4
Check Q1 Q2 Q3
<int> <int> <int> <int>
1 1 5 5 4
2 1 2 5 3
3 2 4 6 3
4 2 4 2 1
data
df1 <- structure(list(Check = c(1L, 1L, 2L, 2L), Q1 = c(5L, 2L, NA,
NA), Q2 = c(5L, 5L, NA, NA), Q3 = c(4L, 3L, NA, NA), Q1.1 = c(NA,
NA, 4L, 4L), Q2.1 = c(NA, NA, 6L, 2L), Q3.1 = c(NA, NA, 3L, 1L
)), class = "data.frame", row.names = c(NA, -4L))
In the check column do the numbers represent individuals? Does each individual have 2 rows of data? Or is this example table all for a single individual that will have 4 rows of data?
If all 4 rows are for 1 person I would structure the table like this if its not already.
Subject Check Q1 Q2 Q3 Q1_1 Q2_1 Q3_1
1 1
1 1
1 2
1 2
There are endless ways of doing this. Based on my knowledge I would subset the dataset into 2 tables for each subject, one for check - 1 and one for check = 2, and then just use rbind to stack them on top of each other. That is what poppiytt did when they created an example dataset but they didn't add a column for subject.
data1 <- (data, check == 1, select = c(subject, check, Q1, Q2, Q3))
data2 <- (data, check == 2, select = c(subject, check, Q1_1, Q2_1, Q3_1))
data3 <- rbind(data1, data2)
I'm sure there is a more efficient way to do this but this will work.

r apply functions over list of data frames

Help with applying functions over a list of data frames.
I don't often work with lists or functions so following a 3 hour search and test I need some assistance.
I have a list of 2 data frames as follows (real list has 40+):
df1 <- structure(list(ID = 1:4,
Period = c("C_2021", "C_2021", "C_2021", "C_2021"),
subjects = c(2044L, 2044L, 2058L, 2059L),
Q_1_A = c(1L, 1L, 4L, 6L),
Q_1_B = c(6L, 1L, 6L, NA),
col3 = c(4L, 6L, 5L, 2L),
col4 = c(3L, 5L, 4L, 4L)),
class = "data.frame", row.names = c(NA, -4L))
df2 <- structure(list(ID = 1:4,
Period = c("C_2022", "C_2022", "C_2022", "C_2022"),
subjects = c(2058L, 2058L, 2065L, 2066L),
Q_1_A = c(2L, 5L, 5L, 6L),
Q_1_B = c(6L, 1L, 4L, NA),
col3 = c(NA, 6L, 5L, 3L),
col4 = c(3L, 6L, 5L, 5L)),
class = "data.frame", row.names = c(NA, -4L))
The structure of the datasets are as follows:
df1
ID Period subjects Q_1_A Q_1_B col3 col4
1 1 C_2021 2044 1 6 4 3
2 2 C_2021 2044 1 1 6 5
3 3 C_2021 2058 4 6 5 4
4 4 C_2021 2059 6 NA 2 4
df2
ID Period subjects Q_1_A Q_1_B col3 col4
1 1 C_2022 2058 2 6 NA 3
2 2 C_2022 2058 5 1 6 6
3 3 C_2022 2065 5 4 5 5
4 4 C_2022 2066 6 NA 3 5
The list of df's
dflist <- list(df1, df2)
I would like to do 2 things:
1. Conditional removal of string before 2nd underscore
I would like to remove characters before the 2nd underscore only in columns beginning with "Q". Column "Q_1_A" would become "A". The code should only impact columns starting with "Q".
Note: The ifelse is important - in the real data there are other columns with 2 underscores that cannot be modified, and the columns in data frames may be in different orders so it needs to be done by column name.
#doesnt work (cant seem to get purr working either)
dflist <- lapply(dflist, function(x) {
names(x) <- ifelse(starts_with(names(x), "Q"), sub("^[^_]*_", "", names(x)), .x)
x})
2. Once column names are updated, remove columns present on a list.
Note: In the real data there are a lot of columns in each df, it's much easier to list the columns to keep rather than remove.
List of columns to keep below
List is structured assuming the gsub above has been complete.
col_keep <- c("ID", "Period", "subjects", "A", "B")
#doesnt work
dflist <- lapply(dflist, function(x) {
x[(names(x) %in% col_keep)]
x})
**UPDATE** I think actually the following will work
dflist <- lapply(dflist, function(x)
{x <- x %>% select(any_of(col_keep))})
#is the best way to do it?
Help would be greatly appreciated.
For the first required apply this
dflist <- lapply(dflist, function(x) {
names(x) <- ifelse(startsWith(names(x), "Q"),
gsub("[Q_0-9]+", "" , names(x)), names(x))
x})
and the second
col_keep <- c("ID", "Period", "subjects", "A", "B")
dflist <- lapply(dflist, function(x) subset(x , select = col_keep))
In base R:
lapply(dflist, \(x)setNames(x, sub('^Q([^_]*_){2}', '', names(x)))[col_keep])
[[1]]
ID Period subjects A B
1 1 C_2021 2044 1 6
2 2 C_2021 2044 1 1
3 3 C_2021 2058 4 6
4 4 C_2021 2059 6 NA
[[2]]
ID Period subjects A B
1 1 C_2022 2058 2 6
2 2 C_2022 2058 5 1
3 3 C_2022 2065 5 4
4 4 C_2022 2066 6 NA
in tidyverse:
library(tidyverse)
dflist %>%
map(~rename_with(.,~str_remove(.,'([^_]+_){2}'), starts_with('Q'))%>%
select(all_of(col_keep)))
[[1]]
ID Period subjects A B
1 1 C_2021 2044 1 6
2 2 C_2021 2044 1 1
3 3 C_2021 2058 4 6
4 4 C_2021 2059 6 NA
[[2]]
ID Period subjects A B
1 1 C_2022 2058 2 6
2 2 C_2022 2058 5 1
3 3 C_2022 2065 5 4
4 4 C_2022 2066 6 NA
Another solutions using base:
# wrap up code for ease of reading
validate_names <- function(df) {
setNames(df, ifelse(grepl("^Q", names(df)),
gsub("[Q_0-9]", "", names(df)), names(df)))
}
# lapply to transform list, then subset with character vector
lapply(dflist, validate_names) |>
lapply(`[`, col_keep)

Aggregating rows across multiple values

I have a large dataframe with approximately this pattern:
Person
Rate
Street
a
b
c
d
e
f
A
2
XYZ
1
NULL
3
4
5
NULL
A
2
XYZ
NULL
2
NULL
NULL
NULL
NULL
A
3
XYZ
NULL
NULL
NULL
NULL
NULL
6
B
2
DEF
NULL
NULL
NULL
NULL
5
NULL
B
2
DEF
NULL
2
3
NULL
NULL
6
C
1
DEF
1
2
3
4
5
6
A, b, c, d, e, f represents about 600 columns.
I am trying to combine the columns so that each person becomes one line, rows a-f combine into a single line using sum, and any conflicting rate or street information becomes a new row. So the data should look something like this:
Person
Rate
Rate 2
Street
a
b
c
d
e
f
A
2
3
XYZ
1
2
3
4
5
6
B
2
DEF
NULL
2
3
NULL
5
6
C
1
DEF
1
2
3
4
5
6
I keep trying to make this work with aggregate and summarize but I'm not sure that's the right approach.
Thank you very much for your help!
First we pivot all the unique rates per person and street.
library(reshape2)
tmp1=dcast(unique(df[,c("Person","Rate","Street")]),Person+Street~Rate,value.var="Rate")
colnames(tmp1)[-c(1:2)]=paste("Rate",colnames(tmp1)[-c(1:2)])
Then we aggregate and sum by person and rate, columns 4 to 9, from "a" to "f", change accordingly.
tmp2=aggregate(df[,4:9],list(Person=df$Person,Street=df$Street),function(x){
ifelse(all(is.na(x)),NA,sum(x,na.rm=T))
})
And finally merge the two.
merge(tmp1,tmp2,by=c("Person","Street"))
Person Street Rate 1 Rate 2 Rate 3 a b c d e f
1 A XYZ NA 2 3 1 2 3 4 5 6
2 B DEF NA 2 NA NA 2 3 NA 5 6
3 C DEF 1 NA NA 1 2 3 4 5 6
Perhaps, you can do this in two-step process -
library(dplyr)
library(tidyr)
#sum columns a-f
table1 <- df %>%
group_by(Person) %>%
summarise(across(a:f, sum, na.rm = TRUE))
#Remove duplicated values and get the data in separate columns
#for Rate and Street columns.
table2 <- df %>%
group_by(Person) %>%
mutate(across(c(Rate, Street), ~replace(., duplicated(.), NA))) %>%
select(Person, Rate, Street) %>%
filter(if_any(c(Rate, Street), ~!is.na(.))) %>%
mutate(col = row_number()) %>%
ungroup %>%
pivot_wider(names_from = col, values_from = c(Rate, Street)) %>%
select(where(~any(!is.na(.))))
#Join the two data to get final result
inner_join(table1, table2, by = 'Person')
# Person a b c d e f Rate_1 Rate_2 Street_1
# <chr> <int> <int> <int> <int> <int> <int> <int> <int> <chr>
#1 A 1 2 3 4 5 6 2 3 XYZ
#2 B 0 2 3 0 5 6 2 NA DEF
#3 C 1 2 3 4 5 6 1 NA DEF
data
It is helpful and easier to help when you share data in a reproducible format which can be copied directly. I have used the below data for the answer.
df <- structure(list(Person = c("A", "A", "A", "B", "B", "C"), Rate = c(2L,
2L, 3L, 2L, 2L, 1L), Street = c("XYZ", "XYZ", "XYZ", "DEF", "DEF",
"DEF"), a = c(1L, NA, NA, NA, NA, 1L), b = c(NA, 2L, NA, NA,
2L, 2L), c = c(3L, NA, NA, NA, 3L, 3L), d = c(4L, NA, NA, NA,
NA, 4L), e = c(5L, NA, NA, 5L, NA, 5L), f = c(NA, NA, 6L, NA,
6L, 6L)), row.names = c(NA, -6L), class = "data.frame")

Using which function to transpose parts of columns under condition

Suppose we have the following data:
X Y
6
1
2
2
1 1
8
3
4
1
1 2
I want to convert it to:
X Y Y-1 Y-2 Y-3
6
1
2
2
1 1 2 2 1
8
3
4
1
1 2 1 4 3
That is: for rows with X=1 - take 3 previous Y values and append them to this row.
I "brute-forced" it with a loop:
namevector <- c("Y-1", "Y-2", "Y-3")
mydata[ , namevector] <- ""
for(i in 1:nrow(mydata)){
if(mydata$X[i] != ""){mydata[i,3:5] <- mydata$Y[(i-1):(i-3)]}
}
But it was too slow for my dataset of ~300k points - about 10 minutes.
Then I found a post with a similar question, and they proposed which function, which reduced the time to tolerable 1-2 minutes:
namevector <- c("Y-1", "Y-2", "Y-3")
mydata[ , namevector] <- ""
trials_rows <- which(mydata$X != "")
for (i in trials_rows) {mydata[i,3:5] <- mydata$Y[(i-1):(i-3)]}
But considering that which takes less than a second - I believe I can somehow combine which with some kind of transpose function, but I can't get my mind around it.
I have a big data frame (~300k rows), and ~6k rows have this "X" value.
Is there a fast and simple way to do it fast, instead of iterating through the results of which function?
You can do this with a single assignment using some vectorised trickery:
mydata[trials_rows, namevector] <- mydata$Y[trials_rows - rep(1:3,each=length(trials_rows))]
mydata
# X Y Y-1 Y-2 Y-3
#1 NA 6
#2 NA 1
#3 NA 2
#4 NA 2
#5 1 1 2 2 1
#6 NA 8
#7 NA 3
#8 NA 4
#9 NA 1
#10 1 2 1 4 3
Basically, take each row in trials_rows, look backwards three rows using a vectorised subtraction, and then overwrite the combination of trials_rows in rows and namevector in columns.
Reproducible example used here:
mydata <- structure(list(X = c(NA, NA, NA, NA, 1L, NA, NA, NA, NA, 1L),
Y = c(6L, 1L, 2L, 2L, 1L, 8L, 3L, 4L, 1L, 2L)), class = "data.frame", row.names = c(NA,
-10L))

Rearrange data by matching columns

I am having issue with rearranging some data.
The original data is:
structure(list(id = 1:3, artery.1 = structure(c(1L, 1L, 2L), .Label = c("a",
"b"), class = "factor"), artery.2 = structure(c(1L, NA, 2L), .Label = c("b",
"c"), class = "factor"), artery.3 = structure(c(1L, NA, 2L), .Label = c("c",
"d"), class = "factor"), artery.4 = structure(c(NA, NA, 1L), .Label = "e", class = "factor"), artery.5 = structure(c(NA, NA, 1L), .Label = "f", class = "factor"),
diameter.1 = c(3L, 2L, 1L), diameter.2 = c(2L, NA, 2L), diameter.3 = c(3L,
NA, 3L), diameter.4 = c(NA, NA, 4L), diameter.5 = c(NA, NA,
5L)), .Names = c("id", "artery.1", "artery.2", "artery.3",
"artery.4", "artery.5", "diameter.1", "diameter.2", "diameter.3",
"diameter.4", "diameter.5"), class = "data.frame", row.names = c(NA,
-3L))
# id artery.1 artery.2 artery.3 artery.4 artery.5 diameter.1 diameter.2 diameter.3 diameter.4 diameter.5
# 1 1 a b c <NA> <NA> 3 2 3 NA NA
# 2 2 a <NA> <NA> <NA> <NA> 2 NA NA NA NA
# 3 3 b c d e f 1 2 3 4 5
I would like to get to this:
structure(list(id = 1:3, a = c(3L, 2L, NA), b = c(2L, NA, 1L),
c = c(3L, NA, 2L), d = c(NA, NA, 3L), e = c(NA, NA, 4L),
f = c(NA, NA, 5L)), .Names = c("id", "a", "b", "c", "d",
"e", "f"), class = "data.frame", row.names = c(NA, -3L))
# id a b c d e f
# 1 1 3 2 3 NA NA NA
# 2 2 2 NA NA NA NA NA
# 3 3 NA 1 2 3 4 5
Basically, a to f represents arteries and the numerical values represent the corresponding diameter. Each row represents a patient.
Is there a neat way to sort this dataframe out?
Modern tidyr makes the solution even more succinct via the pivot_ functions:
library(dplyr)
library(tidyr)
df %>%
pivot_longer(-id, names_pattern = '(artery|diameter)\\.(\\d+)', names_to = c('.value', NA)) %>%
filter(!is.na(artery)) %>%
pivot_wider(names_from = artery, values_from = diameter)
id a b c d e f
<int> <int> <int> <int> <int> <int> <int>
1 1 3 2 3 NA NA NA
2 2 2 NA NA NA NA NA
3 3 NA 1 2 3 4 5
Here is the older solution, which uses the deprecated gather and spread functions:
library(dplyr)
library(tidyr)
new.df <- gather(df, variable, value, artery.1:diameter.5) %>%
separate(variable, c('variable', 'num')) %>%
spread(variable, value) %>%
subset(!is.na(artery)) %>%
mutate(diameter = as.numeric(diameter)) %>%
select(-num) %>%
spread(artery, diameter)
Output:
id a b c d e f
1 1 3 2 3 NA NA NA
2 2 2 NA NA NA NA NA
3 3 NA 1 2 3 4 5
Or using melt/dcast combination with data.table while selecting variables using regex in the patterns function
library(data.table) #v>=1.9.6
dcast(melt(setDT(df),
id = "id",
measure = patterns("artery", "diameter")),
id ~ value1,
sum,
value.var = "value2",
subset = .(!is.na(value2)),
fill = NA)
# id a b c d e f
# 1: 1 3 2 3 NA NA NA
# 2: 2 2 NA NA NA NA NA
# 3: 3 NA 1 2 3 4 5
As you can see, both melt and dcast are very flexible and you can use regex, specify a subset, pass multiple functions and specify how you want to fill missing values.
You can use xtabs with reshape from base R. Use the latter to transform data to long format and use the former to get the count table:
xtabs(diameter ~ id + artery, reshape(df, varying = 2:11, sep = '.', dir = "long"))
# artery
#id a b c d e f
# 1 3 2 3 0 0 0
# 2 2 0 0 0 0 0
# 3 0 1 2 3 4 5
This can be done with two reshape() calls. First, we can longify both artery and diameter on id, then widen with artery as the time variable. To prevent a column of NAs, we also must subset out rows with NA values for artery in the intermediate frame.
reshape(subset(reshape(df,dir='l',varying=setdiff(names(df),'id'),timevar=NULL),!is.na(artery)),dir='w',timevar='artery');
## id diameter.a diameter.b diameter.c diameter.d diameter.e diameter.f
## 1.1 1 3 2 3 NA NA NA
## 2.1 2 2 NA NA NA NA NA
## 3.1 3 NA 1 2 3 4 5
The diameter. prefixes can be removed afterward, if desired. However, an advantage of this solution is that it would be capable of preserving multiple column sets, whereas the xtabs() solution cannot. The prefixes would be essential to distinguish the column sets in that case.

Resources