2016-08-13 12 views
1

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

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

(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) 

ответ

0

Нечто подобное, кажется, работает, соответствие числовые, начиная с заготовки, которые содержат период, то преобразование в цифровой и экстракции, какие из них меньше, чем 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