меня монстр получился...
rework <- function(a = A, b = B){
add_row_filler <- function(a, b){
not_in_a <- setdiff(rownames(b), rownames(a))
l <- length(not_in_a)
if (l > 0) {
filler <- matrix(rep(NA, ncol(a) * l), nrow = l)
a <- rbind(a, filler)
rownames(a)[(nrow(a) - l + 1):nrow(a)] <- not_in_a
}
a
}
add_col_filler <- function(a, b){
not_in_a <- setdiff(colnames(b), colnames(a))
l <- length(not_in_a)
if (l > 0) {
filler <- matrix(rep(NA, nrow(a) * l), ncol = l)
a <- cbind(a, filler)
colnames(a)[(ncol(a) - l + 1):ncol(a)] <- not_in_a
}
a
}
R <- mapply(add_row_filler, a = list(a, b), b = rev(list(a, b)), SIMPLIFY = FALSE)
R <- mapply(add_col_filler, a = R, b = rev(R), SIMPLIFY = FALSE)
lapply(R, function(x) x[sort(rownames(x)), sort(colnames(x))])
}
Как-то так можно: rework = function(mat1, mat2){ common_rows = sort(union(rownames(mat1), rownames(mat2))) common_cols = sort(union(colnames(mat1), colnames(mat2))) res = matrix(NA, nrow = length(common_rows), ncol = length(common_cols), dimnames = list(common_rows, common_cols) ) res[rownames(mat1), colnames(mat1)] = mat1 res }
Обсуждают сегодня