I am developing a censored dependent variable for use in survival analysis. My goal is to find the last time ("time") that someone answers a question in a survey (e.g. the point where "q.time" is coded as "1", and "q.time+1" and q at all subsequent times are coded as "0").
By this logic, the last question answered should be coded as "1" (q.time). The first question that is NOT answered (q.time+1) should be coded as "0". And all questions subsequent to the first question NOT answered should be coded as "NA". I then want to remove ALL rows where the DV=NA from my dataset.
A very generous coworker has helped me to develop the following code, but he's on vacation now and it needs a little more lovin'. Code is as follows:
library(plyr) # for ddply
library(stats) # for reshape(...)
# From above
dat <- data.frame(
id=c(1, 2, 3, 4),
q.1=c(1, 1, 0, 0),
q.2=c(1, 0, 1, 0),
dv.1=c(1, 1, 1, 1),
dv.2=c(1, 1, 0, 1))
# From above
long <- reshape(dat,
direction='long',
varying=c('q.1', 'q.2', 'dv.1', 'dv.2'))
ddply(long, .(id), function(df) {
# figure out the dropoff time
answered <- subset(df, q == 1)
last.q = max(answered$time)
subs <- subset(df, time <= last.q + 1)
# set all the dv as desired
new.dv <- rep(last.q,1)
if (last.q < max(df$time)) new.dv <- c(0,last.q)
subs$dv <- new.dv
subs
})
Unfortunately, this yields the error message:
"Error in `$<-.data.frame`(`*tmp*`, "dv", value = c(0, -Inf)) :
replacement has 2 rows, data has 0"
Any ideas? The problem seems to be located in the "rep" command, but I'm a newbie to R. Thank you so much!
UPDATE: SEE EXPLANATIONS BELOW, and then REFER TO FOLLOW-UP QUESTION
Hi there-I completely followed you, and really appreciate the time you took to help me out. I went back into my data and coded in a dummy Q where all respondents have a value of "1" - but, discovered where the error really may be. In my real data set, I have 30 questions (i.e., 30 times in long form). After I altered the dataset so FOR SURE q==1 for all id variables, the error message changed to saying
"Error in `$<-.data.frame`(`*tmp*`, "newvar", value = c(0, 29)) : replacement has 2 rows, data has 31"
If the problem is with the number of rows assigned to subs, then is the source of the error coming from...
subs <- subset(df, time <= last.q + 1)
i.e., $time <= last.q + 1$ is setting the number of rows to the value EQUAL to last.q+1?
UPDATE 2: What, ideally, I'd like my new variable to look like!
id time q dv
1 1 1 1
1 2 1 1
1 3 1 1
1 4 1 1
1 5 0 0
1 6 0 NA
2 1 1 1
2 2 1 1
2 3 0 0
2 4 0 NA
2 5 0 NA
2 6 0 NA
Please note that "q" can vary between "0" or "1" over time (See the observation for id=1 at time=2), but due to the nature of survival analysis, "dv" cannot. What I need to do is create a variable that finds the LAST time that "q" changes between "1" and "0", and then is censored accordingly. After Step 4, my data should look like this:
id time q dv
1 1 1 1
1 2 1 1
1 3 1 1
1 4 1 1
2 1 1 1
2 2 1 1
2 3 0 0
.(id) in plyr is equivalent to
> dum<-split(long,long$id)
> dum[[4]]
id time q dv
4.1 4 1 0 1
4.2 4 2 0 1
your problem is in your 4th split. You reference
answered <- subset(df, q == 1)
in your function. This is an empty set as there are no dum[[4]]$q taking value 1
If you just want to ignore this split then something like
ans<-ddply(long, .(id), function(df) {
# figure out the dropoff time
answered <- subset(df, q == 1)
if(length(answered$q)==0){return()}
last.q = max(answered$time)
subs <- subset(df, time <= last.q + 1)
# set all the dv as desired
new.dv <- rep(last.q,1)
if (last.q < max(df$time)) new.dv <- c(0,last.q)
subs$dv <- new.dv
subs
})
> ans
id time q dv
1 1 1 1 2
2 1 2 1 2
3 2 1 1 0
4 2 2 0 1
5 3 1 0 2
6 3 2 1 2
would be the result
In short: The error is because there is no q == 1 when id == 4.
A good way to check what's going on here is to rewrite the function separately, and manually test each chunk that ddply is processing.
So first rewrite your code like this:
myfun <- function(df) {
# figure out the dropoff time
answered <- subset(df, q == 1)
last.q = max(answered$time)
subs <- subset(df, time <= last.q + 1)
# set all the dv as desired
new.dv <- rep(last.q,1)
if (last.q < max(df$time)) new.dv <- c(0,last.q)
subs$dv <- new.dv
subs
}
ddply(long, .(id), myfun )
That still gives an error of course, but at least now we can manually check what ddply is doing.
ddply(long, .(id), myfun ) really means:
Take the dataframe called long
Create a number of subset dataframes (one for each distinct id)
Apply the function myfun to each subsetted dataframe
Reassemble the results into a single dataframe
So let's attempt to do manually what ddply is doing automatically.
> myfun(subset(long, id == 1))
id time q dv
1.1 1 1 1 2
1.2 1 2 1 2
> myfun(subset(long, id == 2))
id time q dv
2.1 2 1 1 0
2.2 2 2 0 1
> myfun(subset(long, id == 3))
id time q dv
3.1 3 1 0 2
3.2 3 2 1 2
> myfun(subset(long, id == 4))
Error in `$<-.data.frame`(`*tmp*`, "dv", value = c(0, -Inf)) :
replacement has 2 rows, data has 0
In addition: Warning message:
In max(answered$time) : no non-missing arguments to max; returning -Inf
>
So it seems like the error is coming from the step where ddply applies the function for id == 4.
Now let's take the code outside of the function so we can examine each chunk.
> #################
> # set the problem chunk to "df" so we
> # can examine what the function does
> # step by step
> ################
> df <- subset(long, id == 4)
>
> ###################
> # run the bits of function separately
> ###################
> answered <- subset(df, q == 1)
> answered
[1] id time q dv
<0 rows> (or 0-length row.names)
> last.q = max(answered$time)
Warning message:
In max(answered$time) : no non-missing arguments to max; returning -Inf
> last.q
[1] -Inf
> subs <- subset(df, time <= last.q + 1)
> subs
[1] id time q dv
<0 rows> (or 0-length row.names)
> # set all the dv as desired
> new.dv <- rep(last.q,1)
> new.dv
[1] -Inf
> if (last.q < max(df$time)) new.dv <- c(0,last.q)
> subs$dv <- new.dv
Error in `$<-.data.frame`(`*tmp*`, "dv", value = c(0, -Inf)) :
replacement has 2 rows, data has 0
> subs
[1] id time q dv
<0 rows> (or 0-length row.names)
>
So the error that you're getting comes from subs$dv <- new.dv because new.dv has length two (i.e. two values - (0, -Inf)) but sub$dv is length 0. That wouldn't be a problem if dv were a simple vector, but because it's in the sub dataframe whose columns all have two rows, then sub$dv must also have two rows.
The reason sub has zero rows is because there is no q == 1 when id == 4.
Should the final data frame not have anything for id == 4? The answer to your problem really depends on what you want to happen in the case when there are no q==1 for an id. Just let us know, and we can help you with the code.
UPDATE:
The error that you're getting is because subs$dv has 31 values in it and new.dv has two values in it.
In R when you try to assign a longer vector to a shorter vector, it will always complain.
> test <- data.frame(a=rnorm(100),b=rnorm(100))
> test$a <- rnorm(1000)
Error in `$<-.data.frame`(`*tmp*`, "a", value = c(-0.0507065994549323, :
replacement has 1000 rows, data has 100
>
But when you assign a shorter vector to a longer vector, it will only complain if the shorter is not an even multiple of the longer vector. (eg 3 does not go evenly into 100)
> test$a <- rnorm(3)
Error in `$<-.data.frame`(`*tmp*`, "a", value = c(-0.897908251650798, :
replacement has 3 rows, data has 100
But if you tried this, it wouldn't complain since 2 goes into 100 evenly.
> test$a <- rnorm(2)
>
Try this:
> length(test$a)
[1] 100
> length(rnorm(2))
[1] 2
> test$a <- rnorm(2)
> length(test$a)
[1] 100
>
What's it's doing is silently repeating the shorter vector to fill up the longer vector.
And again, what you do to get around the error (i.e. make both vectors the same length) will depend on what you're trying to achieve. Do you make new.dv shorter, or subs$dv longer?
First, to give credit where credit is due, the code below is not mine. It was generated in collaboration with another very generous coworker (and engineer) who helped me work through my problem (for hours!).
I thought that other analysts tasked with constructing a censored variable from survey data might find this code useful, so I am passing the solution along.
library(plyr)
#A function that only selects cases before the last time "q" was coded as "1"
slicedf <- function(df.orig, df=NULL) {
if (is.null(df)) {
return(slicedf(df.orig, df.orig))
}
if (nrow(df) == 0) {
return(df)
}
target <- tail(df, n=1)
#print(df)
#print('--------')
if (target$q == 0) {
return(slicedf(df.orig, df[1:nrow(df) - 1, ]))
}
if (nrow(df.orig) == nrow(df)) {
return(df.orig)
}
return(df.orig[1:(nrow(df) + 1), ])
}
#Applies function to the dataset, and codes over any "0's" before the last "1" as "1"
long <- ddply(long, .(id), function(df) {
df <- slicedf(df)
if(nrow(df) == 0) {
return(df)
}
q <- df$q
if (tail(q, n=1) == 1) {
df$q <- rep(1, length(q))
} else {
df$q <- c(rep(1, length(q) - 1), 0)
}
return(df)
})
Thanks to everyone online who commented for your patience and help.
Related
I recently tried to match adjacent identical rows in a dataframe based on two variables (Condition1 and Outcome1 below). I have seen people doing this with all rows but not with adjacent rows, which is why I developed the following three-step work-around (which I hope did not overthink things):
-I lagged the variables based on which I wanted the matching to be done.
-I compared the variables and lagged-variables
-I deleted all rows in which both ware identical (and removed the remaining unnecessary columns).
Case <- c("Case 1", "Case 2", "Case 3", "Case 4", "Case 5")
Condition1 <- c(0, 1, 0, 0, 1)
Outcome1 <- c(0, 0, 0, 0, 1)
mwa.df <- data.frame(Case, Condition1, Outcome1)
new.df <- mwa.df
Condition_lag <- c(new.df$Condition1[-1],0)
Outcome_lag <- c(new.df$Outcome1[-1],0)
new.df <- cbind(new.df, Condition_lag, Outcome_lag)
new.df$Comp <- 0
new.df$Comp[new.df$Outcome1 == new.df$Outcome_lag & new.df$Condition1 == new.df$Condition_lag] <- 1
new.df <- subset(new.df, Comp == 0)
new.df <- subset(new.df, select = -c(Condition_lag, Outcome_lag, Comp))
This worked just fine. But when I tried to create a function for this because I had to do this operation with a large number of data frames, I encountered the problem that the lag did not work (i.e. the condition_lag <- c(new.df$condition[-1],0) and outcome_lag <- c(new.df$outcome[-1],0) operations were not carried out). The function code was:
FLC.Dframe <- function(old.df, condition, outcome){
new.df <- old.df
condition_lag <- c(new.df$condition[-1],0)
outcome_lag <- c(new.df$outcome[-1],0)
new.df <- cbind(new.df, condition_lag, outcome_lag)
new.df$comp <- 0
new.df$comp[new.df$outcome == new.df$outcome_lag & new.df$condition == new.df$condition_lag] <- 1
new.df <- subset(new.df, comp == 0)
new.df <- subset(new.df, select = -c(condition_lag, outcome_lag, comp))
return(new.df)
}
As for using the function, I wrote new.df <- FLC.Dframe(mwa.df, Condition1, Outcome1).
Could someone help me with this? Many thanks in advance.
Just generate run-length ids and remove the duplicates.
with(mwa.df, mwa.df[!duplicated(data.table::rleid(Condition1, Outcome1)), ])
Output
Case Condition1 Outcome1
1 Case 1 0 0
2 Case 2 1 0
3 Case 3 0 0
5 Case 5 1 1
If you want a function, then
FLC.Dframe <- function(df, cols) df[!duplicated(data.table::rleidv(df[, cols])), ]
Call this function like this
> FLC.Dframe(mwa.df, c("Condition1", "Outcome1"))
Case Condition1 Outcome1
1 Case 1 0 0
2 Case 2 1 0
3 Case 3 0 0
5 Case 5 1 1
The main problem with your function concerns the incorrect usage of $. This operator treats RHS input as is. For example, in this line new.df$condition the $ operator attempts to find in new.df a column named "condition", but not "Condition1", which is the value of condition. If you rewrite your function as follows, then it should work.
FLC.Dframe <- function(old.df, condition, outcome){
new.df <- old.df
condition_lag <- c(new.df[[condition]][-1],0)
outcome_lag <- c(new.df[[outcome]][-1],0)
new.df <- cbind(new.df, condition_lag, outcome_lag)
new.df$comp <- 0
new.df$comp[new.df[[outcome]] == new.df[["outcome_lag"]] & new.df[[condition]] == new.df[["condition_lag"]]] <- 1
new.df <- subset(new.df, comp == 0)
new.df <- subset(new.df, select = -c(condition_lag, outcome_lag, comp))
return(new.df)
}
You also need to call it like this (note that you need to use characters as inputs)
> FLC.Dframe(mwa.df, "Condition1", "Outcome1")
Case Condition1 Outcome1
1 Case 1 0 0
2 Case 2 1 0
4 Case 4 0 0
5 Case 5 1 1
I am trying to code the following statement in R with if and ifelse.The sample data is trial and x,y,and z are columns of trial).
Statements to be coded
if (x>0) {
if (y>0) {
l=2
}else{
l=5
}
if (z>0) {
m=l+2
}else{
m=5
}
}
The R code using ifelse
trial$l<-with(trial, ifelse((x>0 &y>0),2,ifelse((x>0 &y<=0),5,???)))
trial$m<-with (trial,ifelse((x>0 &z>0),l+2,ifelse((x>0 &z<=0),5,???)))
where, ??? specifies that there are no values according to the above statement. In other words for x<0 and y there are no values.
Next, I use combination of if and ifelse to see that works:
if(trial$z>0){
trial$l<-with(trial, ifelse(y>0,2,5))
trial$m<-with(trial, ifelse(z>0,l+2,5))
}
This code is ok but there is a warning message (since z is a column vector)
In if (trial$z>0){
the condition has length>1 and only the first element will be used
I want to focus only on using ifelse since I am dealing with only vector. But, I have no luck in this regard. Any idea?
If you want to use ifelse and nest things you could do something like this
test <- data.frame(x = 2, y = 5, z = 3)
with(test, ifelse(z > 0 & x > 0 | y > 3, "yes", "no"))
In this case you're using logical operators to guard the output. You'll still get "no" if z <= 0, but you can deal with that pretty easily.
with(test, ifelse(z > 0, ifelse(x > 0 | y > 3, "yes", "no"), NA))
Nested ifelse statements can get hard to follow in any language, so consider matching or switch statements if you end up with more than 3 of them.
I would use transform twice for example:
trial <- data.frame(x=c(-1,1,2),y=c(1,-2,3),z=c(1,-5,5))
trial <- transform(trial,l = ifelse(x>0,ifelse(y > 0,2,5),NA))
transform(trial,m = ifelse(x>0,ifelse(z>0,l+2,5),NA))
x y z l m
1 -1 1 1 NA NA
2 1 -2 -5 5 5
3 2 3 5 2 4
Note that I assign NA for case x < 0. You can use a one transform like this for example:
trial <- data.frame(x=c(-1,1,2),y=c(1,-2,3),z=c(1,-5,5))
transform(trial,l <- ifelse(x>0,ifelse(y > 0,2,5),NA),
m = ifelse(x>0,ifelse(z>0,l+2,5),NA))
x y z c.NA..5..2. m
1 -1 1 1 NA NA
2 1 -2 -5 5 5
3 2 3 5 2 4
But personally I would prefer the first one for readability besides the fact you need maybe change column names.
data:
row A B
1 1 1
2 1 1
3 1 2
4 1 3
5 1 1
6 1 2
7 1 3
Hi all! What I'm trying to do (example above) is to sum those values in column A, but only when column B = 1 (so starting with a simple subset line - below).
sum(data$A[data$B==1])
However, I only want to do this the first time that condition occurs until the values switch. If that condition re-occurs later in the column (row 5 in the example), I'm not interested in it!
I'd really appreciate your help in this (I suspect simple) problem!
Using data.table for syntax elegance, you can use rle to get this done
library(data.table)
DT <- data.table(data)
DT[ ,B1 := {
bb <- rle(B==1)
r <- bb$values
r[r] <- seq_len(sum(r))
bb$values <- r
inverse.rle(bb)
} ]
DT[B1 == 1, sum(a)]
# [1] 2
Here's a rather elaborate way of doing that:
data$counter = cumsum(data$B == 1)
sum(data$A[(data$counter >= 1:nrow(data) - sum(data$counter == 0)) &
(data$counter != 0)])
Another way:
idx <- which(data$B == 1)
sum(data$A[idx[idx == (seq_along(idx) + idx[1] - 1)]])
# [1] 2
# or alternatively
sum(data$A[idx[idx == seq(idx[1], length.out = length(idx))]])
# [1] 2
The idea: First get all indices of 1. Here it's c(2,3,5). From the start index = "2", you want to get all the indices that are continuous (or consecutive, that is, c(2,3,4,5...)). So, from 2 take that many consecutive numbers and equate them. They'll not be equal the moment they are not continuous. That is, once there's a mismatch, all the other following numbers will also have a mismatch. So, the first few numbers for which the match is equal will only be the ones that are "consecutive" (which is what you desire).
For each row of my dataframe, I want to calculate a value from numbers taken from columns of this dataframe. If the calculated value is above 2, I want to set another columns value to 0, else to 1.
x=(df$firstnumber+df$secondnumer)/2
if(x>2){
df$binaryValue=0}
else{ df$binaryValue=1}
this throws the error
the condition has length > 1 and only the first element will be used
because x is a vector
How can I solve this? One way would be to write this as a function and to apply it to the dataframe - are there any other options?
Also, how could I write this to work with appl() ?
Thanks in advance
You could simply do...
df$BinaryValue <- ifelse( x > 2 , 0 , 1 )
So you get...
df <- data.frame( x = 1:5 , y = -2:2 )
x <- df$x + df$y
df$BinaryValue <- ifelse( x > 2 , 0 , 1 )
df
# x y BinaryValue
# 1 1 -2 1
# 2 2 -1 1
# 3 3 0 0
# 4 4 1 0
# 5 5 2 0
transform(df, BinaryValue = as.numeric(firstnumber + secondnumber > 4))
There's no need to divide by two in the first place. You could check whether the sum is greater than four. The function as.numeric is employed to transform boolean to numeric (0 and 1) values.
I am working on a big dataset and have got a problem with data cleaning. My data set looks like this:
data <- cbind (group = c(1,1,1,2,2,3,3,3,4,4,4,4,4),
member = c(1,2,3,1,2,1,2,3,1,2,3,4,5),
score = c(0,1,0,0,0,1,0,1,0,1,1,1,0))
I just want to keep the group in which the sum of score is equal to 1 and remove the whole group in which the sum of score is equal to 0. For the group in which the sum of the score is greater than 1, e.g., sum of score = 3, I want to randomly select two group members with score equal to 1 and remove them from the group. Then the data may look like this:
newdata <- cbind (group = c(1,1,1,3,3,4,4,4),
member = c(1,2,3,2,3,1,3,5),
score = c(0,1,0,0,1,0,1,0))
Does anybody can help me get this done?
I would write a function that combines the various manipulations for you. Here is one such function, heavily commented:
process <- function(x) {
## this adds a vector with the group sum score
x <- within(x, sumScore <- ave(score, group, FUN = sum))
## drop the group with sumScore == 0
x <- x[-which(x$sumScore == 0L), , drop = FALSE]
## choose groups with sumScore > 1
## sample sumScore - 1 of the rows where score == 1L
foo <- function(x) {
scr <- unique(x$sumScore) ## sanity & take only 1 of the sumScore
## which of the grups observations have score = 1L
want <- which(x$score == 1L)
## want to sample all bar one of these
want <- sample(want, scr-1)
## remove the selected rows & retun
x[-want, , drop = FALSE]
}
## which rows are samples with group sumScore > 1
want <- which(x$sumScore > 1L)
## select only those samples, split up those samples by group, lapplying foo
## to each group, then rbind the resulting data frames together
newX <- do.call(rbind,
lapply(split(x[want, , drop = FALSE], x[want, "group"]),
FUN = foo))
## bind the sampled sumScore > 1L on to x (without sumScore > 1L)
newX <- rbind(x[-want, , drop = FALSE], newX)
## remove row labels
rownames(newX) <- NULL
## return the data without the sumScore column
newX[, 1:3]
}
that with your data:
dat <- data.frame(group = c(1,1,1,2,2,3,3,3,4,4,4,4,4),
member = c(1,2,3,1,2,1,2,3,1,2,3,4,5),
score = c(0,1,0,0,0,1,0,1,0,1,1,1,0))
gives:
> set.seed(42)
> process(dat)
group member score
1 1 1 0
2 1 2 1
3 1 3 0
4 3 1 1
5 3 2 0
6 4 1 0
7 4 3 1
8 4 5 0
Which is I think what was wanted.
Update: In process() above, the internal function foo() could be rewritten to sample only 1 row and remove the others. I.e replace foo() with the one below:
foo <- function(x) {
scr <- unique(x$sumScore) ## sanity & take only 1 of the sumScore
## which of the grups observations have score = 1L
want <- which(x$score == 1L)
## want to sample just one of these
want <- sample(want, 1)
## return the selected row & retun
x[want, , drop = FALSE]
}
They are the same operations essentially but foo() that selects just 1 row makes the intended behaviour explicit; we want to select 1 row at random from those with score == 1L, rather than sample scr-1 values.
I would define a function that does what you want it to. Then use ddply and split by group.
myfun <- function(x) {
if(sum(x$score)==1) {
return(x)
} else if(sum(x$score)==0) {
return(data.frame())
} else {
row.names(x) <- NULL
score.1 <- sample(as.integer(row.names(x[x$score==1,])), nrow(x[x$score==1,])-1)
return(x[-score.1,])
}
}
library(plyr)
ddply(as.data.frame(dat), .(group), myfun)
group member score
1 1 1 0
2 1 2 1
3 1 3 0
4 3 1 1
5 4 1 0
6 4 2 1
7 4 3 1
ugroups<-unique(data[,1])
scores<-sapply(ugroups,function(x){sum(data[,1]==x & data[,3]==1)})
data[data[,1]%in%ugroups[scores>0],]
....... etc
will give you the cumulative scores for each group etc