Selecting columns where only one item is true - r

I am using the following code to determine if any of the columns in my data table have 1065. If any of the columns do have 1065, I get "TRUE" which works perfectly. Now I want to only output true if any of the columns notcancer0:notcancer33 contains 1065 AND all the rest are NA. Other columns may contain other values like 1064, 1066, etc. But I want to output "TRUE" for the rows where there is only 1065 and all the rest of the columns contain NAs for that row. What is the best way to do this?
biobank_nsaid[, ischemia1 := Reduce(`|`, lapply(.SD, `==`, "1065")), .SDcols=notcancer0:notcancer33]
Sample data:
biobank_nsaid = structure(list(aspirin = structure(c(2L, 1L, 1L, 1L), .Label =
c("FALSE", "TRUE"), class = "factor"), aspirinonly = c(TRUE, FALSE, FALSE,
FALSE), med0 = c(1140922174L, 1140871050L, 1140879616L, 1140909674L ), med1 =
c(1140868226L, 1140876592L, 1140869180L, NA), med2 = c(1140879464L, NA,
1140865016L, NA), med3 = c(1140879428L, NA, NA, NA)), row.names = c(NA, -4L),
class = c("data.table", "data.frame"))

Here are 2 options:
setDT(biobank_nsaid)[, ischemia1 :=
rowSums(is.na(.SD))==ncol(.SD)-1L & rowSums(.SD==1140909674, na.rm=TRUE)==1L,
.SDcols=med0:med3]
Or after some boolean manipulations:
biobank_nsaid[, ic2 :=
!(rowSums(is.na(.SD))!=ncol(.SD)-1L | rowSums(.SD==1140909674, na.rm=TRUE)!=1L),
.SDcols=med0:med3]

Related

Conditionally replace cells in data frame based on another data frame

In the interest of learning better coding practices, can anyone show me a more efficient way of solving my problem? Maybe one that doesn't require new columns...
Problem: I have two data frames: one is my main data table (t) and the other contains changes I need to replace in the main table (Manual_changes). Example: Sometimes the CaseID is matched with the wrong EmployeeID in the file.
I can't provide the main data table, but the Manual_changes file looks like this:
Manual_changes = structure(list(`Case ID` = c(46605, 25321, 61790, 43047, 12157,
16173, 94764, 38700, 41798, 56198, 79467, 61907, 89057, 34232,
100189), `Employee ID` = c(NA, NA, NA, NA, NA, NA, NA, NA, 906572,
164978, 145724, 874472, 654830, 846333, 256403), `Age in Days` = c(3,
3, 3, 12, 0, 0, 5, 0, NA, NA, NA, NA, NA, NA, NA)), row.names = c(NA,
-15L), class = c("tbl_df", "tbl", "data.frame"))
temp = merge(t, Manual_changes, by = "Case ID", all.x = TRUE)
temp$`Employee ID.y` = ifelse(is.na(temp$`Employee ID.y`), temp$`Employee ID.x`, temp$`Employee ID.y`)
temp$`Age in Days.y`= ifelse(is.na(temp$`Age in Days.y`), temp$`Age in Days.x`, temp$`Age in Days.y`)
temp$`Age in Days.x` = NULL
temp$`Employee ID.x` = NULL
colnames(temp) = colnames(t)
t = temp
We could use coalesce
library(dplyr)
left_join(t, Manual_changes, by = "Case ID") %>%
mutate(Employee_ID.y = coalesce(`Employee ID.x`, `Employee ID.y`),
`Age in Days.y` = coalesce(`Age in Days.x`, `Age in Days.y`))
Or with data.table
library(data.table)
setDT(t)[Manual_changes,
c('Employee ID', 'Age in Days') :=
.(fcoalesce(`Employee ID.x`, `Employee ID.y`),
fcoalesce(`Age in Days.x`, `Age in Days.y`)),
on = .(`Case ID`)]

How to return the column name that matches a certain condition in R (prefer data.table)?

