Randomly drop a column selected from a group, excluding one - r

I have the following data frame, which is going to be used as an input in a logit regression:
my_frame<-data.frame(y=c(1,0,1),A=c(0,1,1),B=c(1,0,0),C=c(0,0,0),t=c(1,1,1),x=c(1,0,0),z=c(1,0,1))
Knowing that the dummy variables A, B and C are connected through a linear equation (A+B+C=1), I need to drop one of the three before proceeding.
y A B C t x z
1 0 1 0 1 1 1
0 1 0 0 1 0 0
1 1 0 0 1 0 1
Now, here is the difficult part. I want to exclude randomly one of the columns of a group comprised by A,B,C and D, but not the one that has 1 as a value in the last row of the dataframe.
In my example, I want one of B and C to be excluded randomly.
Column D is not present, because in this particular data frame it would always be valued 0, but it is still part of the same group of variables.

I don't really get, what you mean with your last sentence about column D, but anyway, you could try this:
my_frame<-data.frame(y=c(1,0,1),A=c(0,1,1),B=c(1,0,0),C=c(0,0,0),t=c(1,1,1),x=c(1,0,0),z=c(1,0,1))
allRelevantCols <- c("A", "B", "C")
# Get all columns, which can be excluded
allColsToExclude <- allRelevantCols[which(my_frame[nrow(my_frame), allRelevantCols] == 0)]
for (i in 1:<how often you would like to run this>) {
colsToExclude <- c(sample(allColsToExclude, 1))
my_frame[, -which(colnames(my_frame) %in% colsToExclude)]
}

Related

How can I use rowSums with conditions to return binary value?

Say I have a data frame with a column for summed data. What is the most efficient way to return a binary 0 or 1 in a new column if any value in columns a, b, or c are NOT zero? rowSums is fine for a total, but I also need a simple indicator if anything differs from a value.
tt <- data.frame(a=c(0,-5,0,0), b=c(0,5,10,0), c=c(-5,0,0,0))
tt[, ncol(tt)+1] <- rowSums(tt)
This yields:
> tt
a b c V4
1 0 0 -5 -5
2 -5 5 0 0
3 0 10 10 20
4 0 0 0 0
The fourth column is a simple sum of the data in the first three columns. How can I add a fifth column that returns a binary 1/0 value if any value differs from a criteria set on the first three columns?
For example, is there a simple way to return a 1 if any of a, b, or c are NOT 0?
as.numeric(rowSums(tt != 0) > 0)
# [1] 1 1 1 0
tt != 0 gives us a logical matrix telling us where there are values not equal to zero in tt.
When the sum of each row is greater than zero (rowSums(tt != 0) > 0), we know that at least one value in that row is not zero.
Then we convert the result to numeric (as.numeric(.)) and we've got a binary vector result.
We can use Reduce
+(Reduce(`|`, lapply(tt, `!=`, 0)))
#[1] 1 1 1 0
One could also use the good old apply loop:
+apply(tt != 0, 1, any)
#[1] 1 1 1 0
The argument tt != 0 is a logical matrix with entries stating whether the value is different from zero. Then apply() with margin 1 is used for a row-wise operation to check if any of the entries is true. The prefix + converts the logical output into numeric 0 or 1. It is a shorthand version of as.numeric().

Check and replace column values in R dataframe

I have multiple files to read in using R. I iterate through the files in a loop, obtain dataframes and then try to change values of a particular column. Examples of the R dataframes are as follows:
df_A:
ID ZN
1 0
2 1
3 1
4 0
df_B:
ID ZN
1 2
2 1
3 1
4 2
As shown above, the column 'ZN' for some dataaframes may have 0's and 1's and others dataframes have have 1's and 2's. What I want is - as I'm iterating through the files, I want to make changes only in the dataframes with column ZN having 1's and 2's like this: 1 to 0 and 2 to 1. Dataframes with ZN values as 0's and 1's will be left unchaged.
my attempt did not work:
if(dataframe$ZN > 1){
dataframe$ZN<-recode(dataframe$ZN,"1=0;2=1")
}
else{
dataframe$ZN
}
Any solutions please?
One approach might be to decrement the value of ZN by one if we detect a single value of 2 anywhere in the column:
if (max(df_A$ZN) == 2) {
df_A$ZN = df_A$ZN - 1
}
Demo
If there are only two values i.e. 0 and 1, then
df_A$ZN <- (df_A$ZN==0) + 1
df_A$ZN
#[1] 2 1 1 2
Or using case_when for multiple values
library(dplyr)
df_A %>%
mutate(ZN = case_when(ZN==0 ~2, TRUE ~ 1))

