Отдельная переменная в поле за символом - PullRequest
0 голосов
/ 15 ноября 2018

Я недавно задал этот вопрос Отдельное содержимое поля И получил очень быстрый и очень простой ответ.

Что-то, что я могу сделать просто в Excel, это посмотреть в ячейке, найти первый экземпляр символа и затем вернуть все символы слева от него.

Например

Автор

Дригерс Р.Л., Верхей Ф.Р., Леентженс А.Ф., Калер С., Аалтен П.

Я могу извлечь Drijgers RL и Aalten P в отдельные столбцы в Excel. Это позволяет мне подсчитать, сколько раз кто-то является первым и последним автором.

Как я могу повторить это в R? Я могу посчитать общее количество раз, когда у автора есть публикация, из отдельных строк ответа выше.

Как бы я разделил первых и последних авторов на отдельные столбцы. Это может быть полезно знать. В этом ответе Разделение столбца разделителем справа налево в R

количество столбцов известно. Как сказать «разбить эту строку на запятые и бросить их в неизвестное количество столбцов на основе количества имен в списке авторов справа от исходного поля»?

Ответы [ 2 ]

0 голосов
/ 15 ноября 2018
data.frame(
  authors = c(
    "Drijgers RL, Verhey FR, Leentjens AF, Kahler S, Aalten P.",
    "Drijgers RL, Verhey FR, Leentjens AF, Kahler S",
    "Drijgers RL, Verhey FR, Leentjens AF",
    "Drijgers RL, Verhey FR",
    "Drijgers RL"
  ),
  stringsAsFactors = FALSE
) -> sample_df

cbind.data.frame( # add the columns to the original data frame after the do.cal() completes
  sample_df,
  do.call( # turn the list created with lapply below into a data frame
    rbind.data.frame, 
    lapply(
      strsplit(sample_df$authors, ", "), # split at comma+space
      function(x) {
        data.frame( # pull first/last into a data frame
          first = x[1],
          last = if (length(x) < 2) NA_character_ else x[length(x)], # NA last if only one author
          stringsAsFactors = FALSE
        )
      }
    )
  )
)
##                                                     authors       first         last
## 1 Drijgers RL, Verhey FR, Leentjens AF, Kahler S, Aalten P. Drijgers RL    Aalten P.
## 2            Drijgers RL, Verhey FR, Leentjens AF, Kahler S Drijgers RL     Kahler S
## 3                      Drijgers RL, Verhey FR, Leentjens AF Drijgers RL Leentjens AF
## 4                                    Drijgers RL, Verhey FR Drijgers RL    Verhey FR
## 5                                               Drijgers RL Drijgers RL         <NA>

Выше ужасно с точки зрения производительности.Я сделал stringi версию для извлечения группы совпадений, но arg0naut все еще быстрее и Я также немного оптимизировал arg0naut, поскольку удаление пробелов потребуется только слева:

library(stringi)

data.frame(
  authors = c(
    "Drijgers RL, Verhey FR, Leentjens AF, Kahler S, Aalten P.",
    "Drijgers RL, Verhey FR, Leentjens AF, Kahler S",
    "Drijgers RL, Verhey FR, Leentjens AF",
    "Drijgers RL, Verhey FR",
    "Drijgers RL"
  ),
  stringsAsFactors = FALSE
) -> sample_df

# make some copies since we're modifying in-place now
s1 <- s2 <- sample_df

microbenchmark::microbenchmark(

  stri_regex = {
    s1$first <-  stri_match_first_regex(s1$authors, "^([^,]+)")[,2]
    s1$last <- stri_trim_left(stri_match_last_regex(s1$authors, "([^,]+)$")[,2])
    s1$last <- ifelse(s1$last == s1$first, NA_character_, s1$last)
  },

  extract_authors = {
    s2[["first"]] <- ifelse(
      grepl(",", s2[["authors"]]), gsub(",.*", "", s2[["authors"]]), s2[["authors"]]
    )
    s2[["last"]] <- ifelse(
      grepl(",", s2[["authors"]]), trimws(gsub(".*,", "", s2[["authors"]]), "left"), NA_character_
    )

  }

)

Результаты:

## Unit: microseconds
##             expr     min       lq     mean   median       uq      max neval
##       stri_regex 236.948 265.8055 331.5695 291.6610 334.1685 1002.921   100
##  extract_authors 127.584 150.8490 217.1192 162.4625 227.9995 1130.913   100

identical(s1, s2)
## [1] TRUE

s1
##                                                     authors       first         last
## 1 Drijgers RL, Verhey FR, Leentjens AF, Kahler S, Aalten P. Drijgers RL    Aalten P.
## 2            Drijgers RL, Verhey FR, Leentjens AF, Kahler S Drijgers RL     Kahler S
## 3                      Drijgers RL, Verhey FR, Leentjens AF Drijgers RL Leentjens AF
## 4                                    Drijgers RL, Verhey FR Drijgers RL    Verhey FR
## 5                                               Drijgers RL Drijgers RL         <NA>
0 голосов
/ 15 ноября 2018

Попробуйте эту функцию:

extract_authors <- function(df, authors) {

  df[["FirstAuthor"]] <- ifelse(
    grepl(",", df[[authors]]), trimws(gsub(",.*", "", df[[authors]])), df[[authors]]
  )


  df[["LastAuthor"]] <- ifelse(
    grepl(",", df[[authors]]), trimws(gsub(".*,", "", df[[authors]])), "No last author"
  )

  return(df)

}

Работает с другим примером из этой темы:

data.frame(
  authors = c(
    "Drijgers RL, Verhey FR, Leentjens AF, Kahler S, Aalten P.",
    "Drijgers RL, Verhey FR, Leentjens AF, Kahler S",
    "Drijgers RL, Verhey FR, Leentjens AF",
    "Drijgers RL, Verhey FR",
    "Drijgers RL"
  ),
  stringsAsFactors = FALSE
) -> sample_df

Вы можете назвать его так:

extract_authors(df, "authors")

ВНа выходе вы получите 2 новых столбца, FirstAuthor и LastAuthor:

                                                    authors FirstAuthor     LastAuthor
1 Drijgers RL, Verhey FR, Leentjens AF, Kahler S, Aalten P. Drijgers RL      Aalten P.
2            Drijgers RL, Verhey FR, Leentjens AF, Kahler S Drijgers RL       Kahler S
3                      Drijgers RL, Verhey FR, Leentjens AF Drijgers RL   Leentjens AF
4                                    Drijgers RL, Verhey FR Drijgers RL      Verhey FR
5                                               Drijgers RL Drijgers RL No last author
...