简体   繁体   中英

Subsetting a data frame based on another data frame with multiple conditions

I have a list of methylation array data frame as shown below called betatable :

sample_A sample_B ... chr    position
0.5      0.3          chr1   75939
0.3      0.6          chr2   11195
...

I want to subset the above data frame and generate another data frame, by specific conditions of chr and range of position. For the purpose I have another set of data genes_pos :

gene   chr    range_lower   range_upper
ABC    chr1   34959         69593
...

I was thinking about using lapply but couldn't figure it out. Many thanks in advance.

In this example, you could use dplyr::inner_join

reproducible example:

set.seed(123)
x <- data.frame(x = sample(1:100, 100, replace = TRUE), y = sample(1:100, 100, replace = TRUE), chr = sample(c("chr1", "chr2", "chr3"), 100, replace = T), Position = sample(1:10000, 100, replace = TRUE))
genes <- data.frame(gene = c("gene1", "gene2", "gene3"), chr = c("chr1", "chr2", "chr3"), rangelower = c(1, 3000, 6000), rangeupper = c(2999, 5999, 10001))

inner join , then filter by upper and lower limits

library(dplyr)

new_df <- x %>% 
               inner_join(genes, by = "chr") %>% 
               filter(Position < rangeupper, Position > rangelower)

See results:

> head(new_df)
    x  y  chr Position  gene rangelower rangeupper
1  90 61 chr1       83 gene1          1       2999
2  96 94 chr2     3896 gene2       3000       5999
3  90 15 chr3     8029 gene3       6000      10001
4  96 41 chr3     8569 gene3       6000      10001
5 100 22 chr3     7040 gene3       6000      10001
6  66 37 chr1     1039 gene1          1       2999 

Then we can split the dataframe by gene.

list_dfs <- split(new_df, new_df$gene)

One approach is to use a non-equi join .

However, the sample data sets provided by the OP in the now deleted post need to be prepared because the positions were given as factors instead of integers

library(data.table)
# prepare data
setDT(betatable, keep.rownames = "sample.id")
setDT(gene_pos)
# coerce positions from factor to integer
betatable[, pos := as.integer(as.character(pos))]
cols <- c("lower", "upper")
gene_pos[, (cols) := lapply(.SD, function(x) as.integer(as.character(x))), .SDcols = cols]

# non-equi join
betatable[gene_pos, on = .(chr, pos >= lower, pos <= upper), gene := i.gene][!is.na(gene)]
  sample.id probe chr pos gene 1: sample_a 111 chr1 335 geneA 2: sample_c 200 chr2 221 geneB 3: sample_e 228 chr2 230 geneC 

Data as provided by the OP

column <-c("probe","chr","pos")
sample_a <- c("111","chr1","335")
sample_b <- c("115","chr1","380")
sample_c <- c("200","chr2","221")
sample_d <- c("222","chr2","226")
sample_e <- c("228","chr2","230")
betatable <-data.frame(rbind(sample_a,sample_b,sample_c,sample_d,sample_e))
colnames(betatable)<- column

gene_A <- c("geneA","chr1", "120","336")
gene_B <- c("geneB","chr2", "200","222")
gene_C <- c("geneC","chr2", "227","231")
gene_pos <- rbind(gene_A,gene_B,gene_C)
gene_pos <- data.frame(rbind(gene_A,gene_B,gene_C))
colnames(gene_pos)<-c("gene","chr","lower","upper")

betatable
  probe chr pos sample_a 111 chr1 335 sample_b 115 chr1 380 sample_c 200 chr2 221 sample_d 222 chr2 226 sample_e 228 chr2 230 
gene_pos
  gene chr lower upper gene_A geneA chr1 120 336 gene_B geneB chr2 200 222 gene_C geneC chr2 227 231 

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM