r - 使用 ggplot2 来自已汇总计数的 3 层堆叠直方图
问题描述
我需要一些帮助,为从 data.frame 中的汇总数据生成的 ggplot2 直方图着色。
我使用的数据集是 [R] 内置 (USarrests) 数据集。
我正在尝试调整arun为这个问题提供的解决方案。
期望的结果是制作“犯罪”的直方图,并根据 c(“Assault”、“Rape”、“Murder”) 的相对贡献为每个条形图着色。
编码:
attach(USArrests)
#Create vector SUM arrests per state
Crime <- with(USArrests, Murder+ Rape+ Assault)
#bind Vector Crime to dataframe USArrets and name it USArrests.transform
USArrests.transform <- cbind (USArrests, Crime)
#See if package is installed, and do if not
if (!require("ggplot2")) {
install.packages("ggplot2")
library(ggplot2)
}
ggplot (data = USArrests.transform, aes(x= Crime)) + geom_histogram()
# get crime histogram plot and name it crime.plot
crime.plot <- ggplot (data = USArrests.transform, aes(x= Crime)) + geom_histogram()
# get data of crime plot: cols = count, xmin and xmax
crime.data <- ggplot_build(crime.plot)$data[[1]][c("count", "x", "xmin", "xmax")]
# add a id colum for ddply
crime.data$id <- seq(nrow(crime.data))
#See if package is installed, and do if not
if (!require("plyr")) {
install.packages("plyr")
library(plyr)
}
#Split data frame, apply function en return results in a data frame: ddply
crime.data.transform <- ddply(crime.data, .(id), function(x) {
tranche <- USArrests.transform[USArrests.transform$Crime >= x$xmin & USArrests.transform$Crime <= x$xmax, ]
if(nrow(tranche) == 0) return(c(x$x, 0, 0))
crime.plot <- c(x=x$x, colSums(tranche)[c("Murder", "Assault", "Rape")]/colSums(tranche)["Crime"] * x$count)
})
#See if package is installed, and do if not
if (!require("reshape2")) {
install.packages("reshape2")
library(reshape2)
}
crime.data.transform <- melt(crime.data.transform, id.var="id")
ggplot(data = crime.data.transform, aes(x=id, y=value)) + geom_bar(aes(fill=variable), stat="identity", group=1)
[错误]:上面给出了以下错误:
Error in list_to_dataframe(res, attr(.data, "split_labels"), .id, id_as_factor) :
Results do not have equal lengths
随后,在重塑后出现部分错误。
关于我做错了什么以及如何在上面的示例中解决它的任何建议?
解决方案
对不起,我想对代码进行一些优化。大多数代码不是你的,但即使在 arun 的代码中,我也发现了一些优化空间。让我们来看看我改变了什么:
- 我删除了您的
attach
声明,因为它不是必需的,如果您使用多个数据集,那么使用它是不好的做法attach
- 主要是因为您失去了对数据结构的跟踪 - 如果您创建一个序列并且步长为 1,则只需使用
:
and notseq
。我在这里解释了为什么 - 您的代码中的错误:从
return(c(x$x, 0, 0))
零到少。 - 另外你不需要
x$x
里面的ddply
-function。因此它应该只是return(c(0,0,0))
,并且在下一行它需要是c(colSums(tranche)[c("Murder", "Assault", "Rape")]
。否则,R 也将绘制所有x
值。 - 见鬼!你实际上不需要
plyr
这里。这个ddply
-function 只是对crime.data
-data.frame 行的简单循环。这是您可以使用lapply
-loop实现的目标
在这里我可能需要解释一下: -packageplyr
试图克服apply
-family-functions的缺点。除了lapply
,他们的行为是相当不可预测的。特别是可能会从over到-objectssapply
返回任何东西。只有可靠 - 它总是给你一个结果: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
-solution 进行了比较:
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
实际上-functionapply
甚至比lapply
-solution 还要快。但是可读性很差。通常data.table
-function 比apply
系列更快,而dplyr
-function 运行速度相对较慢但具有良好的可读性并且适合代码翻译。
只是为了好玩 -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)])
推荐阅读
- javascript - 填写表单后动态向对象添加新键
- python-3.x - 如何在 python 中创建自定义的 bin
- r - 在最新的 R 版本 3.6 中将绘图列表保存到 Powerpoint 幻灯片
- node.js - 我如何解决错误:找不到模块'/node dist/api/server.js/dist/server.js
- asp.net - 阅读并应用任何建议,但无法在 php 中使用 cURL 传递登录页面
- python - 通过索引获取数据帧的行数据给出错误
- java - CreatePlatformSocket() 失败:协议不支持地址系列,并且无法在 AWS Lambda 中使用 WebDriverManager 找到 chrome 二进制文件
- php - 如何使用mysql从已爆炸的数组中调用所有数据
- swift - 如何将指针的地址传递给 Swift 中的 C API 的参数?
- php - 如何使用自定义帖子和自定义字段回显链接的可点击缩略图