Устранить зависимость от 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 ответа:
Как насчет
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)
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 именованный список...
Не ответ, а попытка включить предложения в ответ
Попытка с предложением лапли
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'))
Это то, что сработало, используя предложение Бена Болкера. Разместив это, чтобы завершить поток.
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) }
Спасибо вам всем за то, что вытерпели меня через явно раздутый столб. Я ненавидел это делать, но мне казалось, что это единственный способ запечатлеть происходящее.