Передовая dataframe на основе одной колонки - в обратном порядке

Question

Я задал этот вопрос некоторое время назад (Recode dataframe based on one column), и ответ работал отлично. Теперь, однако, я почти хочу сделать обратное. А именно, у меня есть (700k * 2000) 0/1/2 или NA. В отдельном фрейме данных у меня есть две колонки (Ref и Obs). 0 соответствует двум экземплярам Ref, 1 - один экземпляр Ref и один экземпляр Obs и 2 - два Obs. Для уточнения, фрагмент данных:

Genotype File --- 
Ref Obs 
A G   
T C 
G C 
Ref <- c("A", "T", "G") 
Obs <- c("G", "C", "C") 

Current Data--- 
Sample.1  Sample.2 .... Sample.2000 
0    1    2 
0    0    0 
0    NA    1 

mat <- matrix(nrow=3, ncol=3) 
mat[,1] <- c(0,0,0) 
mat[,2] <- c(1,0,NA) 
mat[,3] <- c(2,0,1) 

Desired Data format--- 
Sample.1 Sample.1 Sample.2 Sample.2 Sample.2000 Sample.2000 
    A   A   A   G   G    G 
    T   T   T   T   T    T 
    G   G   0   0   G    C 

Я думаю, что это правильно. Желаемый формат данных имеет два столбца (пробел разделен) для каждого образца. 0 в этом формате (файл plink ped для биоинформатистов там отсутствует) отсутствуют данные.

Answer 1

MAJOR УСЛОВИЕ: ваши данные в 3-х элементов кадров, то есть вы хотите применить ваше сопоставление к первым 3 строкам, затем к следующим 3 и т. д., которые, я думаю, имеют смысл, учитывая рамки ДНК. Если вы хотите, чтобы окно с катящимся 3-мя элементами не работало (но код может быть изменен, чтобы заставить его работать). Это будет работать для произвольного количества столбцов и произвольного числа из трех групп строк:

# Make up a matrix with your properties (4 cols, 6 rows) 

col <- 4L 
frame <- 3L 
mat <- matrix(sample(c(0:2, NA_integer_), 2 * frame * col, replace=T), ncol=col) 

# Mapping data 

Ref <- c("A", "T", "G") 
Obs <- c("G", "C", "C") 
map.base <- cbind(Ref, Obs) 
num.to.let <- matrix(c(1, 1, 1, 2, 2, 2), byrow=T, ncol=2) # how many from each of ref obs 

# Function to map 0,1,2,NA to Ref/Obs 

re_map <- function(mat.small) { # 3 row matrices, with col columns 
    t(
    mapply(      # iterate through each row in matrix 
     function(vals, map, num.to.let) { 
     vals.2 <- unlist(lapply(vals, function(x) map[num.to.let[x + 1L, ]])) 
     ifelse(is.na(vals.2), 0, vals.2) 
     }, 
     vals=split(mat.small, row(mat.small)), # a row 
     map=split(map.base, row(map.base)),  # the mapping for that row 
     MoreArgs=list(num.to.let=num.to.let) # general conversion of number to Obs/Ref 
)) 
} 
# Split input data frame into 3 row matrices (assumes frame size 3), 
# and apply mapping function to each group 

mat.split <- split.data.frame(mat, sort(rep(1:(nrow(mat)/frame), frame))) 
mat.res <- do.call(rbind, lapply(mat.split, re_map)) 
colnames(mat.res) <- paste0("Sample.", rep(1:ncol(mat), each=2)) 
print(mat.res, quote=FALSE) 
# Sample.1 Sample.1 Sample.2 Sample.2 Sample.3 Sample.3 Sample.4 Sample.4 
# 1 G  G  A  G  G  G  G  G  
# 2 C  C  0  0  T  C  T  C  
# 3 0  0  G  C  G  G  G  G  
# 1 A  A  A  A  A  G  A  A  
# 2 C  C  C  C  T  C  C  C  
# 3 C  C  G  G  0  0  0  0  

Answer 2

Я не уверен, но это может быть то, что вам нужно:

первые же простые данные

geno <- data.frame(Ref = c("A", "T", "G"), Obs = c("G", "C", "C")) 
data <- data.frame(s1 = c(0,0,0),s2 = c(1, 0, NA)) 

потом пару функций:

f <- function(i , x, geno){ 
    x <- x[i] 
    if(!is.na(x)){ 
    if (x == 0) {y <- geno[i , c(1,1)]} 
    if (x == 1) {y <- geno[i, c(1,2)]} 
    if (x == 2) {y <- geno[i, c(2,2)]} 
    } 
    else y <- c(0,0) 
    names(y) <- c("s1", "s2") 
    y 
} 

g <- function(x, geno){ 
Reduce(rbind, lapply(1:length(x), FUN = f , x = x, geno = geno)) 
} 

Путь F() является может быть не самым элегантным, но он выполняет работу

Затем просто запустите его как doble для цикла в lapply моды

as.data.frame(Reduce(cbind, lapply(data , g , geno = geno))) 

надеюсь, что это помогает

Answer 3

Вот один из способов на основе выборочных данных в вашем ответе:

# create index 
idx <- lapply(data, function(x) cbind((x > 1) + 1, (x > 0) + 1)) 

# list of matrices 
lst <- lapply(idx, function(x) { 
    tmp <- apply(x, 2, function(y) geno[cbind(seq_along(y), y)]) 
    replace(tmp, is.na(tmp), 0) 
    }) 

# one data frame 
as.data.frame(lst) 

# s1.1 s1.2 s2.1 s2.2 
# 1 A A A G 
# 2 T T T T 
# 3 G G 0 0