Question

Я хотел бы найти разумный метод для обнаружения и выбора «принципиальных» текстовых столбцов данных из моих data.frames.

В этих столбцах содержатся открытые ответы на опросы, поэтому они содержат разнородные строки, состоящие в основном из буквенных символов. В идеале этот метод

удаляет все множители, цифры c, дату и логические столбцы
удаляет малонаселенные текстовые столбцы
удаляет текстовые столбцы с несколькими уникальные элементы
смогут работать с нестандартными символами

Вот оригинальный пример того, чего я хотел бы достичь:

Оригинал входные данные

   v1   v2   v3   v4   v5 v6 v7 v8     v9 v10 v11 v12 v13   v14
1  Na   Gu   Rx   Ll bird  a  a  1 88,626   1   1   ç   a  TRUE
2  Ue   Ho   Iy <NA> bird  b  b  2 48,666   2   2   é   b FALSE
3  Vk   Lv <NA> <NA> bird  a  c  3 12,559   3   1   ë   ç  TRUE
4  Pd   Hk <NA> <NA> bird  b  d  4  3,794   4   2   õ   d FALSE
5  Ay   Nd <NA> <NA> <NA>  a  e  5 75,239   5   1   ï   é  TRUE
6  Xj <NA> <NA> <NA> <NA>  b  a  6 44,559   6   2   í   f FALSE
7  Zn <NA> <NA> <NA> <NA>  a  b  7 21,100   7   1   ð   g  TRUE
8  Mw <NA> <NA> <NA> <NA>  b  c  8  7,790   8   2   ø   h FALSE
9  Yx <NA> <NA> <NA> <NA>  a  d  9 84,470   9   1   ö   i  TRUE
10 Oj <NA> <NA> <NA> <NA>  b  e 10 45,724  10   2   ò   j FALSE

Исходный желаемый вывод (с ошибками, см. Обновление ниже)

    v1   v2 v7 v12 v13
1  Na   Gu  a   c   a
2  Ue   Ho  b   e   b
3  Vk   Lv  c   e   c
4  Pd   Hk  d   o   d
5  Ay   Nd  e   i   e
6  Xj <NA>  a   i   f
7  Zn <NA>  b   d   g
8  Mw <NA>  c   o   h
9  Yx <NA>  d   o   i
10 Oj <NA>  e   o   j

Вот код для исходных входных данных:

# made-up data
df <- data.frame(stringsAsFactors = F,
  v1 = paste0(sample(LETTERS, 10, replace = T), sample(letters, 10, replace = T)),
  v2 = c(paste0(sample(LETTERS, 5, replace = T), sample(letters, 5, replace = T)), rep(NA, 5)),
  v3 = c(paste0(sample(LETTERS, 2, replace = T), sample(letters, 2, replace = T)), rep(NA, 8)),
  v4 = c(paste0(sample(LETTERS, 1, replace = T), sample(letters, 1, replace = T)), rep(NA, 9)),
  v5 = c(rep("bird", 4), rep(NA, 6)),
  v6 = factor(rep(c("a", "b"), 5)),
  v7 = rep(c("a", "b", "c", "d", "e"),2),
  v8 = 1:10,
  v9 = paste0(sample(1:99, 10, replace =T), ",", sample(1:999, 10, replace =T)),
  v10 = as.character(1:10),
  v11 = factor(rep(c(1, 2), 5)),
  v12 = c('ç','é','ë','õ','ï','í','ð','ø','ö','ò'),
  v13 = c('a','b', 'ç','d',' é',letters[6:10]),
  v14 = as.logical(rep(c("TRUE", "FALSE"), 5)))

До сих пор я был в состоянии выделить векторы символов

df <- df[, sapply(df, is.character)]

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

df[] <- lapply(df, stringi::stri_trans_general, "Latin-ASCII")

Но я пытаюсь найти разумное / надежное решение для удаления малонаселенных (например, v3 и v4), высокоповторных (например, v5) или потенциальных чисел c, отформатированных в виде символов (например, v9 и v10). ). Какой хороший подход?

