New column of factors based on shared group values [R] - r

Suppose I have the following data. I'm interested in making a new column of factors that captures whether Item_i, Item_j, and/or Item_k are coded "1" for each category A,B,C,D,etc.
dat <- data.frame(c("A","A","B","B","C","C","D","D"), c("x","y","y","z","x","z","y","z"), c(1,0,0,1,1,0,0,0), c(0,1,1,0,0,0,1,0), c(0,0,0,1,0,1,0,1))
names(dat) <- c("Categories","Aspects","Item_i", "Item_j", "Item_k")
If I didn't care about the categories and wanted to do this row-by-row, it would be simple enough to do using an ifelse() statement:
dat$FactorCol <- ifelse(dat$Item_i==1 & dat$Item_j==0 & dat$Item_k==0, "i", NA)
dat$FactorCol <- ifelse(dat$Item_i==0 & dat$Item_j==1 & dat$Item_k==0, "j", dat$FactorCol)
dat$FactorCol <- ifelse(dat$Item_i==0 & dat$Item_j==0 & dat$Item_k==1, "k", dat$FactorCol)
dat$FactorCol <- ifelse(dat$Item_i==1 & dat$Item_j==0 & dat$Item_k==1, "i and k", dat$FactorCol)
But what I actually want is for dat$FactorCol to reflect whether i, j, k, or some combination appears anywhere within each Category, and then to return a new column (with the same number of rows).
Output would be something like:
Categories Aspects Item_i Item_j Item_k FactorCol
1 A x 1 0 0 i and j
2 A y 0 1 0 i and j
3 B y 0 1 0 i and j and k
4 B z 1 0 1 i and j and k
5 C x 1 0 0 i and k
6 C z 0 0 1 i and k
7 D y 0 1 0 j and k
8 D z 0 0 1 j and k
It's also not the case in my data that categories restart neatly every two rows. I'm guessing dplyr() can handle this easily, but I wasn't able to do it on my own. Appreciate any tips.

For each Categories, we can get max value for 'Item_' columns, for columns which are 1 we assign i,j or k value in each row. To get same number of rows back we left_join with dat
library(dplyr)
cols <- c('i', 'j', 'k')
dat %>%
group_by(Categories) %>%
summarise(across(starts_with('Item_'), max)) %>%
#In old dplyr
#summarise_at(vars(starts_with('Item_')), max)
mutate(FactorCol = purrr::pmap_chr(select(., starts_with('Item_')),
~toString(cols[c(...) == 1]))) %>%
select(Categories, FactorCol) %>%
left_join(dat, by = 'Categories')
# Categories FactorCol Items Item_i Item_j Item_k
# <chr> <chr> <chr> <dbl> <dbl> <dbl>
#1 A i, j x 1 0 0
#2 A i, j y 0 1 0
#3 B i, j, k y 0 1 0
#4 B i, j, k z 1 0 1
#5 C i, k x 1 0 0
#6 C i, k z 0 0 1
#7 D j, k y 0 1 0
#8 D j, k z 0 0 1

Related

Creating new columns with combinations of string patterns in R