R: find difference if at least one of the two values are zero

I would like to calculate the abs(difference) of rows (current with preceding row), if at least one of the values is zero. If both values are non-zeros, it should return 0.
Example: the column 'A' shows the initial data, 'Diff' shows what I want to get:
df <- data.frame(A=c(0,0,1,2,3,4,0,0),Diff=c(0,0,1,0,0,0,4,0))
Thanks
Here's a way using the dplyr package and the lag function:
library(dplyr)
df1 <- data.frame(A=c(0,0,1,2,3,4,0,0),Diff=c(0,0,1,0,0,0,4,0))
df1 %>%
mutate(lag_A = lag(A),
Diff2 = abs(A - lag_A)) %>%
mutate(Diff2 = ifelse(is.na(lag_A), 0,
ifelse(A == 0 | lag_A == 0, Diff2, 0)))
A Diff lag_A Diff2
1 0 0 NA 0
2 0 0 0 0
3 1 1 0 1
4 2 0 1 0
5 3 0 2 0
6 4 0 3 0
7 0 4 4 4
8 0 0 0 0
You could then use the select function to grab the columns you want. I left all of the columns in the table to illustrate the solution.
Assumption
I'm gonna assume the first value of Diff is not the result of the operation you want, because the first value of A has no preceding value, therefore i chose to repeat it on the answer, but you can add anything instead of A[1].
Edit: I also assumed you wanted a solution using only base, otherwise, bouncyball's solution works like a charm.
Solution
Diff = rep(0,(length(A)-1))
Diff[which(mapply(xor,A[-1],A[-length(A)]))] = abs(A[-1][which(mapply(xor,A[-1],A[-length(A)]))]-A[-length(A)][which(mapply(xor,A[-1],A[-length(A)]))])
Diff = c(A[1],Diff)
You can improve upon this by making it a named function like this:
foo = function(A){
Diff = rep(0,(length(A)-1))
Diff[which(mapply(xor,A[-1],A[-length(A)]))] = abs(A[-1][which(mapply(xor,A[-1],A[-length(A)]))]-A[-length(A)][which(mapply(xor,A[-1],A[-length(A)]))])
Diff = c(A[1],Diff)
Diff
}
Explanation
Instead of operating A, we use:
A[-1], which yields 0 1 2 3 4 0 0 (equal to A but without the first element)
and A[-length(A)], which yields: 0 0 1 2 3 4 0 (equal to A, but without the last element).
If we subtract the first from the latter we have the element-wise subtractions right, but we still need to know when these subtractions need to occur.
By combining functions xor, mapply and which (all of them are members of base), like this:
which(mapply(xor,A[-1],A[-length(A)])) we find:
2 6 which are the indexes of the positions in A[-1] and A[-length(A)] where subtractions should happen.
Now we create a 0 vector called Diff the same size of our new vectors using:
Diff = rep(0,length(A)-1), then we change only the indexes that should not contain 0s using:
Diff[which(mapply(xor,A[-1],A[-length(A)]))] = abs(A[-1][which(mapply(xor,A[-1],A[-length(A)]))]-A[-length(A)][which(mapply(xor,A[-1],A[-length(A)]))])
And finally we put back the first element again using Diff = c(A[1],Diff).

Converting Categorical Columns into Multiple Binary Columns in R

