Selecting Rows in a Column Contingent on Two Variables in R - r

I am working with a data set that contains multiple observations for each prescription a patient is taking, with many different patients. Patients typically take one of several drugs, which are indicated as their own binary variables, Drug1, Drug2 and so on.
I am attempting to pull out only the individuals that have switched from one drug to the other, i.e, have a 1 in Drug1 column and Drug2, but these occur in different rows.
I have attempted to use newdata <- mydata[which(Drug1 == 1 & Drug2 == 1),] however, this assumes that the 1's are in the same row, which they are not.
Is there a way to select the patients that have received both drugs, but the indicator variables are in different rows?
Thank you

I believe this is a solution to what you are asking using dplyr.
data <- data.frame(id = rep(c(1, 2, 3, 4), each = 2),
drug1 = c(1, 0, 0, 0, 0, 1, 1, 1),
drug2 = c(0, 1, 1, 1, 1, 0, 0, 0)
)
library(dplyr)
data %>%
group_by(id) %>%
mutate(both_drugs = ifelse(any(drug1 == 1) & any(drug2 == 1), 1, 0)) %>%
filter(both_drugs == 1)

Try creating a variable for each drug that indicates whether or not it was the only drug taken at that time by that individual.
data <- data.frame(id = rep(c(1, 2, 3, 4), each = 3),
drug1 = c(1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0),
drug2 = c(0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0))
library(dplyr)
data %>%
group_by(id) %>%
mutate(drug1only = ifelse(drug1==1 & drug2==0, 1, 0),
drug2only = ifelse(drug2==1 & drug1==0, 1, 0)) %>%
summarise(
drug_switch = ifelse(max(drug1only)+max(drug2only)==2,1,0))

Related

R - How to run a GWAS analysis with no position data?

everyone!
I am trying to run a GWAS analysis in R on some very simple genetic data. It only contains the SNPs and one outcome variable (as well as an ID variable for each observation).
Everything I have found online includes chromosome and position data. I have that for the SNPs, but in a separate file. (My plan is to map the SNPs after the relevant ones have been selected).
How can I go about running a GWAS analysis on this data? Would I need to, or could I use another method to filter to only the most significant SNPs?
I tried this, but it didn't work, because my data is not a gData object.
# SNPs are in A/B notation, with 0 = AA, 1 = AB, and 2 = BB
library(statgenGWAS)
id <- c("person1", "person2", "person3", "person4", "person5", "person6", "person7", "person8", "person9", "person10")
snp1 <- c(0, 1, 2, 2, 1, 0, 0, 0, 1, 1)
snp2 <- c(2, 2, 2, 1, 1, 1, 0, 0, 0, 1)
snp3 <- c(0, 0, 2, 2, 0, 2, 1, 0, 2, 2)
diagnosis <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1)
data <- as.data.frame(cbind(id, snp1, snp2, snp3, diagnosis))
gwas1a <- runSingleTraitGwas(gData = data,
traits = "diagnosis")
Any help here is appreciated.
Thank you!

Replicating dplyr pipe structure with apply family or loop

I have a data frame df in which for each column I want to calculate what share of occurrences also occur in another column. Each row of occurrences has a weight so ideally I would like to get a weighted share.
A <- c(0, 1, 0, 0, 1, 0, 1, 1, 1, 0)
B <- c(0, 1, 0, 1, 1, 0, 0, 0, 0, 0)
C <- c(0, 0, 0, 1, 1, 0, 0, 0, 0, 1)
D <- c(1, 0, 0, 1, 1, 0, 0, 0, 0, 0)
weight <- c(0.5, 1, 0.2, 0.3, 1.4, 1.5, 0.8, 1.2, 1, 0.9)
df <- data.frame(A, B, C, D, weight)
I was trying to calculate it for each column pair this way:
#total weight of occurences in A
wgt_A <- df%>%
filter(A == 1)%>%
summarise(weight_A = sum(weight))%>%
select(weight_A)
#weighted share of occurrences in A that also occur in B
wgt_A_B <- df%>%
filter(A == 1, B == 1)%>%
summarise(weight_A_B = sum(weight))%>%
select(weight_A_B)
Result_1 <- wgt_A_B / wgt_A
I would want to end up with six results in total for all combinations of the 4 columns. However, for this I would need to replicate this dplyr pipe a lot of times and my actual dataset has 20+ columns like this. Is there a more efficient/quicker way to do this with apply/sapply or some kind of loop where I can also select for which columns I want to perform this?
I'm new to R and stackoverflow so please let me know (and excuse me) if I'm doing/saying anything stupid
We may use combn to do the combinations in base R
out <- combn(df[1:4], 2, FUN = function(x)
sum(df$weight[x[[1]] & x[[2]]])/ sum(df$weight[as.logical(x[[1]])]) )
names(out) <- combn(names(df)[1:4], 2, FUN = paste, collapse = "_")
-output
> out
A_B A_C A_D B_C B_D C_D
0.4444444 0.2592593 0.2592593 0.6296296 0.6296296 0.6538462