Обновление

Получив полезный ответ и комментарий от @Matias Andina, я пришел к выводу, что мои исходные входные данные были ошибочными, потому что 10 строк данных было недостаточно, чтобы правильно отразить мою цель удаления текстовых столбцов с «несколькими уникальными элементами». Итак, вот второй пример, показывающий первые двадцать строк для ввода и желаемого вывода. В соответствии с моим первоначальным вопросом, описанным в начале этого поста, цель состоит в том, чтобы отбросить все столбцы «d» и сохранить столбцы «k». Матиас заслуживает похвалы, за его ответ уже обращается d3-d9.

Дополнительные входные данные

 k1 k2  k3  d1  d2      d3     d4   d5  d6  d7  d8      d9
Ze  E,w h,Y c   bird   12,36    b   38  38  2   FALSE   18/03/2020
Gr  Y,y w,J d   NA     88,510   b   54  54  2   FALSE   3/04/2020
Ze  J,x w,G e   bird   26,932   b   30  30  2   FALSE   10/03/2020
Nt  V,u a,A d   bird    8,660   a   19  19  1   TRUE    28/02/2020
Bn  W,l z,O c   bird   19,684   a   3   3   1   TRUE    12/02/2020
Km  L,c h,d a   bird    8,649   b   16  16  2   FALSE   25/02/2020
Lx  N,e s,H d   NA     92,838   b   84  84  2   FALSE   3/05/2020
Vv  R,s m,b e   bird   58,793   b   40  40  2   FALSE   20/03/2020
El  A,h i,E d   bird   61,589   b   44  44  2   FALSE   24/03/2020
Az  B,b n,é c   NA     45,11    b   58  58  2   FALSE   7/04/2020
Tq  J,y w,N b   NA     81,288   b   82  82  2   FALSE   1/05/2020
Lg  Z,l h,I c   NA     17,418   b   88  88  2   FALSE   7/05/2020
Oh  F,b e,Q a   NA     28,887   a   71  71  1   TRUE    20/04/2020
Rj  I,f ç,F b   NA     59,213   a   97  97  1   TRUE    16/05/2020
Pw  X,u n,Z b   bird   51,622   b   42  42  2   FALSE   22/03/2020
Dv  A,d l,X c   bird   29,148   b   18  18  2   FALSE   27/02/2020
Hp  C,o w,Z d   bird   78,737   b   24  24  2   FALSE   4/03/2020
Br  D,i b,a e   NA     35,231   a   65  65  1   TRUE    14/04/2020
Re  X,g b,O b   NA     18,244   b   92  92  2   FALSE   11/05/2020

Исправлено желаемое значение

k1  k2  k3  
Ze  E,w h,Y 
Gr  Y,y w,J 
Ze  J,x w,G 
Nt  V,u a,A 
Bn  W,l z,O 
Km  L,c h,d 
Lx  N,e s,H 
Vv  R,s m,b 
El  A,h i,E 
Az  B,b n,é 
Tq  J,y w,N 
Lg  Z,l h,I 
Oh  F,b e,Q 
Rj  I,f ç,F 
Pw  X,u n,Z 
Dv  A,d l,X 
Hp  C,o w,Z 
Br  D,i b,a 
Re  X,g b,O

Вот код для дополнительных входных данных:

set.seed(8)

df <- data.frame(stringsAsFactors = F, 
  k1 = paste0(sample(LETTERS, 100, replace = T), sample(letters, 100, replace = T)),
  k2 = paste0(sample(LETTERS, 100, replace = T), ",", sample(letters, 100, replace = T)),
  k3 = paste0(sample(c('a','b', 'ç','d',' é',letters), 100, replace = T), ",",
    sample(c('a','b', 'ç','d',' é', LETTERS), 100, replace = T)),
  d1 = rep(c("a", "b", "c", "d", "e"),20),
  d2 = c(rep("bird", 51), rep(NA, 49)),
  d3 = paste0(sample(1:99, 100, replace =T), ",", sample(1:999, 100, replace =T)),
  d4 = factor(rep(c("a", "b"), 50)),
  d5 = 1:100,
  d6 = as.character(1:100),
  d7 = factor(rep(c(1, 2), 10)),
  d8 = as.logical(rep(c("TRUE", "FALSE"), 50)),
  d9 = seq(from = as.Date("2020-02-10"), to = as.Date("2020-02-10") + 99, by = 'day'))

