rbind, если столбец содержит частичное совпадение R

#r

Вопрос:

У меня есть списки кадров данных, в которых мне удалось успешно просмотреть списки и объединить таблицы по мере необходимости. Я сделал это с помощью чего-то похожего на следующий код:

 anno_files<-c("R1000A_v1.hg19_multianno.txt", "R1000B_v1.hg19_multianno.txt" ,"R1000C_v1.hg19_multianno.txt", "RC1080A_v1.hg19_multianno.txt", "RC1080B_v1.hg19_multianno.txt" )

cancer_files<-c("R1000A_v1.hg19_multianno.txt.cancervar", "R1000B_v1.hg19_multianno.txt.cancervar" ,"R1000C_v1.hg19_multianno.txt.cancervar", "RC1080A_v1.hg19_multianno.txt.cancervar", "RC1080B_v1.hg19_multianno.txt.cancervar")

# extract the sample names from the whole filename
samples<- c()
# Iterate through each filename
for (filename in anno_files) {
  # Pull out the characters prior to the first '.'
  filename_id <- unlist(strsplit(filename, "\."))[1]
  # append to sample_names vector
  samples<- c(samples, filename_id)
}

myfilelist <- lapply(anno_files, read.delim,header=T)
myfilelist2<-lapply(cancer_files, read.csv,sep="t",header=T)

    library(dplyr)
    for (i in 1:length(myfilelist)){
      all_annotation<-left_join(myfilelist[[i]], myfilelist2[[i]], by = c("Chr","Start","End","Ref","Alt"))
      all_annotation$sample_id<-samples[i]
      write.csv(all_annotation, paste("data/",samples[i],".merged.csv",sep = ""))
}
 

Я хотел бы добавить дополнительную строку кода для привязки таблиц, если у них одинаковая первая часть имени файла/имени примера, например, таблицы rbind "R1000A_v1", "R1000B_v1" ,"R1000C_v1" , как они взяты из образца R1000, и rbind "RC1080A_v1", "RC1080B_v1" , как они взяты из образца RC1080

Мне удалось получить список той части имени образца, с которой я хочу сопоставить:

 samples2<- c()
# Iterate through each filename
for (filename in samples) {
  # Pull out the characters prior to the first 'underscore'.'
  filename2_id<-unlist(strsplit(filename, "\_"))[1]
  filename3_id<-substr(filename2_id,1,nchar(filename2_id)-1)
  # append to sample_names vector
  samples2<- unique(c(samples2, filename3_id))
}
samples2
"R1000""RC1080"
 

Итак, теперь в цикле all_annoatation мне нужно сделать что-то вроде:

 for (j in length(samples2)){
if all_annotation$sample_id contains samples2[j] 
rbind
write.csv
} 
 

Ответ №1:

С этим можно легко справиться data.table .

 library(data.table)
 

Вам нужно будет изменить строку чтения csv, чтобы каждый объект загружался в виде таблицы data.table (если ваш csv большой, вы заметите, что это тоже быстро).:

 # myfilelist <- lapply(anno_files, read.delim,header=T)
myfilelist <- lapply(anno_files, function(x) assign(gsub("(.*)(\.txt)", "\1", x), fread(x), .GlobalEnv))

# myfilelist2 <- lapply(cancer_files, read.csv,sep="t",header=T)
myfilelist2 <- lapply(cancer_files, function(x) assign(gsub("(.*)(\.txt\.cancervar)", "\1", x), fread(x), .GlobalEnv))
 

Как только ваши объекты будут созданы, я предположу, что вы знаете, каков шаблон на названии, поэтому вы можете сделать что-то вроде:

 R100_total = rbindlist(lapply(ls(pattern = "R100"), get))
R1080_total = rbindlist(lapply(ls(pattern = "R1080"), get))
 

При условии, что у вас нет других объектов с именами по тому же шаблону, которые вы не хотите rbind .

Комментарии:

1. Как бы я прошел по длинному списку примеров имен, содержащих шаблон? Я включил в пример только 2, но у меня их более 100. Что-то вроде: for (i in 1:length(samples2)){ samples2[i]_total = rbindlist(lapply(ls(pattern = samples2[i]), get)) }

2. Подумайте о том , чтобы избежать assign функции, которая редко используется в R.

3. Спасибо. Что бы вы использовали вместо этого?

Ответ №2:

Я не могу действительно проверить это без всех файлов, но я думаю, что это близко:

 for (j in seq_along(samples2)) {
  all_annotation[grepl(samples2[j], samples)]
    temp <- do.call('rbind', all_annotation[grepl(samples2[j], samples)])
    write.csv(temp, paste0(samples2[j], '.csv'))
  }  
}
 

Ответ №3:

Рассмотрите возможность применения семейных решений ( lapply , sapply , Map которые являются оболочкой mapply ) и избегайте учета, необходимого for для циклов. А для извлечения необходимых образцов используйте функции строкового шаблона gsub и grep . Наконец, запустите do.call и rbind сложите в стопку, как именованные фреймы данных.

 anno_files <- c(
    "R1000A_v1.hg19_multianno.txt",
    "R1000B_v1.hg19_multianno.txt",
    "R1000C_v1.hg19_multianno.txt",
    "RC1080A_v1.hg19_multianno.txt",
    "RC1080B_v1.hg19_multianno.txt" 
)
anno_samples <- sapply(strsplit(anno_files, "\."), `[`, 1)

cancer_files <- c(
    "R1000A_v1.hg19_multianno.txt.cancervar", 
    "R1000B_v1.hg19_multianno.txt.cancervar",
    "R1000C_v1.hg19_multianno.txt.cancervar", 
    "RC1080A_v1.hg19_multianno.txt.cancervar", 
    "RC1080B_v1.hg19_multianno.txt.cancervar"
) 

cancer_samples <- sapply(strsplit(cancer_files, "\."), `[`, 1)

process_data <- function(txt_file, s_id) {
    data.frame(
        sample_id = s_id,        # FIRST COLUMN
        read.delim(txt_file),
        source = txt_file        # LAST COLUMN
    )
} 

anno_dfs <- Map(process_data, anno_files, anno_samples)
cancer_dfs <- Map(process_data, cancer_files, cancer_samples)

merged_dfs <- Map(
    # BASE R LEFT JOIN
    merge(x, y, by=c("Chr","Start","End","Ref","Alt"), all.x=TRUE),
    anno_dfs,
    cancer_dfs
) |> setNames(   # NEW PIPE AS OF R v4.1.0 
    anno_samples
)

roots <- unique(gsub("[A-Z]\_.*$", "", anno_samples))
rbind_dfs <- lapply(
    roots,
    function(r) do.call(
        rbind.data.frame, 
        merged_dfs[grep(r, names(merged_dfs))]
    )
)