Регулярное выражение в R: Как отделить или опустить группы регулярного выражения для разбора стенограммы? (Массивная проблема с неравными рядами)

Question

Я работаю над созданием собственного синтаксического анализатора стенограммы, который только анализирует выступающих. Я наткнулся на контрольно-пропускной пункт в том, как настроить это для l oop. Проблема: у меня более 50 строк со столбцом с именем «линии», эта переменная содержит данные, которые мне нужны для извлечения и добавления к уже существующим данным. Данные выглядят следующим образом:

        col_date        col_name_speech           col_lines
Row 1:  2001-06-09         test1          "SPEAKER A. W. Hello this is a speech that I am giving. Blah. 
                                            Blah. SPEAKER B. W. This 
                                            is ALSO a line of a speech that I am giving."

Row 2:    2002-09-10         test2         "This is procedural garbage. I hate garbage. Blah BLAH Blah. 
                                            header. SPEAKER. T. I. I have a speech now."

Row 3:    2006-09-19        test3          "procedural garbage. SPEAKER E. W. Wow, what a good speech. 
                                             SPEAKER. T. I. yes. SPEAKER E. W. indeed."

Фрейм данных, который я хотел бы получить, должен выглядеть примерно так:

date           name        speaker          lines
2001-06-09     test1       SPEAKER A. W.    Hello this is a speech that I am giving. Blah. Blah.
2001-06-09     test1       SPEAKER B. W.    This is ALSO a line of a speech that I am giving
2002-09-10     test2       SPEAKER T. I.    I have a speech now.
2006-09-19     test3       SPEAKER E. W.    Wow, what a good speech. indeed.
2006-09-19     test3       SPEAKER. T. I.   yes. 

Вы должны заметить, что переменная lines отбрасывается процедурно мусор из заголовка ряда и объединяет выступления ораторов.

У меня есть приличный шаблон регулярных выражений для обнаружения динамиков, и он работает при применении к отдельным строкам, но он не работает в течение l oop, так как конечный кадр данных имеет разные номера строк с точки зрения динамиков и речи (которые я приписываю проблеме заголовка). Следует отметить, что разница в количестве строк составляет почти столько же, сколько и количество строк. Я предоставлю оба набора кода.

Работает для разделения динамиков по одной строке за раз:

  person  = c(NA, unlist(stri_extract_all(data$lines[[1]], 
                                          regex="([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)")))
  speech = unlist(stri_split(data$lines[[1]], 
                              regex="([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)"))

Чтобы удалить переменную NA и объединить как динамики (требуется интеграция в l oop ):

df <-data.frame(person, speech)
df <- df[complete.cases(df), ]
df<- df %>%
  group_by(person) %>%
  summarise(speech= paste(speechsage, collapse = ","))

Для l oop, который ничего не работает:

for(i in 1:50){
  person  = c(NA, unlist(stri_extract_all(data$lines, 
                                          regex="([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)")))
  message = unlist(stri_split(data$lines, 
                              regex="([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)"))
}
df <- data.frame(person, speech)
error in data.frame(person, speech): arguments imply differing number of rows 927, 971

Более того, мне нужно добавить переменную даты и имени в окончательный фрейм данных, который выглядит как легче сделать внутри для l oop. ЦЕНА любая помощь в этом (особенно, если кто-то может показать полные шаги, необходимые для преобразования структуры данных).

Answer 1

Это один из тех трудных, но в конечном итоге простых вопросов в аду разбора стенограммы. Я решил это с помощью нескольких простых решений в stringr, stringi и tidyverse, как указал Акаш87 - большая часть этого ответа вдохновлялась его ответом. Я добавил еще одно наблюдение в набор данных для дополнительной диагностики.

Сначала я создаю фрейм данных из данных:

df  <- data.frame(col_date = (c("2001-06-09", "2002-09-10", "2006-09-19")), 
       name = c("test1", "test2", "test3"), 
       col_lines = c("SPEAKER A. W. Hello this is a speech that I am giving. Blah. Blah. SPEAKER B. W. This is ALSO a line of a speech that I am giving.","This is procedural garbage. I hate garbage. Blah BLAH Blah. header. SPEAKER. T. I. I have a speech now.","procedural garbage. SPEAKER E. W. Wow, what a good speech. SPEAKER. T. I. yes. SPEAKER E. W. indeed. SPEAKER A. W. Hello this is a speech that I am giving. "))
df$speakers <- NA
df$speech <- NA

Затем я сохраняю шаблон регулярных выражений для более легкого доступа (не обращайте внимания на последний канал).

speakers_names  = "([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)|[[:upper:]]+([[:upper:]]\\s[[:upper:]]{4}\\.)"

