Найти переменные, которые встречаются только в одной строке в R - PullRequest
Новая
       18

Найти переменные, которые встречаются только в одной строке в R

2 голосов
/ 10 ноября 2019

Используя BASE R, мне интересно, как ответить на следующий вопрос:

Есть ли какие-либо значения в X или Y, которые встречаются только в одном ряду, но не в других? Если да, выведите мой желаемый вывод ниже. 

f <- data.frame(id = c(rep("AA",4), rep("BB",2), rep("CC",2)), X = c(1,2,2,3,1,4,3,3), 
                                                               Y = c(99,7,8,7,6,7,7,7))

Желаемый вывод: 

list(BB = c(X = 4, Y = 6), AA = c(Y = c(99, 8)))

# $BB
# X Y 
# 4 6 

# $AA
# Y1 Y2  # Would be a plus if shows `Y Y` instead of `Y1 Y2` 
# 99  8

Ответы [ 3 ]

2 голосов
/ 10 ноября 2019

У этого базового подхода есть две большие идеи:

  1. Поскольку нам нужно сравнить все значения, мы должны просто объединить все в одно data.frame.
  2. Созданиеunsplit data.frame long сэкономит нам некоторые дополнительные шаги. 
#/13209047/naiti-peremennye-kotorye-vstrechaytsya-tolko-v-odnoi-stroke-v-r
f <- data.frame(id = c(rep("AA",4), rep("BB",2), rep("CC",2)), X = c(1,2,2,3,1,4,3,3), 
                Y = c(99,7,8,7,6,7,7,7))
m <- split(f, f$id) # Here is `m`

unsplit <- do.call(rbind, c(m, make.row.names = F))
molten <- data.frame(unsplit[, 1, drop = F], stack(unsplit[, -1]))

# res <- subset(molten, !duplicated(values) & !duplicated(values, fromLast = T))
res <- molten[as.logical(ave(molten[['values']], molten[['ind']], FUN = function(x) !duplicated(x) & !duplicated(x, fromLast = T))), ]
#I would stop here
res
#>    id values ind
#> 6  BB      4   X
#> 9  AA     99   Y
#> 11 AA      8   Y
#> 13 BB      6   Y

#to get exact output
res_vector <- res$values
names(res_vector) <- res$ind

split(res_vector, as.character(res$id))
#> $AA
#>  Y  Y 
#> 99  8 
#> 
#> $BB
#> X Y 
#> 4 6

Создано в 2019-11-10 пакетом представлением (v0.3.0)

Вот еще один базовый подход, который может быть менее сложным: 

####Way 1 with rapply
vec <- rapply(lapply(m, '[', mods), I)
unique_vec <- vec[!duplicated(vec) & !duplicated(vec, fromLast = T)]

vec_names <- do.call(rbind, strsplit(names(unique_vec), '.', fixed = T))

names(unique_vec) <- substr(vec_names[, 2], 1, 1) #turns Y1 into Y
split(unique_vec, vec_names[, 1])

###Way 2 with data.frame already do.call(rbind, m)
vec <-   unlist(
  lapply(f[, -1],
         function(x){
           ind <- !duplicated(x) & !duplicated(x, fromLast = T)
           ret <- x[ind]
           names(ret) <- f[ind, 1]
           ret
         } 
  )
)

#this is likely overly simplified:
split(vec, sub('.*\\.', '', names(vec)))

#this leads to exact result
vec_names <- do.call(rbind, strsplit(names(vec), '.', fixed = T))
names(vec) <- vec_names[, 1]

split(vec, vec_names[, 2])

$AA
 Y  Y 
99  8 

$BB
X Y 
4 6

OP вызывает использование table() в подсказке. duplicated() очень производительный: 

unlist(lapply(f[mods], function(y) names(which(table(y) == 1))))
#   X   Y1   Y2   Y3 
# "4"  "6"  "8" "99"

vec
#X.BB Y.AA Y.AA Y.BB 
#   4   99    8    6 

# A tibble: 2 x 13
  expression   min median `itr/sec` mem_alloc
  <bch:expr> <bch> <bch:>     <dbl> <bch:byt>
1 table_meth 321us  336us     2794.    10.3KB
2 dup_meth   132us  136us     7105.    31.7KB

bench::mark(
  table_meth = {unlist(lapply(f[mods], function(y) names(which(table(y) == 1))))},
  dup_meth = {
  #could get slight performance boost with
    #f_id <- f[['id']]
  unlist(
    lapply(f[, -1],
           function(x){
             ind <- !duplicated(x) & !duplicated(x, fromLast = T)
             ret <- x[ind]
             names(ret) <- f[ind, 1]
             #names(ret) <- f_id[ind] 
             ret
           } 
    )
  )}
  , check = F
)

И похожая идея в : 

library(data.table)

molten_dt <- melt(rbindlist(m), id.vars = 'id')
molten_dt[!duplicated(value, by = variable) &
             !duplicated(value, by = variable, fromLast = T)]

И похожая идея в : 

library(dplyr)
library(tidyr)

m%>%
  bind_rows()%>%
  pivot_longer(cols = -id)%>%
  group_by(name)%>%
  filter(!duplicated(value) & !duplicated(value, fromLast = T))%>%
  group_by(id)%>%
  group_split()
0 голосов
/ 10 ноября 2019

Вот тидиверс подход. Я использую вспомогательную функцию вместе с map на вашем неразделенном data.frame f. Однако вам все равно необходимо отдельно указать переменную id и указать переменные, к которым должна применяться функция, в вашем случае все имена столбцов, кроме первого столбца идентификатора (vars = colnames(f)[-1]). Мы могли бы улучшить вспомогательную функцию, включив вызов map и все последующие вызовы функций, чтобы у вас была только одна функция, а аргументами были бы data.frame и ваш столбец id. Но функциональность была бы такой же. 

library(tidyverse)

find_unique <- function(df, x) {
  df %>% 
    group_by(!! sym(x)) %>% 
    filter(n() == 1) %>% 
    select(id, !! sym(x))
}  

vars = colnames(f)[-1]

res <- map_dfr(vars, ~find_unique(f, .x)) %>% 
  ungroup() %>% 
  nest(-id) %>% 
  mutate(data2 = map(data, ~ unlist(.x) %>%
                                enframe %>% 
                                filter(!is.na(value)) %>% 
                                spread(name, value)),
         data2 = set_names(data2, id))
res <- res$data2

# Output looks like this:
res
$BB
# A tibble: 1 x 2
     X1    Y2
  <dbl> <dbl>
1     4     6

$AA
# A tibble: 1 x 2
     Y1    Y2
  <dbl> <dbl>
1    99     8
0 голосов
/ 10 ноября 2019

Это не просто функциональное программирование, но это базовая R: 

lapply(split(df, df$id), function(z){

  X <- z$X[which(!(z$X %in% df$X[duplicated(df$X)]))]

  Y <- z$Y[which(!(z$Y %in% df$Y[duplicated(df$Y)]))]

  cbind(X, Y)

  }

)

Данные: 

    df <-
  structure(list(
    id = structure(
      c(1L, 1L, 1L, 1L, 2L, 2L, 3L, 3L),
      .Label = c("AA", "BB", "CC"),
      class = "factor"
    ),
    X = c(1,
          2, 2, 3, 1, 4, 3, 3),
    Y = c(99, 7, 8, 7, 6, 7, 7, 7)
  ),
  class = "data.frame",
  row.names = c(NA,-8L))
...