I have a data set similar to the following format:
Each user has only one variable that is not NA. I want to return the column name of this NA column as follows:
Writing a loop by row may easily solve this problem, but I want to user data.table to generate this variable.
With base R, it would be more efficent
df1$NonNA_VarName <- names(df1)[-1][max.col(!is.na(df1[-1]), 'first')]
df1$NonNA_VarName
#[1] "v1" "v2" "v1" "v3" "v4" "v3"
With data.table, an option is to melt into 'long' format and then extract the 'variable
library(data.table)
melt(setDT(df1), id.var = 'user', na.rm = TRUE)[,
.(NonNA_VarName = first(variable)), user][df1, on = .(user)]
Or another option is to group by 'user' and use which.max to return the index
setDT(df1)[, NonNA_VarName := names(.SD)[which.max(unlist(.SD))], by = user]
data
df1 <- structure(list(user = 1:6, v1 = c(3, NA, 2, NA, NA, NA), v2 = c(NA,
5, NA, NA, NA, NA), v3 = c(NA, NA, NA, 5, NA, 7), v4 = c(NA,
NA, NA, NA, 4, NA)), class = "data.frame", row.names = c(NA,
-6L))

Speed up/replace the loop for millions data:judge multi date range

Good evening guys,I have 6 millions data and they have four types.
z=structure(list(date = structure(c(11866, 16190, 14729, 11718), class = "Date"),
beg1 = structure(c(12264, 12264, 13970, 12264), class = "Date"),
end1 = structure(c(17621, 14760, 14760, 13298), class = "Date"),
ID1 = c(1003587, 1000396, 1010743, 1002113), beg2 = structure(c(NA,
14790, 14790, 13299), class = "Date"), end2 = structure(c(NA,
17621, 15217, 13969), class = "Date"), ID2 = c(NA, 1024488,
1027877, 1002824), beg3 = structure(c(NA, NA, 15218, 13970
), class = "Date"), end3 = structure(c(NA, NA, 17621, 14760
), class = "Date"), ID3 = c(NA, NA, 1031361, 1002113), beg4 = structure(c(NA,
NA, NA, 14790), class = "Date"), end4 = structure(c(NA, NA,
NA, 17621), class = "Date"), ID4 = c(NA, NA, NA, 1021290),
realID = c(NA, NA, NA, NA)), row.names = c(267365L, 193587L,
5294385L, 2039421L), class = "data.frame")
and I tried to judge and assign a suitalbe ID based on their date in which date ranges(use the loop).
for(i in 1:nrow(z)){tryCatch({print(i)
if(between(z$date[i],z$beg1[i],z$end1[i])==T){z$realID[i]=z$ID1[i]}
if(between(z$date[i],z$beg2[i],z$end2[i])==T){z$realID[i]=z$ID2[i]}
if(between(z$date[i],z$beg3[i],z$end3[i])==T){z$realID[i]=z$ID3[i]}
if(between(z$date[i],z$beg4[i],z$end4[i])==T){z$realID[i]=z$ID4[i]}},error=function(e){})}
The code works.
But,now the problem is I have too many datas,the loop is inefficiency,may be it will take almost one day to loop.
Does anyone know how can I improve or replace the code?
Thanks you so much.
Since R is a vectorized language, to speed up this code it is best to operate on the entire vector as oppose to looping through each element.
As simple solution is to use a series of ifelse statements.
z$realID <- ifelse(!is.na(z$beg1) & z$date> z$beg1 & z$date< z$end1, z$ID1, z$realID)
z$realID <- ifelse(!is.na(z$beg2) & z$date> z$beg2 & z$date< z$end2, z$ID2, z$realID)
z$realID <- ifelse(!is.na(z$beg3) & z$date> z$beg3 & z$date< z$end3, z$ID3, z$realID)
z$realID <- ifelse(!is.na(z$beg4) & z$date> z$beg4 & z$date< z$end4, z$ID4, z$realID)
When the if statement evaluates TRUE, the realID will update if not it will retain its prior value.

mutate with multiple conditions using if_else or ifelse

