Извлечение чисел из строки в R на основе определенных критериев

Я пытаюсь извлечь некоторые числа из строки (комментариев) на основе определенных критериев. Числа, которые я хотел бы извлечь, следуют непосредственно за датой в 24-часовом формате и всегда содержат десятичный знак и меньше 20 (в строке есть и другие числа, но они меня не интересуют). Мне удалось извлечь числа, которые я хотел бы, с помощью приведенного ниже кода R, но у меня нет возможности связать их с идентификаторами, из которых они пришли. Некоторые идентификаторы имеют несколько интересующих номеров, а некоторые — только один. Например, мне нужен какой-то способ связать идентификационный номер в фиктивных данных, приведенных ниже, с каждым интересующим числом. Как видите, ID 1 содержит три интересующих результата (4.1, 6.9 и 4.3), а ID 2 имеет только 1 интересующий результат (6.5).

Любая помощь будет фантастической!

(An example of the format of comment.txt)

    ID  comments
    1   abc1200 4.1  abc1100 6.9 etd1130 4.3 69.0
    2   abc0900 6.5 abcde 15
    3   3.2 0850 9.5 abc 8.2 0930 12.2 agft 75.0
    4   ashdfalsk 0950 10.5 dvvxcvszv asdasd assdas d 75.0


#rm(list=ls(all=TRUE))

#import text and pull out a list of all numbers contained withtin the free text
raw_text <- read.delim("comment.txt")
numbers_from_text <- gregexpr("[0-9]+.[0-9]", raw_text$comments)

numbers_list <- unlist(regmatches(raw_text$comments, numbers_from_text))
numbers_list <- as.data.frame(numbers_list)

#pull out those numbers that contain an decimal place and create a running count
format<-cbind(numbers_list,dem=(grepl("\\.",as.character(numbers_list$numbers_list)))*1,row.number=1:nrow(numbers_list))

#if the number does not contain a decimal (a date) then create a new row number which is the addition of the first row
#else return NA
test <- cbind(format,new_row = ifelse(format$dem==0, format$row.number+1, "NA"))

#match the cases where the new_row is equal to the row.number and then output the corresponding numbers_list
match <-test$numbers_list[match(test$new_row,test$row.number)]

#get rid of the NA's for where there wasnt a match and values less than 20 to ensure results are correct
match_NA <- subset(match, match!= "<NA>" & as.numeric(as.character(match))<20)

match_NA <- as.data.frame(match_NA) 

person sharkey32    schedule 13.08.2016    source источник


Ответы (1)


Кажется, что-то вроде этого работает, сопоставляя числовые значения, начинающиеся с пробела, которые содержат точку, затем преобразуя их в числовые и извлекая те, которые меньше 20.

library(stringr)
temp <- apply(comments, 1, function(x) {
  str_extract_all(x,"[[:blank:]][0-9]+[.][0-9]")
})

library(purrr)
temp <- lapply(flatten(temp), function(x) as.numeric(str_trim(x)))
lapply(temp, function(x) x[x <20])

[[1]]
[1] 4.1 6.9 4.3

[[2]]
[1] 6.5

[[3]]
[1]  3.2  9.5  8.2 12.2

[[4]]
[1] 10.5
person shayaa    schedule 13.08.2016