Извините за длинный ответ, мне хотелось немного оптимизировать код. В основном код не ваш, но даже в коде Аруна я нашел место для оптимизации. Давайте пройдемся по тому, что я изменил:
- Я удалил ваше заявление
attach, потому что оно не было необходимо, и если вы работаете с несколькими наборами данных, использование attach - это плохая практика - в основном из-за того, что вы теряете структуру своих данных
- Если вы создаете последовательность с шагом 1, просто используйте
:, а не seq. Я объяснил здесь, почему
- Ошибка в вашем коде: в
return(c(x$x, 0, 0)) есть один ноль или мало.
- Кроме того, вам не нужно
x$x внутри ddply -функции. Таким образом, оно должно быть просто return(c(0,0,0)), а в следующей строке оно должно быть c(colSums(tranche)[c("Murder", "Assault", "Rape")]. В противном случае R также построит все значения x.
- Хек! Вам на самом деле не нужно
plyr здесь. Эта ddply -функция представляет собой простой цикл над строками вашего crime.data -data.frame. Это то, чего вы можете достичь, используя lapply -loop
Здесь мне, возможно, нужно немного пояснить: plyr -пакет попытался преодолеть недостатки apply -семейных функций. За исключением lapply, их поведение довольно непредсказуемо. Особенно sapply может возвращать что-либо от vector над matrix до list -объектов. Только lapply надежен - он всегда дает list результат:
USArrests_sum <- cbind (USArrests, arrests=with(USArrests, Murder+ Rape+ Assault))
#See if package is installed, and do if not
if (!require("ggplot2")) {
install.packages("ggplot2")
library(ggplot2)
}
# get crime histogram plot and name it crime.plot
crime.plot <- ggplot (data = USArrests_sum, aes(x= arrests)) + geom_histogram()
crime_df <- ggplot_build(crime.plot)$data[[1]][c("count", "x", "xmin", "xmax")] # get data of crime plot: cols = count, xmin and xmax
crime_df$id = 1:nrow(crime_df) #add a id colum for ddply
#Split data frame, apply function en return results in a data frame: ddply
tranche_list<-lapply(1:nrow(crime_df), function(j) {
myrows<-(USArrests_sum$arrests >= crime_df$xmin[j] & USArrests_sum$arrests <= crime_df$xmax[j])
tranche <- USArrests_sum[myrows,]
if(nrow(tranche) == 0) return(c('Murder'=0,'Assault'=0,'Rape'=0))
crime.plot <- c(colSums(tranche)[c("Murder", "Assault", "Rape")]/colSums(tranche)["arrests"] * crime_df$count[j])
})
Альтернатива состоит в том, чтобы использовать dplyr для преобразования ваших данных, возможно, кто-то еще чувствует это. Я предпочитаю делать base R.
На следующем шаге вы используете reshape2, преемник - tidyr. Но на самом деле структура данных так проста. Вы можете использовать base R, если хотите:
stack_df2<-data.frame(value=as.numeric(unlist(tranche_list)),
variable=names(unlist(tranche_list)),
id=rep(1:nrow(crime_df),each=3))
ggplot(data = stack_df2, aes(x=id, y=value)) + geom_bar(aes(fill=variable), stat="identity", group=1)
Приложение
Я сравнил несколько функций с решением ddply:
plyr_fun<-function(){
ddply(crime_df, .(id), function(x) {
tranche <- USArrests_sum[USArrests_sum$arrests >= x$xmin & USArrests_sum$arrests <= x$xmax, ]
if(nrow(tranche) == 0) return(c(0, 0,0))
crime.plot <- c(colSums(tranche)[c("Murder", "Assault", "Rape")]/colSums(tranche)["arrests"] * x$count)
})
}
apply_fun2<-function(){
res_mat<-t(apply(crime_df, 1, function(x) {
tranche <- USArrests_sum[USArrests_sum$arrests >= x['xmin'] & USArrests_sum$arrests <= x['xmax'], ]
if(nrow(tranche) == 0) return(c(0, 0,0))
crime.plot <- c(colSums(tranche)[c("Murder", "Assault", "Rape")]/colSums(tranche)["arrests"] * x['count'])
}))
colnames(res_mat)=c("Murder", "Assault", "Rape")
}
lapply_fun3<-function(){
tranche_list<-lapply(1:nrow(crime_df), function(j) {
myrows<-(USArrests_sum$arrests >= crime_df$xmin[j] & USArrests_sum$arrests <= crime_df$xmax[j])
tranche <- USArrests_sum[myrows,]
if(nrow(tranche) == 0) return(c(0, 0,0))
crime.plot <- c(colSums(tranche)[c("Murder", "Assault", "Rape")]/colSums(tranche)["arrests"] * crime_df$count[j])
})
do.call(rbind,tranche_list)
}
lapply_fun<-function(){
tranche_list<-lapply(1:nrow(crime_df), function(j) {
myrows<-(USArrests_sum$arrests >= crime_df$xmin[j] & USArrests_sum$arrests <= crime_df$xmax[j])
tranche <- USArrests_sum[myrows,]
if(nrow(tranche) == 0) return(c('Murder'=0,'Assault'=0,'Rape'=0))
crime.plot <- c(colSums(tranche)[c("Murder", "Assault", "Rape")]/colSums(tranche)["arrests"] * crime_df$count[j])
})
}
microbenchmark::microbenchmark(apply_fun2(),lapply_fun3(),lapply_fun(),plyr_fun(),times=1000L)
Unit: milliseconds
expr min lq mean median uq max neval
apply_fun2() 5.2307 5.73340 7.169920 6.17165 7.27340 31.5333 1000
lapply_fun3() 5.3633 5.98930 7.487173 6.40780 7.50115 37.1350 1000
lapply_fun() 5.4470 5.99295 7.762575 6.43975 7.73060 82.2069 1000
plyr_fun() 8.8593 9.83850 12.186933 10.54180 12.75880 192.6898 1000
На самом деле функция apply даже быстрее, чем lapply. Но читаемость довольно плохая. Обычно data.table -функции работают быстрее, чем семейство apply, тогда как dplyr -функции выполняются сравнительно медленно, но имеют хорошую читаемость и подходят для преобразования кода.
Просто для удовольствия - еще один тест tidyr против моего базового решения R:
tidyr_fun<-function(){
crime_tranche<-do.call(rbind,tranche_list)
stack_df <- gather(data.frame(crime_tranche,id=1:nrow(crime_df)), key=variable,value=value,-id)
}
base_fun<-function(){
stack_df2<-data.frame(value=as.numeric(unlist(tranche_list)),
variable=names(unlist(tranche_list)),
id=rep(1:nrow(crime_df),each=3))
}
microbenchmark::microbenchmark(tidyr_fun(),base_fun())
Unit: microseconds
expr min lq mean median uq max neval
tidyr_fun() 1588.4 1869.45 2516.253 2302.35 2777.9 7671.3 100
base_fun() 286.7 367.40 530.104 454.85 612.8 3675.8 100
# In case you want to verify that the data is the same. identical(stack_df2$id[order(stack_df2$id,stack_df2$variable)],stack_df$id[order(stack_df$id,stack_df$variable)])
identical(stack_df2$value[order(stack_df2$id,stack_df2$variable)],stack_df$value[order(stack_df$id,stack_df$variable)])
identical(as.character(stack_df2$variable[order(stack_df2$id,stack_df2$variable)]),stack_df$variable[order(stack_df$id,stack_df$variable)])