I'm trying to create a new variable lab_conf based on meeting either condition for 2 other variables diagnosis and PC_R. This is the code I'm using:
mutate(lab_conf = ifelse( (diagnosis == "confirmed")|(PC_R == "pos"), "pos", "neg"))
The output I'm getting is showing NA where it should show "neg", so I'm only getting 2 values; "pos" or "NA". I'd like the values for this new variable to be either "pos", "neg", or NA based based on the conditions specified, where NA would be if it's NA in both conditions.
This is what I get with dput(head(x)):
structure(list(diagnosis = structure(c(16L, 16L, 16L, 3L, 16L,
3L), .Label = c("*un-confirmed", "Cloted sample", "confirmed",
"Hemolysed sampl", "inadequate sample", "rej (sample leaking)",
"rej(Hemolyzed sample)", "rej(Hemolyzed)", "rej: sample Hemolyzed",
"rej: sample leaking", "rej: sample leaking + Hemolyzed", "rej: sample leaking+not convnient tube",
"repeat sample", "tf", "TF", "un-confirmed"), class = "factor"),
PC_R = structure(c(NA_integer_, NA_integer_, NA_integer_,
NA_integer_, NA_integer_, NA_integer_), .Label = c("clotted",
"hemolyzed", "neg", "not pos", "Not REQUIred", "OTHER", "pos",
"QNS", "rej", "repeat sample", "Sample broken", "tf", "TF"
), class = "factor"), lab_conf = c(NA, NA, NA, "pos", NA,
"pos")), .Names = c("diagnosis", "PC_R", "lab_conf"), row.names = c(NA,
6L), class = "data.frame")
Use %in% instead of ==, like so:
df = df %>%
mutate(lab_conf = ifelse( (diagnosis %in% "confirmed") | (PC_R %in% "pos"), "pos", "neg"))
The problem you're experience is that the == operator returns NA if one of the operands is NA. Also, NA | FALSE returns NA. These two facts are why your OR statement are evaluating to NA, which is causing your ifelse to evaluate to NA.
The ifelse statement is set to return "pos" if the statement evaluates to TRUE and "neg" if the statement evaluates to FALSE, but the ifelse doesn't return anything if the statement evaluates to NA. That's why you're getting NAs.
Using %in% gets around this.
Usually, when you provide sample data you want to provide all the possible outcomes. The sample data you provided is all the same.
I've created some sample data for you which I think is what you're going for and then how to do it.
library(dplyr)
temp2 <- structure(list(diagnosis = c("unconfirmed", "unconfirmed", "unconfirmed", "confirmed", "confirmed", "confirmed"), PC_R = c("pos", "neg",NA, "pos", "neg", NA)), row.names = c(NA, -6L), class = "data.frame")
temp2 %>% mutate(lab_conf = ifelse(diagnosis == "confirmed" | PC_R == "pos", "pos", "neg"))
diagnosis PC_R lab_conf
1 unconfirmed pos pos
2 unconfirmed neg neg
3 unconfirmed <NA> <NA>
4 confirmed pos pos
5 confirmed neg pos
6 confirmed <NA> pos

How to create a for loop based on unique user IDs and specific event types