df <- df[sample(nrow(df)),]

Matias Andina · Answer 1 · 10 февраля 2020

Это может взорваться в ваших реальных данных, но я думаю, что это может быть связано с.

library(tidyverse)
step_one <- df %>% 
  # change the commas for dots (may explode if you actually have commas)
  mutate_if(.predicate = function(x) is.character(x),
            .funs = function(x) stringr::str_replace_all(x, ",", ".")) %>%
  select_if(.predicate =  function(x) is.character(x) && is.na(as.numeric(x)) == TRUE && is.logical(x) == FALSE) %>% 
  mutate_all(.funs = function(x) stringi::stri_trans_general(x, "Latin-ASCII"))


step_one %>%
  summarise_each(funs = function(x) sum(is.na(x))) %>%
  reshape2::melt() %>%
  mutate(variable = as.character(variable),
         total_cases = nrow(df),
         frac = value/total_cases,
# --->>> arbitrary 0.5 threshold <<<<----
         sparse = ifelse(frac>0.5, "remove", "keep")) %>%
  filter(sparse == "keep") %>%
  pull(variable) -> variables_to_keep

df %>% select(variables_to_keep)

, который производит

   v1   v2 v7 v12 v13
1  Bq   Um  a   ç   a
2  Tb   Aq  b   é   b
3  Wv   Cf  c   ë   ç
4  Mf   Sl  d   õ   d
5  Ou   Ah  e   ï   é
6  Ag <NA>  a   í   f
7  Rl <NA>  b   ð   g
8  Mw <NA>  c   ø   h
9  Kj <NA>  d   ö   i
10 Bd <NA>  e   ò   j

или

step_one %>% select(variables_to_keep)
   v1   v2 v7 v12 v13
1  Bq   Um  a   c   a
2  Tb   Aq  b   e   b
3  Wv   Cf  c   e   c
4  Mf   Sl  d   o   d
5  Ou   Ah  e   i   e
6  Ag <NA>  a   i   f
7  Rl <NA>  b   d   g
8  Mw <NA>  c   o   h
9  Kj <NA>  d   o   i
10 Bd <NA>  e   o   j

ОБНОВЛЕНИЕ

Я думаю, что это должно приблизить вас к тому, что вы хотите go ...

remove_high_repetition_variables <- function(df){
  tallies <- df %>%
    purrr::map(function(tt) as.data.frame(table(tt))) %>%
    purrr::map(function(tt) mutate(tt,
                                  unique_values = length(tt),
                                  total = sum(Freq),
                                  highly_rep = total/unique_values,
                                  representation = Freq/total,
   # Your thresholds here
   # 100-element vector had only 20 unique values or less
                                  flag = ifelse(highly_rep > 100/20, "remove", "keep"))) %>%
  purrr::map(function (tt) any(pull(tt, flag) == "remove"))

 if (any(tallies == TRUE)){
   return(names(tallies[tallies == FALSE]))  
 } else {
   return(names(tallies))
 }

}

Предполагается, что использование будет с dplyr::select

remove_high_repetition_variables(step_two)
[1] "k1" "k2" "k3"
remove_high_repetition_variables(mtcars)
[1] "mpg"  "disp" "hp"   "drat" "wt"   "qsec"

таким образом, что вы можете получить то, что вы хотите

step_two %>% select(remove_high_repetition_variables(.)

Winnow data.frame к основным текстовым столбцам?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

ОБНОВЛЕНИЕ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Winnow data.frame к основным текстовым столбцам?

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

ОБНОВЛЕНИЕ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов