Устранить зависимость от plyr

перепишите Оригинал поста. Я ищу, чтобы устранить зависимость plyr.

Я попытался соединить tapply в мой код, а также lapply. Tapply работал для одной переменной (пол), но не для 2 (Пол, взрослый). Проскальзывание ответа lapply не возвращает список слов с помощью переменной группировки, он просто возвращает один большой список слов с переменной группировки в верхней части (поэтому для человека он возвращает один список слов вместо одного списка слов для каждого человека).

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

Я собираюсь включить свои попытки изменить функцию с вашими предложениями в ответ, а не здесь, чтобы уменьшить уже раздутый пост. Кроме того, Пожалуйста, не комментируйте дополнительные функции, определенные пользователем, если они не полезны для основной проблемы. Они находятся в процессе разработки и включены только для того, чтобы показать вам, в чем проблема.

ПРАВИЛЬНЫЙ ВЫВОД С PLYR: http://pastebin.com/mr9FvjpF

Фрейм данных 

DATA<-structure(list(person = structure(c(4L, 1L, 5L, 4L, 1L, 3L, 1L,  
4L, 3L, 2L, 1L), .Label = c("greg", "researcher", "sally", "sam",  
"teacher"), class = "factor"), sex = structure(c(2L, 2L, 2L,  
2L, 2L, 1L, 2L, 2L, 1L, 1L, 2L), .Label = c("f", "m"), class = "factor"),  
adult = c(0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L), state = structure(c(2L,  
7L, 9L, 11L, 5L, 4L, 8L, 3L, 10L, 1L, 6L), .Label = c("Shall we move on?  Good then.",  
"Computer is fun. Not too fun.", "I distrust you.",  
"How can we be certain?", "I am telling the truth!", "Im hungry.  Lets eat.  You already?",  
"No its not, its ****.", "There is no way.", "What should we do?",  
"What are you talking about?", "You liar, it stinks!" 
), class = "factor"), code = structure(c(1L, 4L, 5L, 6L,  
7L, 8L, 9L, 10L, 11L, 2L, 3L), .Label = c("K1", "K10", "K11",  
"K2", "K3", "K4", "K5", "K6", "K7", "K8", "K9"), class = "factor")), .Names = c("person",  
"sex", "adult", "state", "code"), row.names = c(NA, -11L), class = "data.frame") 
#=====================

ЗАВИСИМЫЕ ПОЛЬЗОВАТЕЛЬСКИЕ ИНСТРУМЕНТЫ 

Trim<-function (x) gsub("^\s+|\s+$", "", x)

bracketX<-function(text, bracket='all'){
    switch(bracket,
        square=sapply(text, function(x)gsub("\[.+?\]", "", x)),
        round=sapply(text, function(x)gsub("\(.+?\)", "", x)),
        curly=sapply(text, function(x)gsub("\{.+?\}", "", x)),
        all={P1<-sapply(text, function(x)gsub("\[.+?\]", "", x))
             P1<-sapply(P1, function(x)gsub("\(.+?\)", "", x))
             sapply(P1, function(x)gsub("\{.+?\}", "", x))})                                                                                                                                                           
}

words <- function(x){as.vector(unlist(strsplit(x, " ")))}

word.split <- function(x) lapply(x, words)

strip <- function(x){
         sentence <- gsub('[[:punct:]]', '', as.character(x))  
         sentence <- gsub('[[:cntrl:]]', '', sentence)  
         sentence <- gsub('\d+', '', sentence)  
         Trim(tolower(sentence))
}
#=====================

ФУНКЦИЯ ИНТЕРЕСА 

textLISTER <- function(dataframe = DFwcweb, text.var = "dialogue", group.vars = "person") {
    require(plyr)
    DF <- dataframe
    DF$words <- Trim(as.character(bracketX(dataframe[, text.var])))
    DF$words <- as.vector(word.split(strip(DF$words)))

    #I'd like to get ride of the plyr dependency in the line below
    dlply(DF, c(group.vars), summarise, words = as.vector(unlist(DF$words)))
} 
#=====================