Boxplots for overlapping data subsets w/dummy variables in R

I want to visualize mean comparison with a boxplot in ggplot2, but instead of having a vector of categorical variables, I have a couple of vectors with 1 or 0 to indicate whether they belong in that category. There's some overlap - i.e., some data points will belong to multiple groups simultaneously.
I'm able to get a boxplot of values for all the values in one group, but not able to add another group's values to the same plot. With as.factor() applied to a dummy variable I'm able to get a boxplot of the means of scores for those in that group vs. not in that group. I've seen posts about faceting that seem like that might be helpful, but none of the examples I've found (Multiple boxplots placed side by side for different column values in ggplot, How do I make a boxplot with two categorical variables in R?) are quite like what I'm trying to do.
score <- c(1, 8, 3, 5, 10, 7, 4, 3, 8, 1)
group1 <- c(0, 0, 1, 0, 1, 1, 0, 1, 0, 1)
group2 <- c(1, 1, 0, 1, 0, 1, 1, 1, 0, 0)
group3 <- c(0, 1, 0, 0, 0, 0, 0, 0, 1, 1)
df <- data.frame(score, group1, group2, group3)
library(ggplot2)
ggplot(aes(y=score, x=as.factor(group1), fill=group1), data=df) +
geom_boxplot() #mean for both values inside and outside group plotted
ggplot(aes(y=score, x=as.numeric(group1), fill=group1), data=df) +
geom_boxplot() #mean for just those values where group1 == 1
I want to end up with either a) multiple plots like what I get from that first line of code, OR b) multiple plots like what I get from the second. The former includes a boxplot for all those values outside the group, the latter does not. Would also be cool to have a boxplot for the overall mean but I really am not sure what's feasible.
I'm not quite sure if you just want box plots for those with dummy = 1. Anyway, data.table::melt can be useful to you, which gives you an easy plottable long format.
library(data.table)
dat.m <- melt(dat, measure.vars=2:4)
boxplot(score ~ value + variable, dat.m[dat.m$value == 1, ])
Yields
Data
dat <- structure(list(score = c(1, 8, 3, 5, 10, 7, 4, 3, 8, 1), group1 = c(0,
0, 1, 0, 1, 1, 0, 1, 0, 1), group2 = c(1, 1, 0, 1, 0, 1, 1, 1,
0, 0), group3 = c(0, 1, 0, 0, 0, 0, 0, 0, 1, 1)), class = "data.frame", row.names = c(NA,
-10L))

Pair wise binary comparison - optimizing code in R

