How to avoid having duplicate binary values in R - r

Question

I am currently working on building a simulation that simulates user interactions with fake/authentic FB news posts. As I built simulation using for loop, I've ran into the following problem:
First, I wanted to set my loop such that if a person reacts to a FB post (i.e leave a like, love, wow, haha, sad, angry, or care) he/she would leave only one reaction. For instance, if someone leaves a like, he/she shouldn't be able to leave other reactions like love, wow, etc.
This is the code I used for generating simulation data
#Creating empty dataframe
fake_id<-1:1000
like<-rep(NA,max(fake_id))
love<-rep(NA,max(fake_id))
wow<-rep(NA,max(fake_id))
haha<-rep(NA,max(fake_id))
sad<-rep(NA,max(fake_id))
angry<-rep(NA,max(fake_id))
care<-rep(NA,max(fake_id))
comment<-rep(NA,max(fake_id))
shares<-rep(NA,max(fake_id))
fake<-data.frame(fake_id,like,love,wow,haha,sad,angry,care,comment,shares)
#Probability distribution for user interaction with a given FB post
misinformation_prob<-c(0.090637966,0.015194195,0.023018674,0.013500845,0.001573673,0.017003550,0.002058321,0.003093388,0.001312486)
authentic_prob<-c(0.0275070460,0.0103958123,0.0060707537,0.0034785282,0.0007527044,0.0088240139,0.0020064930,0.0019195168,0.0006860144)
prob.dist<-data.frame(misinformation_prob,authentic_prob)
colnames(prob.dist)<-c("Misinformation","Authentic")
rownames(prob.dist)<-c("Likes","Comments","Shares","Loves","Wows","Hahas","Sads","Angrys","Cares")
prob.dist
#For loop used to create a simulated data
for(i in fake_id){
fake$like[i]<-sample(x=c(0,1), size=1,prob=c(1-prob.dist[1,'Misinformation'],prob.dist[1,'Misinformation']))
fake$comment[i]<-sample(x=c(0,1), size=1,prob=c(1-prob.dist[2,'Misinformation'],prob.dist[2,'Misinformation']))
fake$shares[i]<-sample(x=c(0,1), size=1,prob=c(1-prob.dist[3,'Misinformation'],prob.dist[3,'Misinformation']))
if(fake$like[i]==1){
fake[i,3:8]=0
}else for(j in 3:8){
if(is.na(fake[i,j])==TRUE){
fake[i,j]<-sample(x=c(0,1),size=1,prob=c(1-prob.dist[j+1,'Misinformation'],prob.dist[j+1,'Misinformation']))
}
if(fake[i,j]==1){
fake[i,-j]==0
}
}
}
I hoped that by writing
if(fake[i,j]==1){
fake[i,-j]==0
}
I'd be able to avoid having duplicate reactions like certain user liking and loving the post simultaneously. Yet, once I run the simulation, I'd occasionally run into this problem that I wanted to avoid. Any input regarding this problem would be greatly appreciated. Thank you community!

Answer 1

