Устранить зависимость Plyr - PullRequest
Новая
       6

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

2 голосов
/ 17 декабря 2011

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

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

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

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

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

Dataframe 

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 ]

3 голосов
/ 17 декабря 2011

Как насчет 

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)
2 голосов
/ 17 декабря 2011

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 именованному списку ...

0 голосов
/ 17 декабря 2011

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

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 голосов
/ 17 декабря 2011

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

ПОПЫТКА С предложением счастья 

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

ПОПЫТКА С НАКЛАДНЫМ ПРЕДЛОЖЕНИЕМ 

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'))
...