I have a file that represents the gene structure of bacteria models. Each row represents a model. A row is a fixed length binary string of which genes are present (1 for present and 0 for absent). My task is to compare the gene sequence for each pair of models and get a score of how similar they are and computer a dissimilarity matrix.
In total there are 450 models (rows) in one file and there are 250 files. I have a working code however it takes roughly 1.6 hours to do the whole thing for only one file.
#Sample Data
Generation: 0
[0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0]
[1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1]
[1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0]
[0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0]
[0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0]
[1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0]
What my code does:
Reads the file
Convert the binary string into a data frame Gene, Model_1, Model_2,
Model_3, … Model_450
Run a nested for loop to do the pair-wise comparison (only the top
half of the matrix) – I take the two corresponding columns and add
them, then count the positions where the sum is 2 (meaning present
in both models)
Write the data to a file
Create the matrix later
comparison code
generationFiles = list.files(pattern = "^Generation.*\\_\\d+.txt$")
start.time = Sys.time()
for(a in 1:length(generationFiles)){
fname = generationFiles[a]
geneData = read.table(generationFiles[a], sep = "\n", header = T, stringsAsFactors = F)
geneCount = str_count(geneData[1,1],"[1|0]")
geneDF <- data.frame(Gene = paste0("Gene_", c(1:geneCount)), stringsAsFactors = F)
#convert the string into a data frame
for(i in 1:nrow(geneData)){
#remove the square brackets
dataRow = substring(geneData[i,1], 2, nchar(geneData[i,1]) - 1)
#removing white spaces
dataRow = gsub(" ", "", dataRow, fixed = T)
#splitting the string
dataRow = strsplit(dataRow, ",")
#converting to numeric
dataRow = as.numeric(unlist(dataRow))
colName = paste("M_",i,sep = "")
geneDF <- cbind(geneDF, dataRow)
colnames(geneDF)[colnames(geneDF) == 'dataRow'] <- colName
dataRow <- NULL
}
summaryDF <- data.frame(Model1 = character(), Model2 = character(), Common = integer(),
Uncommon = integer(), Absent = integer(), stringsAsFactors = F)
modelNames = paste0("M_",c(1:450))
secondaryLevel = modelNames
fileName = paste0("D://BellosData//GC_3//Summary//",substr(fname, 1, nchar(fname) - 4),"_Summary.txt")
for(x in 1:449){
secondaryLevel = secondaryLevel[-1]
for(y in 1:length(secondaryLevel)){
result = geneDF[modelNames[x]] + geneDF[secondaryLevel[y]]
summaryDF <- rbind(summaryDF, data.frame(Model1 = modelNames[x],
Model2 = secondaryLevel[y],
Common = sum(result == 2),
Uncommon = sum(result == 1),
Absent = sum(result == 0)))
}
}
write.table(summaryDF, fileName, sep = ",", quote = F, row.names = F)
geneDF <- NULL
summaryDF <- NULL
geneData <-NULL
}
converting to matrix
maxNum = max(summaryDF$Common)
normalizeData = summaryDF[,c(1:3)]
normalizeData[c('Common')] <- lapply(normalizeData[c('Common')], function(x) 1 - x/maxNum)
normalizeData[1:2] <- lapply(normalizeData[1:2], factor, levels=unique(unlist(normalizeData[1:2])))
distMatrixN = xtabs(Common~Model1+Model2, data=normalizeData)
distMatrixN = distMatrixN + t(distMatrixN)
Is there a way to make the process run faster? Is there a more efficient way to do the comparison?
This code should be faster. Nested loops are nightmare slow in R. Operations like rbind-ing one row at a time is also among the worst and slowest ideas in R programming.
Generate 450 rows with 20 elements of 0, 1 on each row.
M = do.call(rbind, replicate(450, sample(0:1, 20, replace = T), simplify = F))
Generate list of combination(450, 2) numbers of row pairs
L = split(v<-t(utils::combn(450, 2)), seq(nrow(v))); rm(v)
Apply whatever comparison function you want. In this case, the number of 1's at the same position for each row combinations. If you want to calculate different metrics, just write another function(x) where M[x[1],] is the first row and M[x[2],] is the second row.
O = lapply(L, function(x) sum(M[x[1],]&M[x[2],]))
Code takes ~4 seconds a fairly slow 2.6 Ghz Sandy Bridge
Get a clean data.frame with your results, three columns : row 1, row 2, metric between the two rows
data.frame(row1 = sapply(L, `[`, 1),
row2 = sapply(L, `[`, 2),
similarity_metric = do.call(rbind, O))
To be honest, I didn't thoroughly comb through your code to replicate exactly what you were doing. If this is not what you are looking for (or can't be modified to achieve what you are looking for), leave a comment.

Add accuracy to data frame based on several predicted values and known actual values

I have a data frame
testdf <- data.frame(predicted1 = c(1, 0, 1, 3, 2, 1, 1, 0, 1, 0), predicted2 = c(1, 0, 2, 2, 2, 1, 1, 0, 0, 0), predicted3 = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1), actual = c(1, 0, 2, 3, 2, 1, 1, 1, 0, 0))
I want to add another column to this data frame which tells me the total percentage accuracy when looking at all predicted values. So for example, row 1 of this would have an accuracy of 100%, because all prediction columns predicted the correct value (1).
How can this be done?
Thanks!
We can compare with the 'actual' get the rowMeans, multiply by 100 and round if needed
round(100*rowMeans(testdf[1:3] == testdf$actual), 2)

Resources