Блог

Я пытаюсь заменить цикл for функцией типа * ply .

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

Вот некоторые примеры данных (я знаю, что этот конкретный пример можно было бы выполнить другими способами, но это просто для простоты — мой реальный пример намного сложнее):

 sample_pat_rep <-  data.frame(matrix(NA, ncol=2, nrow=3, dimnames=list(c(), c("Pattern","Replacement"))), stringsAsFactors=FALSE)
sample_pat_rep[1,] <-  c("a","A")
sample_pat_rep[2,] <-  c("b","B")
sample_pat_rep[3,] <-  c("c","C")

sample_strings <-  data.frame(matrix(NA, ncol=2, nrow=3, dimnames=list(c(), c("Original","Fixed"))), stringsAsFactors=FALSE)
sample_strings[1,] <-  c("aaaaaaaa bbbbbbbb cccccccc","aaaaaaaa bbbbbbbb cccccccc")
sample_strings[2,] <-  c("aAaAaAaA bBbBbBbB cCcCcCcC","aAaAaAaA bBbBbBbB cCcCcCcC")
sample_strings[3,] <-  c("AaAaAaAa BbBbBbBb CcCcCcCc","AaAaAaAa BbBbBbBb CcCcCcCc")
  

Вот версия для цикла:

 sample_strings1 <- sample_strings
for (i in 1:nrow(sample_pat_rep))
{
  sample_strings1[,c("Fixed")] <- gsub(sample_pat_rep[i,c("Pattern")], sample_pat_rep[i,c("Replacement")], sample_strings1[,c("Fixed")],ignore.case = TRUE)
} 
  

Когда я пытаюсь воспроизвести это с помощью adply, данные не обновляются — они существенно реплицируют и повторно связывают их.

 sample_strings2 <- adply(.data=sample_pat_rep, .margins=1, .fun = function(x,data){

data[,c("Fixed")] <- gsub(x[,c("Pattern")], x[,c("Replacement")], data[,c("Fixed")],ignore.case = TRUE)
return(data)

}, data=sample_strings, .expand = FALSE, .progress = "none", .inform = FALSE, .parallel = FALSE, .paropts = NULL)
  

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

Может быть, написать функцию, которая выполняет вызов?? Использовать Rapply??

Заранее спасибо!

ОБНОВЛЕНИЕ: НОВЫЕ ДАННЫЕ

Это ближе к реальному сценарию. Совпадения являются динамическими и основаны на внешней системе. Я пытаюсь избежать чрезмерно сложных регулярных выражений или вложенных if elses .

 library(plyr)

sample_match <-  data.frame(matrix(NA, ncol=1, nrow=3, dimnames=list(c(), c("Match"))), stringsAsFactors=FALSE)
sample_match[1,] <-  c("dog")
sample_match[2,] <-  c("cat")
sample_match[3,] <-  c("bear")

sample_strings <-  data.frame(matrix(NA, ncol=2, nrow=3, dimnames=list(c(), c("Sentence","Has_Animal"))), stringsAsFactors=FALSE)
sample_strings[1,] <-  c("This person only has a cat",0)
sample_strings[2,] <-  c("This person has a cat and a dog",0)
sample_strings[3,] <-  c("This person has no animals",0)

sample_strings1 <- sample_strings
for (i in 1:nrow(sample_match))
{
 sample_strings1[,c("Has_Animal")] <- ifelse(grepl(sample_match[i,c("Match")], sample_strings1[,c("Sentence")]), 1,sample_strings1[,c("Has_Animal")])
} 


sample_strings2 <- adply(.data=sample_match, .margins=1, .fun = function(x,data){

 data[,c("Has_Animal")] <- ifelse(grepl(x[,c("Match")], data[,c("Sentence")]), 1,data[,c("Has_Animal")])
 return(data)

}, data=sample_strings, .expand = FALSE, .progress = "none", .inform = FALSE, .parallel = FALSE, .paropts = NULL)
  

Вот прямой plyr подход к вопросу:

 ddply(sample_strings,.(Sentence),function(x,ref = sample_match) {
  any(unlist(strsplit(x[["Sentence"]]," ")) %in% ref[[1]])
  })

                         Sentence    V1
1 This person has a cat and a dog  TRUE
2      This person has no animals FALSE
3      This person only has a cat  TRUE
  

Обновление: неправильно понял вопрос, это sample_strings2 был требуемый результат. Обновлен ответ, который дает sample_strings1 сейчас, который требуется IIUC.

Вот решение, использующее base :

 pattern = paste(sample_match$Match, collapse="|")
transform(sample_strings, Has_Animal = grepl(pattern, Sentence)*1L)

#                          Sentence Has_Animal
# 1      This person only has a cat          1
# 2 This person has a cat and a dog          1
# 3      This person has no animals          0
  

Если вы не хотите сопоставлять слова, содержащие шаблон внутри, например: concatenate содержит cat , тогда вы можете использовать регулярное b выражение для границы слова.

 pattern = paste(paste("\b", sample_match$Match, "\b", sep=""), collapse="|")
grepl(pattern, c("cat", "concatenate"))
# [1] TRUE FALSE