I have two data frames: users and events.
Both data frames contain a field that links events to users.
How can I create a for loop where every user's unique ID is matched against an event of a particular type and then stores the number of occurrences into a new column within users (users$conversation_started, users$conversation_missed, etc.)?
In short, it is a conditional for loop.
So far I have this but it is wrong:
for(i in users$id){
users$conversation_started <- nrow(event[event$type = "conversation-started"])
}
An example of how to do this would be ideal.
The idea is:
for(each user)
find the matching user ID in events
count the number of event types == "conversation-started"
assign count value to user$conversation_started
end for
Important note:
The type field can contain one of five values so I will need to be able to effectively filter on each type for each associate:
> events$type %>% table %>% as.matrix
[,1]
conversation-accepted 3120
conversation-already-accepted 19673
conversation-declined 27
conversation-missed 831
conversation-request 23427
Data frames (note that these are reduced versions as confidential information has been removed):
users <- structure(list(`_id` = c("JTuXhdI4Ai", "iGIeCEXyVE", "6XFtOJh0bD",
"mNN986oQv9", "9NI71KBMX9", "x1jH7t0Cmy"), language = c("en",
"en", "en", "en", "en", "en"), registering = c(TRUE, TRUE, FALSE,
FALSE, FALSE, NA), `_created_at` = structure(c(1485995043.131,
1488898839.838, 1480461193.146, 1481407887.979, 1489942757.189,
1491311381.916), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
`_updated_at` = structure(c(1521039527.236, 1488898864.834,
1527618624.877, 1481407959.116, 1490043838.561, 1491320333.09
), class = c("POSIXct", "POSIXt"), tzone = "UTC"), lastOnlineTimestamp = c(1521039526.90314,
NA, 1480461472, 1481407959, 1490043838, NA), isAgent = c(FALSE,
NA, FALSE, FALSE, FALSE, NA), lastAvailableTime = structure(c(NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), class = c("POSIXct",
"POSIXt"), tzone = ""), available = c(NA, NA, NA, NA, NA,
NA), busy = c(NA, NA, NA, NA, NA, NA), joinedTeam = structure(c(NA_real_,
NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), class = c("POSIXct",
"POSIXt"), tzone = ""), timezone = c(NA_character_, NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_
)), row.names = c("list.1", "list.2", "list.3", "list.4",
"list.5", "list.6"), class = "data.frame")
and
events <- structure(list(`_id` = c("JKY8ZwkM1S", "CG7Xj8dAsA", "pUkFFxoahy",
"yJVJ34rUCl", "XxXelkIFh7", "GCOsENVSz6"), expirationTime = structure(c(1527261147.873,
NA, 1527262121.332, NA, 1527263411.619, 1527263411.619), class = c("POSIXct",
"POSIXt"), tzone = ""), partId = c("d22bfddc-cd51-489f-aec8-5ab9225c0dd5",
"d22bfddc-cd51-489f-aec8-5ab9225c0dd5", "cf4356da-b63e-4e4d-8e7b-fb63035801d8",
"cf4356da-b63e-4e4d-8e7b-fb63035801d8", "a720185e-c300-47c0-b30d-64e1f272d482",
"a720185e-c300-47c0-b30d-64e1f272d482"), type = c("conversation-request",
"conversation-accepted", "conversation-request", "conversation-accepted",
"conversation-request", "conversation-request"), `_p_conversation` = c("Conversation$6nSaLeWqs7",
"Conversation$6nSaLeWqs7", "Conversation$6nSaLeWqs7", "Conversation$6nSaLeWqs7",
"Conversation$bDuAYSZgen", "Conversation$bDuAYSZgen"), `_p_merchant` = c("Merchant$0A2UYADe5x",
"Merchant$0A2UYADe5x", "Merchant$0A2UYADe5x", "Merchant$0A2UYADe5x",
"Merchant$0A2UYADe5x", "Merchant$0A2UYADe5x"), `_p_associate` = c("D9ihQOWrXC",
"D9ihQOWrXC", "D9ihQOWrXC", "D9ihQOWrXC", "D9ihQOWrXC", "D9ihQOWrXC"
), `_wperm` = list(list(), list(), list(), list(), list(), list()),
`_rperm` = list("*", "*", "*", "*", "*", "*"), `_created_at` = structure(c(1527264657.998,
1527264662.043, 1527265661.846, 1527265669.435, 1527266922.056,
1527266922.059), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
`_updated_at` = structure(c(1527264657.998, 1527264662.043,
1527265661.846, 1527265669.435, 1527266922.056, 1527266922.059
), class = c("POSIXct", "POSIXt"), tzone = "UTC"), read = c(TRUE,
NA, TRUE, NA, NA, NA), data.customerName = c("Shopper 109339",
NA, "Shopper 109339", NA, "Shopper 109364", "Shopper 109364"
), data.departmentName = c("Personal advisors", NA, "Personal advisors",
NA, "Personal advisors", "Personal advisors"), data.recurring = c(FALSE,
NA, TRUE, NA, FALSE, FALSE), data.new = c(TRUE, NA, FALSE,
NA, TRUE, TRUE), data.missed = c(0L, NA, 0L, NA, 0L, 0L),
data.customerId = c("84uOFRLmLd", "84uOFRLmLd", "84uOFRLmLd",
"84uOFRLmLd", "5Dw4iax3Tj", "5Dw4iax3Tj"), data.claimingTime = c(NA,
4L, NA, 7L, NA, NA), data.lead = c(NA, NA, FALSE, NA, NA,
NA), data.maxMissed = c(NA, NA, NA, NA, NA, NA), data.associateName = c(NA_character_,
NA_character_, NA_character_, NA_character_, NA_character_,
NA_character_), data.maxDecline = c(NA, NA, NA, NA, NA, NA
), data.goUnavailable = c(NA, NA, NA, NA, NA, NA)), row.names = c("list.1",
"list.2", "list.3", "list.4", "list.5", "list.6"), class = "data.frame")
Update: 21st September 2018
This solution now results in an NA-only data frame being produced at the end of the function. When written to a .csv, this is what I get (naturally, Excel displays NA-values as blank values):
My data source has not changed, nor has my script.
What might be causing this?
My guess is that this is an unforeseen case where there may have been 0 hits for each step has occurred; as such, is there a way to add 0 to those cases where there weren't any hits, rather than NA/ blank values?
Is there a way to avoid this?
New solution based on the provided data.
Note: As your data had no overlap in _id, I changed the events$_id to be the same as in users.
Simplified example data:
users <- structure(list(`_id` = structure(c(4L, 3L, 1L, 5L, 2L, 6L),
.Label = c("6XFtOJh0bD", "9NI71KBMX9", "iGIeCEXyVE",
"JTuXhdI4Ai", "mNN986oQv9", "x1jH7t0Cmy"),
class = "factor")), .Names = "_id",
row.names = c(NA, -6L), class = "data.frame")
events <- structure(list(`_id` = c("JKY8ZwkM1S", "CG7Xj8dAsA", "pUkFFxoahy",
"yJVJ34rUCl", "XxXelkIFh7", "GCOsENVSz6"),
type = c("conversation-request", "conversation-accepted",
"conversation-request", "conversation-accepted",
"conversation-request", "conversation-request")),
.Names = c("_id", "type"), class = "data.frame",
row.names = c("list.1", "list.2", "list.3", "list.4", "list.5", "list.6"))
events$`_id` <- users$`_id`
> users
_id
1 JTuXhdI4Ai
2 iGIeCEXyVE
3 6XFtOJh0bD
4 mNN986oQv9
5 9NI71KBMX9
6 x1jH7t0Cmy
> events
_id type
list.1 JTuXhdI4Ai conversation-request
list.2 iGIeCEXyVE conversation-accepted
list.3 6XFtOJh0bD conversation-request
list.4 mNN986oQv9 conversation-accepted
list.5 9NI71KBMX9 conversation-request
list.6 x1jH7t0Cmy conversation-request
We can use the same approach I suggested before, just enhance it a bit.
First we loop over unique(events$type) to store a table() of every type of event per id in a list:
test <- lapply(unique(events$type), function(x) table(events$`_id`, events$type == x))
Then we store the specific type as the name of the respective table in the list:
names(test) <- unique(events$type)
Now we use a simple for-loop to match() the user$_id with the rownames of the table and store the information in a new variable with the name of the event type:
for(i in names(test)){
users[, i] <- test[[i]][, 2][match(users$`_id`, rownames(test[[i]]))]
}
Result:
> users
_id conversation-request conversation-accepted
1 JTuXhdI4Ai 1 0
2 iGIeCEXyVE 0 1
3 6XFtOJh0bD 1 0
4 mNN986oQv9 0 1
5 9NI71KBMX9 1 0
6 x1jH7t0Cmy 1 0
Hope this helps!

Resources