Я напрямую извлекаю докладчиков в фрейм данных

df$speakers <- stri_extract_all(df$col_lines, regex= speakers_names)

Речи извлекаются путем удаления имен и лишних данных.

df$speech = str_remove(df$col_lines, ".*?(?=(([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)|([[:upper:]]+([[:upper:]]\\s[[:upper:]]{4}\\.))))")
df$speech = stri_split(df$speech, regex= speakers_names)

Это оставляет нам фрейм данных с вложенными списками , Таким образом, мы должны отложить их и сформировать данные. Имейте в виду, что нам нужно избавиться от предметов АН, соответствующих нашим случаям.

df <- data.frame(df %>% unnest(speakers), (df %>% unnest(speech) %>%
  na_if("") %>%
  na.omit()))
keeps <- c("col_date", "name", "speakers", "speech.1")
df <- df[ ,keeps, drop =FALSE]

Теперь все, что нам осталось, - это объединить выступления ораторов на определенную дату. Я группирую по дате, именам и ораторам и суммирую строки.

df <- df %>% 
  group_by(col_date, name, speakers) %>%
  summarise(speech.1 = toString(speech.1))
View(df)

И все готово. То, что было бесконечной и изнурительной битвой Кафки-эска с превращением этих данных во что-то выполнимое, разрешимо в 18 строках. Если у кого-то есть предложения, дайте мне знать.

Я надеюсь, что любой, кто анализирует стенограммы, может использовать этот вопрос в качестве схемы - особенно если они получены из длинных и сложных JSON. Это работает на большинстве стенографических c стилей / языков, если регулярное выражение задано c достаточно для захвата имен выступающих (и это, конечно, также относится к указаниям на сцене и т. Д. c). Приветствия.

Answer 2

Ого, это был dooz ie! Я использовал несколько разных библиотек tidyverse, stringr и stringi:

Сначала я создаю набор данных в удобном для R формате:

data          <- data.frame(col_date = as.Date(c("2001-06-09", "2002-09-10", "2006-09-19")), 
                            name = c("test1", "test2", "test3"), 
                            col_lines = c("SPEAKER A. W. Hello this is a speech that I am giving. Blah. Blah. SPEAKER B. W. This is ALSO a line of a speech that I am giving.","This is procedural garbage. I hate garbage. Blah BLAH Blah. header. SPEAKER. T. I. I have a speech now.","procedural garbage. SPEAKER E. W. Wow, what a good speech. SPEAKER. T. I. yes. SPEAKER E. W. indeed."))

Затем я идентифицирую ораторов для каждого col_lines, и получите уникальный список ораторов для подстрок позже.

speakers      <- sapply(lapply(data$col_lines, 
                          function(x) stri_extract_all(x, regex="([[:upper:]]+[ [:upper:]]+[ [:upper:].]+\\.+[ [:upper:].]+\\.)|([[:upper:]]+[[:upper:]]{19,20}\\.)")), unlist)

speak_unique  <- unique(unlist(speakers)) #GET UNIQUE SPEAKER LIST FOR 

speak_mat     <- plyr::ldply(speakers, rbind)

Я связываю результат speak_mat с моими исходными данными и проверяю имена столбцов для будущего использования. Строка, используемая для генерации speak_mat, используется для go из списка в матрицу, заполняя пробелы NA в порядке генерации.

data_new      <- cbind(data, speak_mat)

colnames(data_new) <- c(names(data), paste("speaker_", names(speak_mat)))

Теперь я заменяю speak_unique в каждом col_line с одним символьным представлением

data_new_lines <- data_new %>% 
                  mutate( col_lines_new  = gsub(paste(speak_unique, collapse = "|"), ";", col_lines),
                          col_lines_new1 = gsub("[^;]*;(.*)", "\\1", col_lines_new))

Затем я избавляюсь от конечных и начальных пробелов, когда speak_unique был первым или последним символом, и удаляю весь текст для каждого col_lines, который стоит перед первым speak_unique. Я также разбиваю каждый текст на ; и создаю вектор.

out <- unlist(lapply(strsplit(as.character(data_new_lines$col_lines_new1),";"), function(x) {x[!x == ""]}))

Я беру out и объединяю его с длинным форматом data_new, который не имеет оригинального col_lines .

data_long <- data_new %>%
             select(-col_lines) %>% 
             gather(num, speaker, -col_date, -name, na.rm = T) %>%
             arrange(col_date, num) %>%
             select(-num) %>% 
             cbind(lines = out) %>%
             group_by(col_date, name, speaker) %>%
             summarise(lines_c = paste(trimws(lines), collapse = " "))

Надеюсь, это поможет!