I have a data frame - in which I have a column with a lengthy string separated by _. Now I am interested in counting the patterns and several possible combinations from the long string. In the use case I provided below, you can find that I would like to count the occurrence of events A and B but not anything else.
If A and B repeat like A_B or B_A alone or if they repeats itself n number of times, I want to count them and also if there are several occurrences of those combinations.
Example data frame:
participant <- c("A", "B", "C")
trial <- c(1,1,2)
string_pattern <- c("A_B_A_C_A_B", "B_A_B_A_C_D_A_B", "A_B_C_A_B")
df <- data.frame(participant, trial, string_pattern)
Expected output:
participant trial string_pattern A_B B_A A_B_A B_A_B B_A_B_A
1. A 1 A_B_A_C_A_B 2 1 1 0 0
2. B 1 B_A_B_A_C_D_A_B 2 2 1 1 1
3. C 2 A_B_C_A_B 2 0 0 0 0
My code:
revised_df <- df%>%
dplyr::mutate(A_B = stringr::str_count(string_pattern, "A_B"),
B_A = stringr::str_count(string_pattern, "B_A"),
B_A_B = string::str_count(string_pattern, "B_A_B"))
My approach gets complicated as the number of combinations increases. Hence, looking for a better solution.
You could write a function to solve this:
m <- function(s){
a <- seq(nchar(s)-1)
start <- rep(a, rev(a))
stop <- ave(start, start, FUN = \(x)seq_along(x)+x)
b <- substring(s, start, stop)
gsub('(?<=\\B)|(?=\\B)', '_', b, perl = TRUE)
}
n <- function(x){
names(x) <- x
a <- strsplit(gsub("_", '', gsub("_[^AB]+_", ':', x)), ':')
b <- t(table(stack(lapply(a, \(y)unlist(sapply(y, m))))))
data.frame(pattern=x, as.data.frame.matrix(b), row.names = NULL)
}
n(string_pattern)
pattern A_B A_B_A B_A B_A_B B_A_B_A
1 A_B_A_C_A_B 2 1 1 0 0
2 B_A_B_A_C_D_A_B 2 1 2 1 1
3 A_B_C_A_B 2 0 0 0 0
Try: This checks each string row for current column name
library(dplyr)
df |>
mutate(A_B = 0, B_A = 0, A_B_A = 0, B_A_B = 0, B_A_B_A = 0) |>
mutate(across(A_B:B_A_B_A, ~ str_count(string_pattern, cur_column())))
participant trial string_pattern A_B B_A A_B_A B_A_B B_A_B_A
1 A 1 A_B_A_C_A_B 2 1 1 0 0
2 B 1 B_A_B_A_C_D_A_B 2 2 1 1 1
3 C 2 A_B_C_A_B 2 0 0 0 0

How to assign 1s and 0s to columns if variable in row matches or not match in R