В НАСТОЯЩЕЕ ВРЕМЯ КОД РАБОТАЕТ С ОДНОЙ ИЛИ НЕСКОЛЬКИМИ ГРУППИРУЮЩИМИ ПЕРЕМЕННЫМИ. 

textLISTER(DATA, 'state', 'person')
textLISTER(DATA, 'state', c('sex','adult'))
4 2

4 ответа:

Как насчет 

d1 <- dlply(DF, .(sex, adult), summarise, words=as.vector(unlist(dia2word)))
d2 <- dlply(DF, .(person), summarise, words=as.vector(unlist(dia2word)))
ff <- function(x) {
    u <- unlist(x)
    data.frame(words=u,
             row.names=seq(length(u)),
             stringsAsFactors=FALSE)
}
d1B <- with(DF,lapply(split(dia2word,list(adult,sex)),ff))
all.equal(d1,d1B,check.attributes=FALSE) ## TRUE
d2B <- with(DF,lapply(split(dia2word,person),ff))
all.equal(d2,d2B,check.attributes=FALSE) ## TRUE

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

target <- "dia2word"
categ <- c("adult","sex")
d1C <- lapply(split(DF[[target]],lapply(categ,getElement,object=DF)),ff)
all.equal(d1,d1B,d1C,check.attributes=FALSE)
categ <- "person"
d2C <- lapply(split(DF[[target]],lapply(categ,getElement,object=DF)),ff)
all.equal(d2,d2B,d2C,check.attributes=FALSE)
3

tapply я должен доставить тебя туда.

> tapply(DF$dia2word, DF[, c('sex', 'adult')], function(x) as.vector(unlist(x)))
   adult
sex 0            1          
  f Character,10 Character,7
  m Character,35 Character,4

Тогда это будет просто немного больше форматирования, если вы хотите имитировать 1D именованный список...

2

Не ответ, а попытка включить предложения в ответ

Попытка с предложением лапли 

textLISTER<-function(dataframe, text.var, group.vars){
    #require(plyr)
    DF<-dataframe
    DF$dia2word<-Trim(as.character(bracketX(dataframe[,text.var])))
    DF$dia2word<-as.vector(word.split(strip(DF$dia2word)))
    #dlply(DF, c(group.vars), summarise, words=as.vector(unlist(dia2word)))

ff <- function(x) {
    u <- unlist(x)
    data.frame(words=u,
             row.names=seq(length(u)),
             stringsAsFactors=FALSE)
}
with(DF,lapply(split(dia2word,list(group.vars)),ff))
}
#================================================================
#THE TEST
textLISTER(DATA, 'state', 'person')
textLISTER(DATA, 'state', c('sex','adult'))

Попытка с предложением tapply 

textLISTER <- function(dataframe, text.var, group.vars) {
    #require(plyr)
    DF <- dataframe
    DF$dia2word <- Trim(as.character(bracketX(dataframe[, text.var])))
    DF$dia2word <- as.vector(word.split(strip(DF$dia2word)))
    #dlply(DF, c(group.vars), summarise,
    #   words=as.vector(unlist(dia2word)))
    tapply(DF$dia2word, DF[, c(group.vars)], function(x) as.vector(unlist(x)))
} 
#================================================================
#THE TEST
textLISTER(DATA, 'state', 'person')
textLISTER(DATA, 'state', c('sex','adult'))
0

Это то, что сработало, используя предложение Бена Болкера. Разместив это, чтобы завершить поток.

textLISTER <- function(dataframe, text.var, group.vars) {
    reducer <- function(x) gsub(" +", " ", x)
    DF <- dataframe
    DF$dia2word <- Trim(as.character(bracketX(dataframe[, text.var])))
    DF$dia2word <- as.vector(word.split(reducer(strip(DF$dia2word))))

    ff <- function(x) {
        u <- unlist(x)
        data.frame(words = u, row.names = seq(length(u)), stringsAsFactors = FALSE)
    }
    lapply(split(DF[["dia2word"]], lapply(group.vars, getElement, 
        object = DF)), ff)
}

Спасибо вам всем за то, что вытерпели меня через явно раздутый столб. Я ненавидел это делать, но мне казалось, что это единственный способ запечатлеть происходящее.

0