I am trying to convert a column that has categorical data ('A', 'B', or 'C') to 3 columns where 1,0,0 would be 'A'; 0,1,0 would represent 'B', etc.
I found this code online:
flags = data.frame(Reduce(cbind,
lapply(levels(d$purpose), function(x){(d$purpose == x)*1})
))
names(flags) = levels(d$purpose)
d = cbind(d, flags)
# Include the new columns as input variables
levelnames = paste(names(flags), collapse = " + ")
neuralnet(paste("output ~ ", levelnames), d)
Converting categorical variables in R for ANN (neuralnet)
But I'm very new to R. Can anyone break down what this complicated looking code is doing?
edit:
Implementing #nongkrong's recommendations I'm running into a problem:
CSV:
X1,X2,X3
A,D,Q
B,E,R
C,F,S
B,G,T
C,H,U
A,D,Q
R:
newData <- read.csv("new.csv")
newerData <- model.matrix(~ X1 + X2 + X3 -1, data=newData)
newerData
R Output:
X1A X1B X1C X2E X2F X2G X2H X3R X3S X3T X3U
1 1 0 0 0 0 0 0 0 0 0 0
2 0 1 0 1 0 0 0 1 0 0 0
3 0 0 1 0 1 0 0 0 1 0 0
4 0 1 0 0 0 1 0 0 0 1 0
5 0 0 1 0 0 0 1 0 0 0 1
6 1 0 0 0 0 0 0 0 0 0 0
It works great with 1 column, but is missing X2D and X3Q. Any ideas why?
#nongkrong is right--read ?formulas and you'll see that most functions that accept formulas as input (e.g. lm, glm, etc.) will automatically convert categorical variables (stored as factors or characters) to dummies; you can force this on non-factor numeric variables by specifying as.factor(var) in your formula.
That said, I've encountered situations where it's convenient to have created these indicators by hand anyway--e.g., a data set with an ethnicity variable where <1% of the data fit in one or several of the ethnicity codes. There are other ways to deal with this (simply delete the minority-minority observations, e.g.), but I find that varies by situation.
So, I've annotated the code for you:
flags = data.frame(Reduce(cbind,
lapply(levels(d$purpose), function(x){(d$purpose == x)*1})
))
Lots going on in this first line, so let's go bit-by-bit:
d$purpose==x checks each entry of d$purpose for equality to x; the result will be TRUE or FALSE (or NA if there are missing values). Multiplying by 1 (*1) forces the output to be an integer (so TRUE becomes 1 and FALSE becomes 0).
lapply applies the function in its second argument to each element of its first argument--so for each element of levels(d$purpose) (i.e., each level of d$purpose), we output a vector of 0s and 1s, where the 1s correspond to the elements of d$purpose matching the given level. The output of lapply is a list (hence l in front of apply), with one list element corresponding to each of the levels of d$purpose.
We want to get this into our data.frame, so a list isn't very useful; Reduce is what we use to back out the information from the list to a data.frame form. Reduce(cbind,LIST) is the same as cbind(LIST[[1]],LIST[[2]],LIST[[3]],...)--convenient shorthand, especially when we don't know the length of LIST.
Wrapping this in data.frame casts this into the mode data.frame.
#This line simply puts column names on each of the indicator variables
# Note that you can replace the RHS of this line with whatever
# naming convention you want for the levels--a common approach might
# be to specify paste0(levels(d$purpose),"_flag"), e.g.
names(flags) = levels(d$purpose)
#this line adds all the indicator variables to the original
# data.frame
d = cbind(d, flags)
#this creates a string of the form "level1 + level2 + ... + leveln"
levelnames = paste(names(flags), collapse = " + ")
#finally we create a formula of the form y~x+d1+d2+d3
# where each of the d* is a dummy for a level of the categorical variable
neuralnet(paste("output ~ ", levelnames), d)
Also note that something like this could have been done much simpler in the data.table package:
library(data.table)
setDT(d)
l = levels(purpose)
d[ , (l) := lapply(l, function(x) as.integer(purpose == x))]
d[ , neuralnet(paste0("output~", paste0(l, collapse = "+"))]

Comparing two columns: logical- is value from column 1 also in column 2?

I'm pretty confused on how to go about this. Say I have two columns in a dataframe. One column a numerical series in order (x), the other specifying some value from the first, or -1 (y). These are results from a matching experiment, where the goal is to see if multiple photos are taken of the same individual. In the example below, there 10 photos, but 6 are unique individuals. In the y column, the corresponding x is reported if there is a match. y is -1 for no match (might as well be NAs). If there is more than 2 photos per individual, the match # will be the most recent record (photo 1, 5 and 7 are the same individual below). The group is the time period the photo was take (no matches within a group!). Hopefully I've got this example right:
x <- c(1,2,3,4,5,6,7,8,9,10)
y <- c(-1,-1,-1,-1,1,-1,1,-1,2,4)
group <- c(1,1,1,2,2,2,3,3,3,3)
DF <- data.frame(x,y,group)
I would like to create a new variable to name the unique individuals, and have a final dataset with a single row per individual (i.e. only have 6 rows instead of 10), that also includes the group information. I.e. if an individual is in all three groups, there could be a value of "111" or if just in the first and last group it would be "101". Any tips?
Thanks for asking about the resulting dataset. I realized my group explanation was bad based on the actual numbers I gave, so I changed the results slightly. Bonus would also be nice to have, but not critical.
name <- c(1,2,3,4,6,8)
group_history <- as.character(c('111','101','100','011','010','001'))
bonus <- as.character(c('1,5,7','2,9','3','4,10','6','8'))
results_I_want <- data.frame(name,group_history,bonus)
My word, more mistakes fixed above...
Using the (updated) example you gave
x <- c(1,2,3,4,5,6,7,8,9,10)
y <- c(-1,-1,-1,-1,1,-1,1,-1,3,4)
group <- c(1,1,1,2,2,2,3,3,3,3)
DF <- data.frame(x,y,group)
Use the x and y to create a mapping from higher numbers to lower numbers that are the same person. Note that names is a string, despite it be a string of digits.
bottom.df <- DF[DF$y==-1,]
mapdown.df <- DF[DF$y!=-1,]
mapdown <- c(mapdown.df$y, bottom.df$x)
names(mapdown) <- c(mapdown.df$x, bottom.df$x)
We don't know how many times it might take to get everything down to the lowest number, so have to use a while loop.
oldx <- DF$x
newx <- mapdown[as.character(oldx)]
while(any(oldx != newx)) {
oldx = newx
newx = mapdown[as.character(oldx)]
}
The result is the group it belongs to, names by the lowest number of that set.
DF$id <- unname(newx)
Getting the group membership is harder. Using reshape2 to convert this into wide format (one column per group) where the column is "1" if there was something in that one and "0" if not.
library("reshape2")
wide <- dcast(DF, id~group, value.var="id",
fun.aggregate=function(x){if(length(x)>0){"1"}else{"0"}})
Finally, paste these "0"/"1" memberships together to get the grouping variable you described.
wide$grouping = apply(wide[,-1], 1, paste, collapse="")
The result:
> wide
id 1 2 3 grouping
1 1 1 1 1 111
2 2 1 0 0 100
3 3 1 0 1 101
4 4 0 1 1 011
5 6 0 1 0 010
6 8 0 0 1 001
No "bonus" yet.
EDIT:
To get the bonus information, it helps to redo the mapping to keep everything. If you have a lot of cases, this could be slow.
Replace the oldx/newx part with:
iterx <- matrix(DF$x, ncol=1)
iterx <- cbind(iterx, mapdown[as.character(iterx[,1])])
while(any(iterx[,ncol(iterx)]!=iterx[,ncol(iterx)-1])) {
iterx <- cbind(iterx, mapdown[as.character(iterx[,ncol(iterx)])])
}
DF$id <- iterx[,ncol(iterx)]
To generate the bonus data, then you can use
bonus <- tapply(iterx[,1], iterx[,ncol(iterx)], paste, collapse=",")
wide$bonus <- bonus[as.character(wide$id)]
Which gives:
> wide
id 1 2 3 grouping bonus
1 1 1 1 1 111 1,5,7
2 2 1 0 0 100 2
3 3 1 0 1 101 3,9
4 4 0 1 1 011 4,10
5 6 0 1 0 010 6
6 8 0 0 1 001 8
Note this isn't same as your example output, but I don't think your example output is right (how can you have a grouping_history of "000"?)
EDIT:
Now it agrees.
Another solution for bonus variable
f_bonus <- function(data=df){
data_a <- subset(data,y== -1,select=x)
data_a$pos <- seq(nrow(data_a))
data_b <- subset(df,y!= -1,select=c(x,y))
data_b$pos <- match(data_b$y, data_a$x)
data_t <- rbind(data_a,data_b[-2])
data_t <- with(data_t,tapply(x,pos,paste,sep="",collapse=","))
return(data_t)
}

Resources