I'm an absolute beginner in coding and R and this is my third week doing it for a project. (for biologists, I'm trying to find the sum of risk alleles for PRS) but I need help with this part
df
x y z
1 t c a
2 a t a
3 g g t
so when code applied:
x y z
1 t 0 0
2 a 0 1
3 g 1 0
```
I'm trying to make it that if the rows in y or z match x the value changes to 1 and if not, zero
I started with:
```
for(i in 1:ncol(df)){
df[, i]<-df[df$x == df[,i], df[ ,i]<- 1]
}
```
But got all NA values
In reality, I have 100 columns I have to compare with x in the data frame. Any help is appreciated
An alternative way to do this is by using ifelse() in base R.
df$y <- ifelse(df$y == df$x, 1, 0)
df$z <- ifelse(df$z == df$x, 1, 0)
df
# x y z
#1 t 0 0
#2 a 0 1
#3 g 1 0
Edit to extend this step to all columns efficiently
For example:
df1
# x y z w
#1 t c a t
#2 a t a a
#3 g g t m
To apply column editing efficiently, a better approach is to use a function applied to all targeted columns in the data frame. Here is a simple function to do the work:
edit_col <- function(any_col) any_col <- ifelse(any_col == df1$x, 1, 0)
This function takes a column, and then compare the elements in the column with the elements of df1$x, and then edit the column accordingly. This function takes a single column. To apply this to all targeted columns, you can use apply(). Because in your case x is not a targeted column, you need to exclude it by indexing [,-1] because it is the first column in df.
# Here number 2 indicates columns. Use number 1 for rows.
df1[, -1] <- apply(df1[,-1], 2, edit_col)
df1
# x y z w
#1 t 0 0 1
#2 a 0 1 1
#3 g 1 0 0
Of course you can also define a function that edit the data frame so you don't need to do apply() manually.
Here is an example of such function
edit_df <- function(any_df){
edit_col <- function(any_col) any_col <- ifelse(any_col == any_df$x, 1, 0)
# Create a vector containing all names of the targeted columns.
target_col_names <- setdiff(colnames(any_df), "x")
any_df[,target_col_names] <-apply( any_df[,target_col_names], 2, edit_col)
return(any_df)
}
Then use the function:
edit_df(df1)
# x y z w
#1 t 0 0 1
#2 a 0 1 1
#3 g 1 0 0
A tidyverse approach
library(dplyr)
df <-
tibble(
x = c("t","a","g"),
y = c("c","t","g"),
z = c("a","a","t")
)
df %>%
mutate(
across(
.cols = c(y,z),
.fns = ~if_else(. == x,1,0)
)
)
# A tibble: 3 x 3
x y z
<chr> <dbl> <dbl>
1 t 0 0
2 a 0 1
3 g 1 0

Loop within a loop with column names in R

I have the following data:
id A B C
1 1 1 0
2 1 1 1
3 0 1 1
I will like to create a function that computes the following three information between columns:
the number of individuals i) with A and B, ii) with A but not B, iii) B but not A. Similarly, I will like a recursive loop that computes these three numbers for A and C, and B and C. Is there a smart way to do so? a loop within a loop? So far, I have tried the following:
for(ii in colnames(df)){
for(jj in (ii+1):df){
print(ii,jj)
}}
Perhaps something like this:
# function to return your metrics
foo = function(x, y) {
c(
"x and y" = sum(x & y),
"x not y" = sum(x & !y),
"y not x" = sum(!x & y)
)
}
# generate combinations of columns
col_combos = combn(names(df)[-1], 2)
result = apply(col_combos, 2, function(x) foo(df[[x[1]]], df[[x[2]]]))
colnames(result) = apply(col_combos, 2, toString)
result
# A, B A, C B, C
# x and y 2 1 2
# x not y 0 1 1
# y not x 1 1 0
Using this data:
df = read.table(text = 'id A B C
1 1 1 0
2 1 1 1
3 0 1 1 ', header = TRUE)

In R: Split a character vector to find specific characters and return a data frame

I want to be able to extract specific characters from a character vector in a data frame and return a new data frame. The information I want to extract is auditors remark on a specific company's income and balance sheet. My problem is that the auditors remarks are stored in vectors containing the different remarks. For instance:
vec = c("A C G H D E"). Since "A" %in% vec won't return TRUE, I have to use strsplit to break up each character vector in the data frame, hence "A" %in% unlist(strsplit(dat[i, 2], " "). This returns TRUE.
Here is a MWE:
dat <- data.frame(orgnr = c(1, 2, 3, 4), rat = as.character(c("A B C")))
dat$rat <- as.character(dat$rat)
dat[2, 2] <- as.character(c("A F H L H"))
dat[3, 2] <- as.character(c("H X L O"))
dat[4, 2] <- as.character(c("X Y Z A B C"))
Now, to extract information about every single letter in the rat coloumn, I've tried several approaches, following similar problems such as Roland's answer to a similar question (How to split a character vector into data frame?)
DF <- data.frame(do.call(rbind, strsplit(dat$rat, " ", fixed = TRUE)))
DF
X1 X2 X3 X4 X5 X6
1 A B C A B C
2 A F H L H A
3 H X L O H X
4 X Y Z A B C
This returnsthe following error message: Warning message:
In (function (..., deparse.level = 1) :
number of columns of result is not a multiple of vector length (arg 2)
It would be a desirable approach since it's fast, but I can't use DF since it recycles.
Is there a way to insert NA instead of the recycling because of the different length of the vectors?
So far I've found a solution to the problem by using for-loops in combination with ifelse-statements. However, with 3 mill obs. this approach takes years!
dat$A <- 0
for(i in seq(1, nrow(dat), 1)) {
print(i)
dat[i, 3] <- ifelse("A" %in% unlist(strsplit(dat[i, 2], " ")), 1, 0)
}
dat$B <- 0
for(i in seq(1, nrow(dat), 1)) {
print(i)
dat[i, 4] <- ifelse("B" %in% unlist(strsplit(dat[i, 2], " ")), 1, 0)
}
This gives the results I want:
dat
orgnr rat A B
1 1 A B C 1 1
2 2 A F H L H 1 0
3 3 H X L O 0 0
4 4 X Y Z A B C 1 1
I've searched through most of the relevant questions I could find here on StackOverflow. This one is really close to my problem: How to convert a list consisting of vector of different lengths to a usable data frame in R?, but I don't know how to implement strsplit with that approach.
We can use for-loop with grepl to achieve this task. + 0 is to convert the column form TRUE or FALSE to 1 or 0
for (col in c("A", "B")){
dat[[col]] <- grepl(col, dat$rat) + 0
}
dat
# orgnr rat A B
# 1 1 A B C 1 1
# 2 2 A F H L H 1 0
# 3 3 H X L O 0 0
# 4 4 X Y Z A B C 1 1
If performance is an issue, try this data.table approach.
library(data.table)
# Convert to data.table
setDT(dat)
# Create a helper function
dummy_fun <- function(col, vec){
grepl(col, vec) + 0
}
# Apply the function to A and B
dat[, c("A", "B") := lapply(c("A", "B"), dummy_fun, vec = rat)]
dat
# orgnr rat A B
# 1: 1 A B C 1 1
# 2: 2 A F H L H 1 0
# 3: 3 H X L O 0 0
# 4: 4 X Y Z A B C 1 1
using Base R:
a=strsplit(dat$rat," ")
b=data.frame(x=rep(dat$orgnr,lengths(a)),y=unlist(a),z=1)
cbind(dat,as.data.frame.matrix(xtabs(z~x+y,b)))
orgnr rat A B C F H L O X Y Z
1 1 A B C 1 1 1 0 0 0 0 0 0 0
2 2 A F H L H 1 0 0 1 2 1 0 0 0 0
3 3 H X L O 0 0 0 0 1 1 1 1 0 0
4 4 X Y Z A B C 1 1 1 0 0 0 0 1 1 1
From here you can Just call those columns that you want:
d=as.data.frame.matrix(xtabs(z~x+y,b))
cbind(dat,d[c("A","B")])
orgnr rat A B
1 1 A B C 1 1
2 2 A F H L H 1 0
3 3 H X L O 0 0
4 4 X Y Z A B C 1 1

Efficient way to replace value in binary column with 1 in R

I have a below data frame and I want to check binary columns and change non-empty value to 1.
a <- c("","a","a","","a")
b <- c("","b","b","b","b")
c <- c("c","","","","c")
d <- c("b","a","","c","d")
dt <- data.frame(a,b,c,d)
I am able to get the solution by looping and traversing through each column. But, I want some efficient solution because my data frame is really really large and the below solution is way much slower.
My Solution-
for(i in 1:length(colnames(dt)))
{
if(length(table(dt[,i]))==2){
dt[which(dt[,i]!=""),i] <- 1
}
}
Expected Output:
a b c d
1 b
1 1 a
1 1
1 c
1 1 1 d
Is there a way to make it more efficient.
Since your concerns seems to be efficiency you may want to look at packages like dplyr or data.table
library(dplyr)
mutate_all(dt, .funs = quo(if_else(n_distinct(.) <= 2L & . != "", "1", .)))
library(data.table)
setDT(dt)
dt[ , lapply(.SD, function(x) ifelse(uniqueN(x) <= 2L & x != "", 1, x))]
inds = lengths(lapply(dt, unique)) == 2
dt[inds] = lapply(dt[inds], function(x) as.numeric(as.character(x) != ""))
dt
# a b c d
#1 0 0 1 b
#2 1 1 0 a
#3 1 1 0
#4 0 1 0 c
#5 1 1 1 d
If you want "" instead of 0
dt[inds] = lapply(dt[inds], function(x) c("", 1)[(as.character(x) != "") + 1])
dt
# a b c d
#1 1 b
#2 1 1 a
#3 1 1
#4 1 c
#5 1 1 1 d

Resources