Удаление подэлементов из списка, который появляется в другом списке подэлементов в R - PullRequest
0 голосов
/ 03 июля 2018

У меня есть два списка матрицы

lst1 <- lapply(1:4, function(i) combn(x=4,m=i))
lst2 <- lapply(1:5, function(i) combn(x=5,m=i))

и хотел бы извлечь столбцы для матрицы во 2-м списке, которых нет в столбцах матрицы в первом списке. Можете ли вы помочь, пожалуйста?

например.

Я хотел бы получить этот список ниже

[[1]]
     [,5]
[1,]    5

[[2]]
     [,4] [,7] [,9] [,10]
[1,]    1    2    3     4
[2,]    5    5    5     5

[[3]]
    [,3] [,5] [,6] [,8] [,9] [,10]
[1,]   1    1    1    2    2     3
[2,]   2    3    4    3    4     4
[3,]   5    5    5    5    5     5

[[4]]
    [,2] [,3] [,4] [,5]
[1,]   1    1    1    2
[2,]   2    2    3    3
[3,]   3    4    4    4
[4,]   5    5    5    5

[[5]]
     [,1]
[1,]    1
[2,]    2
[3,]    3
[4,]    4
[5,]    5

Ответы [ 4 ]

0 голосов
/ 03 июля 2018

Это должно работать:

foo  <-  function(z,w) w[,!apply(matrix(apply(w,2,function(y) apply(z, 2, 
function(x) identical(x, y))), nrow=ncol(z)),2,any)]

mapply(foo, lst1,lst2)
0 голосов
/ 03 июля 2018

Использование базы R:

Map(function(x,y)as.matrix(unname(setdiff(data.frame(y),data.frame(x)))),c(lst1,NA),lst2) 

[[1]]
  [,1]
1    5

[[2]]
  [,1] [,2] [,3] [,4]
1    1    2    3    4
2    5    5    5    5

[[3]]
  [,1] [,2] [,3] [,4] [,5] [,6]
1    1    1    1    2    2    3
2    2    3    4    3    4    4
3    5    5    5    5    5    5

[[4]]
  [,1] [,2] [,3] [,4]
1    1    1    1    2
2    2    2    3    3
3    3    4    4    4
4    5    5    5    5

[[5]]
  [,1]
1    1
2    2
3    3
4    4
5    5

или вы можете сделать

purrr::map2(c(lst1,NA),lst2,~as.matrix(unname(setdiff(data.frame(.y),data.frame(.x)))))

[[1]]
     [,1]
[1,]    5

[[2]]
     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4
[2,]    5    5    5    5

[[3]]
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    1    1    2    2    3
[2,]    2    3    4    3    4    4
[3,]    5    5    5    5    5    5

[[4]]
     [,1] [,2] [,3] [,4]
[1,]    1    1    1    2
[2,]    2    2    3    3
[3,]    3    4    4    4
[4,]    5    5    5    5

[[5]]
     [,1]
[1,]    1
[2,]    2
[3,]    3
[4,]    4
[5,]    5
0 голосов
/ 03 июля 2018

Вот еще одна base R опция

fpaste <- function(x) tapply(x, col(x), toString)
fun1 <- Vectorize(function(x, y) x[,!fpaste(x) %in% fpaste(y), drop = FALSE])
m1 <- outer(lst2, lst1, FUN = fun1)
c(diag(m1), m1[length(m1)])
#[[1]]
#     [,1]
#[1,]    5

#[[2]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    2    3    4
#[2,]    5    5    5    5

#[[3]]
#     [,1] [,2] [,3] [,4] [,5] [,6]
#[1,]    1    1    1    2    2    3
#[2,]    2    3    4    3    4    4
#[3,]    5    5    5    5    5    5

#[[4]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    1    1    2
#[2,]    2    2    3    3
#[3,]    3    4    4    4
#[4,]    5    5    5    5

#[[5]]
#     [,1]
#[1,]    1
#[2,]    2
#[3,]    3
#[4,]    4
#[5,]    5
0 голосов
/ 03 июля 2018

Как насчет следующего

lapply(lst2, function(x) Filter(Negate(is.null), lapply(lst1, function(y)
    if (nrow(x) == nrow(y)) x[, !apply(x, 2, toString) %in% apply(y, 2, toString)])))
#[[1]]
#[[1]][[1]]
#[1] 5
#
#
#[[2]]
#[[2]][[1]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    2    3    4
#[2,]    5    5    5    5
#
#
#[[3]]
#[[3]][[1]]
#     [,1] [,2] [,3] [,4] [,5] [,6]
#[1,]    1    1    1    2    2    3
#[2,]    2    3    4    3    4    4
#[3,]    5    5    5    5    5    5
#
#
#[[4]]
#[[4]][[1]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    1    1    2
#[2,]    2    2    3    3
#[3,]    3    4    4    4
#[4,]    5    5    5    5
#
#
#[[5]]
#list()

Для каждой записи в lst2 мы проверяем уникальные столбцы из всех записей в lst1. Следовательно, длина вывода list равна длине lst2, что позволяет легко идентифицировать записи из lst2, у которых нет уникальных столбцов с записями из lst1 (как в случае пятой записи из lst2).


Обновление

К точно воспроизведите ожидаемый результат, который вы можете сделать

lst <- lapply(lst2, function(x) Filter(Negate(is.null), lapply(lst1, function(y)
    if (nrow(x) == nrow(y)) x[, !apply(x, 2, toString) %in% apply(y, 2, toString)])))

lst <- unlist(lapply(seq_along(lst), function(i)
    if (length(lst[[i]]) == 0) lst[[i]] <- list(lst2[[i]]) else lst[[i]]), recursive = F)
lst;
#[[1]]
#[1] 5
#
#[[2]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    2    3    4
#[2,]    5    5    5    5
#
#[[3]]
#     [,1] [,2] [,3] [,4] [,5] [,6]
#[1,]    1    1    1    2    2    3
#[2,]    2    3    4    3    4    4
#[3,]    5    5    5    5    5    5
#
#[[4]]
#     [,1] [,2] [,3] [,4]
#[1,]    1    1    1    2
#[2,]    2    2    3    3
#[3,]    3    4    4    4
#[4,]    5    5    5    5
#
#[[5]]
#     [,1]
#[1,]    1
#[2,]    2
#[3,]    3
#[4,]    4
#[5,]    5
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...