i'm stucked with a problem but i can find no satisfying answers on the web. I would like to valorize a data.frame(also a data.table it's good for me) using start:end vectors. An example will clarify what i'm asking.
Suppose i have a data.framelike the following:
df <- data.frame(col_1 = rep(0, 3), col_2 = rep(0, 3), col_3 = rep(0, 3), col_4 = rep(0,3))
df
col_1 col_2 col_3 col_4
1 0 0 0 0
2 0 0 0 0
3 0 0 0 0
And suppose i have two vectors:
indexesStart <- c(1, 2, 1)
indexesEnd <- c(2, 4, 3)
I would like to valorize to 1 all values in the range indicated by the vectors by row. The output should be the following:
col_1 col_2 col_3 col_4
1 1 1 0 0
2 0 1 1 1
3 1 1 1 0
I tried something like this:
df[ , indexesStart:indexesEnd] <- 1
But it doesn't work, it just takes indexesStart[1]:indexesEnd[1] and repeat it for all rows.
I must avoid loop cycles because my real data frame has millions rows and it is too slow. Any help is appreciated (a data.table solution would be even better)
Thank you
This will do it:
df <- data.frame(col_1=rep(0,3),col_2=rep(0,3),col_3=rep(0,3),col_4=rep(0,3))
indexesStart <- c(1, 2, 1)
indexesEnd <- c(2, 4, 3)
for (i in 1:nrow(df)) df[i, indexesStart[i]:indexesEnd[i]] <- 1
df
Here is another technique using a twocolumn matrix as index:
I <- do.call(rbind, lapply(1:length(indexesStart), function(i) cbind(i, indexesStart[i]:indexesEnd[i])))
df[I] <- 1
In the second variant I hided the loop (and the hidden loop is in another place).
Try this, it avoids any looping or lapply and is vectorized. This takes advantage of the fact that a data.frame is really a list.
impute <- function(lst, start, end){ lst[start:end] <- 1; lst }
fill <- function(df, start, end){
cols <- names(df)
lst <- as.list(as.data.frame(t(df)))
res <- as.data.frame(t(Vectorize(impute)(lst, start, end)))
names(res) <- names(df)
row.names(res) <- row.names(df)
res
}
res <- fill(df, indexesStart, indexesEnd)
Takes around 5 seconds to do 1 million rows on my MacBook Pro.
Related
I have a dataframe with two variables (start,end). would like to create an identifier variable which grows in ascending order of start and, most importantly, is kept constant if the value of start coincides with end of any other row in the dataframe.
Below is a simple example of the data
toy_data <- data.frame(start = c(1,5,6,10,16),
end = c(10,9,11,15,17))
The output I would be looking for is the following:
output_data <- data.frame(start = c(1,10,5,6,16),
end = c(10,15,9,11,17),
NEW_VAR = c(1,1,2,3,4))
You could try adapting this answer to group by ranges that are adjacent to each other. Credit goes entirely to #r2evans.
In this case, you would use expand.grid to get combinations of start and end. Instead of labels you would have row numbers rn to reference.
In the end, you can number the groups based on which rows appear together in the list. The last few lines starting with enframe use tibble/tidyverse. To match the group numbers I resorted the results too.
I hope this might be helpful.
library(tidyverse)
toy_data <- data.frame(start = c(1,5,6,10,16),
end = c(10,9,11,15,17))
toy_data$rn = 1:nrow(toy_data)
eg <- expand.grid(a = seq_len(nrow(toy_data)), b = seq_len(nrow(toy_data)))
eg <- eg[eg$a < eg$b,]
together <- cbind(
setNames(toy_data[eg$a,], paste0(names(toy_data), "1")),
setNames(toy_data[eg$b,], paste0(names(toy_data), "2"))
)
together <- subset(together, end1 == start2)
groups <- split(together$rn2, together$rn1)
for (i in toy_data$rn) {
ind <- (i == names(groups)) | sapply(groups, `%in%`, x = i)
vals <- groups[ind]
groups <- c(
setNames(list(unique(c(i, names(vals), unlist(vals)))), i),
groups[!ind]
)
}
min_row <- as.numeric(sapply(groups, min))
ctr <- seq_along(groups)
lapply(ctr[order(match(min_row, ctr))], \(x) toy_data[toy_data$rn %in% groups[[x]], ]) %>%
enframe() %>%
unnest(col = value) %>%
select(-rn)
Output
name start end
<int> <dbl> <dbl>
1 1 1 10
2 1 10 15
3 2 5 9
4 3 6 11
5 4 16 17
The following function should give you the desired identifier variable NEW_VAR.
identifier <- \(df) {
x <- array(0L, dim = nrow(df))
count <- 0L
my_seq <- seq_len(nrow(df))
for (i in my_seq) {
if(!df[i,]$start %in% df$end) {
x[i] <- my_seq[i] + count
} else {
x[i] <- my_seq[i]-1L + count
count <- count - 1L
}
}
x
}
Examples
# your example
toy_data <- data.frame(start = c(1,10,5,6,16),
end = c(10,15,9,11,17))
toy_data$NEW_VAR <- identifier(toy_data)
# ---------------------
> toy_data$NEW_VAR
[1] 1 1 2 3 4
# other example
toy_data <- data.frame(start = c(1, 2, 2, 4, 16, 21, 18, 3),
end = c(16, 2, 21, 2, 2, 2, 3, 1))
toy_data$NEW_VAR <- identifier(toy_data)
# ---------------------
> toy_data$NEW_VAR
[1] 0 0 0 1 1 1 2 2
I have a data.table with 1000+ binary columns, but a simple example is:
dt <- data.table(one=c(1,1,0), two=c(0,0,1), three=c(1,1,0), four=c(1,1,1))
I want to count the number of times each combination of a predefined number of columns all are equal to 1. So for example if I wanted to count the "1" matches between every 2 columns, I could do:
a <- combn(names(dt),2)[1,]
b <- combn(names(dt),2)[2,]
for(i in 1:length(a)){
print(c(a[i], b[i], dt[get(a[i])==1 & get(b[i])==1,.N]))
}
I want to vary the number of columns that are combined and I need an efficient way to do this.
I can solve that with eval(parse()) like this:
n <- 3 # number of columns to combine
for(i in 1:n){assign(paste0("a", i), combn(names(dt),n)[i,])}
for(i in 1:length(a1)){
expr1 <- paste0("c(",paste0(rep("a", n), 1:n, "[i]", collapse=","), ")")
expr2 <- paste0("dt[",paste0("get(",rep("a", n), 1:n, ")", sep=" ==TRUE ", collapse = " & "),",.N]")
print(c(eval(parse(text=expr1)), eval(parse(text=expr2))))
}
Nevertheless, a microbenchmarking test on the simple code above shows that get() is about 5 times faster than eval(parse()).
What is an efficient way to do that?
Use the indicated all1 as a function in combn:
k <- 3
DF <- as.data.frame(dt)
all1 <- combn(names(DF), k, function(x) sum(apply(DF[, x] == 1, 1, all)))
data.frame(t(combn(names(DF), k)), all1)
giving:
X1 X2 X3 all1
1 one two three 0
2 one two four 0
3 one three four 2
4 two three four 0
Here is an idea,
sapply(combn(dt, 3, simplify = FALSE), function(i){
v1 <- sum(rowSums(i) == ncol(i));
setNames(v1, paste(names(i), collapse = '-'))
})
# one-two-three one-two-four one-three-four two-three-four
# 0 0 2 0
I've looked at R create a vector from conditional operation on matrix, and using a similar solution does not yield what I want (and I'm not sure why).
My goal is to evaluate df with the following condition: if df > 2, df -2, else 0
Take df:
a <- seq(1,5)
b <- seq(0,4)
df <- cbind(a,b) %>% as.data.frame()
df is simply:
a b
1 0
2 1
3 2
4 3
5 4
df_final should look like this after a suitable function:
a b
0 0
0 0
1 0
2 1
3 2
I applied the following function with the result, and I'm not sure why it doesn't work (further explanation of a solution would be appreciated)
apply(df,2,function(df){
ifelse(any(df>2),df-2,0)
})
Yielding the following:
a b
-1 -2
Thank you SO community!
Let's fix your function and understand why it didn't work:
apply(df, # apply to df
2, # to each *column* of df
function(df){ # this function. Call the function argument (each column) df
# (confusing because this is the same name as the data frame...)
ifelse( # Looking at each column...
any(df > 2), # if there are any values > 2
df - 2, # then df - 2
0 # otherwise 0
)
})
any() returns a single value. ifelse() returns something the same shape as the test, so by making your test any(df > 2) (a single value), ifelse() will also return a single value.
Let's fix this by (a) changing the function to be of a different name than the input (for readability) and (b) getting rid of the any:
apply(df, # apply to df
2, # to each *column* of df
function(x){ # this function. Call the function argument (each column) x
ifelse( # Looking at each column...
x > 2, # when x is > 2
df - 2, # make it x - 2
0 # otherwise 0
)
})
apply is made for working on matrices. When you give it a data frame, the first thing it does is convert it to a matrix. If you want the result to be a data frame, you need to convert it back to a data frame.
Or we can use lapply instead. lapply returns a list, and by assigning it to the columns of df with df[] <- lapply(), we won't need to convert. (And since lapply doesn't do the matrix conversion, it knows by default to apply the function to each column.)
df[] <- lapply(df, function(x) ifelse(x > 2, x - 2, 0))
As a side note, df <- cbind(a,b) %>% as.data.frame() is a more complicated way of writing df <- data.frame(a, b)
Create the 'out' dataset by subtracting 2, then replace the values that are based on a logical condition to 0
out <- df - 2
out[out < 0] <- 0
Or in a single step
(df-2) * ((df - 2) > 0)
Using apply
a <- seq(1,5)
b <- seq(0,4)
df <- cbind(a,b) %>% as.data.frame()
new_matrix <- apply(df, MARGIN=2,function(i)ifelse(i >2, i-2,0))
new_matrix
###if you want it to return a tibble/df
new_tibble <- apply(df, MARGIN=2,function(i)ifelse(i >2, i-2,0)) %>% as_tibble()
I have the following data frame
df <- data.frame(col1 = c(0,0,1,1),col2 = c(1,0,0,3),col2 = c(1,0,0,3))
How can I identify the the first value of each value which is greater than 0.
The expected output is like this
df <- data.frame(col1 = c(0,0,1,1),col2 = c(1,0,0,3),col3 = c(1,0,0,3),col4 = c(1,0,1,1))
And I have tried the followings
for (i in 1:3){
df$col4 <- apply(df[,c(0:i)],1,sum)
if (df$col4>0)
break
}
We can use max.col() for this.
df[cbind(1:nrow(df), max.col(df > 0, "first"))]
# [1] 1 0 1 1
df$col4 <- apply(df, 1, function(x) x[which(x>0)[1]])
df[is.na(df$col4),'col4'] <- 0
Here is another idea using mapply,
unlist(mapply(`[`, split(df, 1:nrow(df)), max.col(df>0, ties.method = 'first')))
#1.col2 2.col1 3.col1 4.col1
# 1 0 1 1
Depending on what you need by 'count backward', you can either change ties.method to 'last', i.e.
unlist(mapply(`[`, split(df, 1:nrow(df)), max.col(df>0, ties.method = 'last')))
#1.col2.1 2.col2.1 3.col1 4.col2.1
# 1 0 1 3
Or reverse the data frame and leave ties.method to 'first', i.e.
unlist(mapply(`[`, split(rev(df), 1:nrow(df)), max.col(df>0, ties.method = 'first')))
# 1.col2 2.col2.1 3.col2.1 4.col2.1
# 1 0 0 3
Situation
I have two data frames, df1 and df2with the same column headings
x <- c(1,2,3)
y <- c(3,2,1)
z <- c(3,2,1)
names <- c("id","val1","val2")
df1 <- data.frame(x, y, z)
names(df1) <- names
a <- c(1, 2, 3)
b <- c(1, 2, 3)
c <- c(3, 2, 1)
df2 <- data.frame(a, b, c)
names(df2) <- names
And am performing a merge
#library(dplyr) # not needed for merge
joined_df <- merge(x=df1, y=df2, c("id"),all=TRUE)
This gives me the columns in the joined_df as id, val1.x, val2.x, val1.y, val2.y
Question
Is there a way to co-locate the columns that had the same heading in the original data frames, to give the column order in the joined data frame as id, val1.x, val1.y, val2.x, val2.y?
Note that in my actual data frame I have 115 columns, so I'd like to stay clear of using joned_df <- joined_df[, c(1, 2, 4, 3, 5)] if possible.
Update/Edit: also, I would like to maintain the original order of column headings, so sorting alphabetically is not an option (-on my actual data, I realise it would work with the example I have given).
My desired output is
id val1.x val1.y val2.x val2.y
1 1 3 1 3 3
2 2 2 2 2 2
3 3 1 3 1 1
Update with solution for general case
The accepted answer solves my issue nicely.
I've adapted the code slightly here to use the original column names, without having to hard-code them in the rep function.
#specify columns used in merge
merge_cols <- c("id")
# identify duplicate columns and remove those used in the 'merge'
dup_cols <- names(df1)
dup_cols <- dup_cols [! dup_cols %in% merge_cols]
# replicate each duplicate column name and append an 'x' and 'y'
dup_cols <- rep(dup_cols, each=2)
var <- c("x", "y")
newnames <- paste(dup_cols, ".", var, sep = "")
#create new column names and sort the joined df by those names
newnames <- c(merge_cols, newnames)
joined_df <- joined_df[newnames]
How about something like this
numrep <- rep(1:2, each = 2)
numrep
var <- c("x", "y")
var
newnames <- paste("val", numrep, ".", var, sep = "")
newdf <- cbind(joined_df$id, joined_df[newnames])
names(newdf)[1] <- "id"
Which should give you the dataframe like this
id val1.x val1.y val2.x val2.y
1 1 3 1 3 3
2 2 2 2 2 2
3 3 1 3 1 1