To elaborate a little on my comment, you have structured the data pretty nicely so once we clean the row names all of this can be vectorised easily:
rownames(prob.dist) <- c("like", "comment", "shares", "love", "wow", "haha", "sad", "angry", "care")
We can then create a function to look up the probabilities for each column in your table:
get_prob <- function(col, dat = prob.dist) {
prob <- c(
1 - dat[col, "Misinformation"],
dat[col, "Misinformation"]
)
return(prob)
}
Then it's a simple matter of running the simulation for each column. First the three columns can be sampled from the distribution randomly based on the probabilities but not depending on likes:
set.seed(100) # for reproducibility
n <- length(fake_id)
independent_cols <- c("like", "comment", "shares")
cols_depend_on_like <- c("love", "wow", "haha", "sad", "angry", "care")
fake[independent_cols] <- lapply(independent_cols, \(col) {
sample(x = c(0, 1), size = n, prob = get_prob(col), replace = TRUE)
})
Note that we are sampling with replacement - which is essentially what you were doing when you did a rowwise sampling without replacement. Then we can add the columns which depend on likes:
zeroes <- fake$like == 1
fake[cols_depend_on_like] <- lapply(cols_depend_on_like, \(col) {
values <- sample(0:1, size = n, prob = get_prob(col), replace = TRUE)
values[zeroes] <- 0
values
})
The output is probabilities in the same range as your original code but much quicker:
sapply(fake, sum)
# fake_id like love wow haha sad angry care comment shares
# 500500 100 21 2 19 2 4 1 19 20
# Check that all the columns are zeroes that are supposed to be when like==1
sapply(fake[fake$like == 1, ], sum)
# fake_id like love wow haha sad angry care comment shares
# 51347 100 0 0 0 0 0 0 6 2
Benchmarking
I wanted to compare the performance for fun but also it will hopefully give you a sense of why it is worth doing this in R. This is the benchmarking code:
num_rows <- c(10, 1e2, 1e3, 1e4)
results <- bench::press(
rows = num_rows,
{
# Creating dataframe
fake_id <- 1:rows
like <- rep(NA, max(fake_id))
love <- rep(NA, max(fake_id))
wow <- rep(NA, max(fake_id))
haha <- rep(NA, max(fake_id))
sad <- rep(NA, max(fake_id))
angry <- rep(NA, max(fake_id))
care <- rep(NA, max(fake_id))
comment <- rep(NA, max(fake_id))
shares <- rep(NA, max(fake_id))
fake <- data.frame(fake_id, like, love, wow, haha, sad, angry, care, comment, shares)
# Probability distribution for user interaction with a given FB post
misinformation_prob <- c(0.090637966, 0.015194195, 0.023018674, 0.013500845, 0.001573673, 0.017003550, 0.002058321, 0.003093388, 0.001312486)
authentic_prob <- c(0.0275070460, 0.0103958123, 0.0060707537, 0.0034785282, 0.0007527044, 0.0088240139, 0.0020064930, 0.0019195168, 0.0006860144)
prob.dist <- data.frame(misinformation_prob, authentic_prob)
colnames(prob.dist) <- c("Misinformation", "Authentic")
rownames(prob.dist) <- c("like", "comment", "shares", "love", "wow", "haha", "sad", "angry", "care")
bench::mark(
min_iterations = 10,
check = FALSE,
rowwise = {
set.seed(100) # for reproducibility
for (i in fake_id) {
fake$like[i] <- sample(x = c(0, 1), size = 1, prob = c(1 - prob.dist[1, "Misinformation"], prob.dist[1, "Misinformation"]))
fake$comment[i] <- sample(x = c(0, 1), size = 1, prob = c(1 - prob.dist[2, "Misinformation"], prob.dist[2, "Misinformation"]))
fake$shares[i] <- sample(x = c(0, 1), size = 1, prob = c(1 - prob.dist[3, "Misinformation"], prob.dist[3, "Misinformation"]))
if (fake$like[i] == 1) {
fake[i, 3:8] <- 0
} else {
for (j in 3:8) {
if (is.na(fake[i, j]) == TRUE) {
fake[i, j] <- sample(x = c(0, 1), size = 1, prob = c(1 - prob.dist[j + 1, "Misinformation"], prob.dist[j + 1, "Misinformation"]))
}
if (fake[i, j] == 1) {
fake[i, -j] <- 0
}
}
}
}
},
vectorised = {
set.seed(100) # for reproducibility
n <- length(fake_id)
independent_cols <- names(fake)[c(2, 9, 10)]
cols_depend_on_like <- names(fake)[3:8]
fake[independent_cols] <- lapply(independent_cols, \(col) {
sample(x = c(0, 1), size = n, prob = get_prob(col), replace = TRUE)
})
fake[cols_depend_on_like] <- lapply(cols_depend_on_like, \(col) {
values <- fake[[col]]
zeroes <- fake$like == 1
n <- sum(!zeroes)
values[zeroes] <- 0
values[!zeroes] <- sample(0:1, size = n, prob = get_prob(col), replace = TRUE)
values
})
}
)
}
)