Related
I would like to write a function with multiple conditions within lapply. I know how to define multiple conditions using a for loop. However I would like to avoid looping this time.
For instance:
let's assume there is a vector (vctr) with numbers from -3 to 5:
set.seed(10)
vctr <- c(sample(-3:5), rep(0,3), sample(-3:5), 0)
and let's define two conditions:
condition_1 <- if the number is equal to 0 -> add 1 to the initial
value
condition_2 <- if the number is not equal to 0 -> leave it be
And this works perfectly fine:
test_list <- lapply(1:length(vctr), function(x) if(vctr[x]==0) vctr[x] +1 else vctr[x])
However, what about the situation in which there would be multiple conditions? For instance:
condition_1 <- if the number is equal to 0 -> add 1
condition_2 <- if the number is negative -> replace it with absolute value
condition_3 <- if the number is greater than 0 but lower than 3 ->
add 2 to the initial value
condition_4 <- if the number is equal or greater than 3 -> leave it be
I tried the following with conditions 1, 2 and "leave it be" however this syntax does not work.
test_list2 <- lapply(1:length(vctr), function(x) if(vctr[x]==0) vctr[x] +1 if else(vctr[x]<0) abs(vctr[x]) else vctr[x])
EDIT: I would like to ask for non-dplyr solutions.
you can replace sapply with lapply if you want a list output
sapply(vctr, function(x) {
if (x == 0) y <- x + 1
if (x < 0) y <- abs(x)
if (x > 0 & x < 3) y <- x + 2
if (x >= 3) y <- x
return(y)
})
[1] 5 2 1 4 1 3 3 3 4 1 1 1 3 2 4 3 1 5 1 3 4 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.
I am trying to get all the indexes that meet a condition in a colum. I've already done this in the case of having one column like this:
# Get a 10% of samples labeled with a 1
indexPositive = sample(which(datafsign$result == 1), nrow(datafsign) * .1)
It is possible to do the same operation vectoriced for any number of columns in one line as well? I imagine that in that case indexPositive would be a list or array with the indexes of each column.
Data
The data frame is as follow:
x y f1 f2 f3 f4
1 76.71655 60.74299 1 1 -1 -1
2 -85.73743 -19.67202 1 1 1 -1
3 75.95698 -27.20154 1 1 1 -1
4 -82.57193 39.30717 1 1 1 -1
5 -45.32161 39.44898 1 1 -1 -1
6 -46.76636 -35.30635 1 1 1 -1
The seed I am using is set.seed(1000000007)
What I want is the set of indexes with value 1. In the case of only one column the result is:
head(indexPositive)
[1] 1398 873 3777 2140 133 3515
Thanks in advance.
Answer
Thanks to #David Arenburg I finally did it. Based on his comment I created this function:
getPercentageOfData <- function(x, condition = 1, percentage = .1){
# Get the percentage of samples that meet condition
#
# Args:
# x: A vector containing the data
# condition: Condition that the data need to satisfy
# percentaje: What percentage of samples to get
#
# Returns:
# Indexes of the percentage of the samples that meet the condition
meetCondition = which(x == condition)
sample(meetCondition, length(meetCondition) * percentage)
}
And then I used like this:
# Get a 10% of samples labeled with a 1 in all 4 functions
indexPositive = lapply(datafunctions[3:6], getPercentageOfData)
# Change 1 by -1
datafunctions$f1[indexPositive$f1] = -1
datafunctions$f2[indexPositive$f2] = -1
datafunctions$f3[indexPositive$f3] = -1
datafunctions$f4[indexPositive$f4] = -1
It would be great to also assign the values -1 to each column at once instead of writing 4 lines, but I do not know how.
You can define your function as follows (you can also add replacement as a partameter)
getPercentageOfData <- function(x, condition = 1, percentage = .1, replacement = -1){
meetCondition <- which(x == condition)
replace(x, sample(meetCondition, length(meetCondition) * percentage), replacement)
}
Then select the columns you want to operate on and update datafunctions directly (without creating indexPositive and then manually updating)
cols <- 3:6
datafunctions[cols] <- lapply(datafunctions[cols], getPercentageOfData)
You can of course play around with the functions parameters within lapply as in (for example)
datafunctions[cols] <- lapply(datafunctions[cols],
getPercentageOfData, percentage = .8, replacement = -100)
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.
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.