我希望能够制作一些图表来展示一些NBA球员和球队的投篮趋势/效果。我想如下格式化六边形:尺寸将代表镜头的数量,颜色将代表该位置的相对效率(pts / attempt)。我正在寻找的Here is a great example,由Kirk Goldsberry创建:
我已经能够使用hexbins
和hexTapply
来获得接近所需结果的内容,但形状是圆形。这是我的代码(包括示例数据):
library(hexbin); library(ggplot2)
df <- read.table(text="xCoord yCoord pts
11.4 14.9 2
2.6 1.1 0
4.8 4.1 2
-14.4 8.2 2
4.2 0.3 0
0.4 0.0 2
-23.2 -1.1 3", header=TRUE)
h <- hexbin (x=df$xCoord, y = df$yCoord, IDs = TRUE, xbins=50)
pts.binned <- hexTapply (h, df$pts, FUN=mean)
df.binned <- data.frame (xCoord = h@xcm,
yCoord = h@ycm, FGA = h@count, pts = pts.binned)
chart.player <- ggplot (df.binned, aes (x =xCoord ,
y =yCoord , col = pts, size = FGA)) + coord_fixed() +
geom_point() + scale_colour_gradient("Points/Attempt", low = "green", high="red")
考虑它的另一种方法是通过pts / attempt对plot(h, style="lattice")
中的六边形着色 - 但我也不确定如何做到这一点。
有没有办法让这个图形用六边形而不是圆圈?
答案 0 :(得分:9)
首先感谢您提出这个问题并以极大的想象力分享这个情节!
尝试使用lattice
包。主要是我实现了你的想法:通过pts / attempt“对图中的六边形着色(h,style =”lattice“)。格子的使用也是因为你可以在格子中使用grid
函数面板功能(例如绘制地面细节)
我生成了一些数据
dat <- data.frame(
xCoord = round(runif(1000,-30,30),2),
yCoord = round(runif(1000,-2,30),2),
pts = sample(c(0,2,3),100,rep=T))
#dat$pts[dat$xCoord <0 & dat$yCoord] <- 3
这里的情节:
xyplot(yCoord~xCoord,data =dat , panel = function(x,y,...)
{
hbin<-hexbin(dat$xCoord,dat$yCoord,xbins=50,IDs=TRUE)
mtrans<-hexTapply(hbin,dat$pts,sum,na.rm=TRUE)
cols <- rainbow( 4,alpha=0.5)
grid.hexagons(hbin, style='lattice',
,minarea=0.5,maxarea=5,colorcut=c(0,.6,1),
border=NA,
pen=cols[mtrans+1])
## Now you can get fun to draw the ground here
## something like...
## grid.circle(gp=gpar(fill=NA))
})
编辑使用OP real data。我得到了这个情节。您需要使用minarea
和``maxarea argument to define overlapping regions. I add also an image as abckground using
grid.raster`。我没有情节技巧所以我从网上选择一个,但你可以使用这种技术来增加一个基础。我相信你可以做一个更好的形象。
library(lattice)
library(hexbin)
library(png)
xyplot(locationY~locationX,data =dat , panel = function(x,y,...)
{
## imgae bakground
m <- readPNG('basket.png')
rimg <- as.raster(m)
grid.raster(rimg, x=0, y=61.5, just="top", width=50,
default.units = "native")
panel.fill(col=rgb(1,1,1,alpha=0.8))
hbin<-hexbin(dat$locationX,dat$locationY,xbins=50,IDs=TRUE)
mtrans<-hexTapply(hbin,dat$Points,sum,na.rm=TRUE)
cols <- rainbow(4)
grid.hexagons(hbin, style='lattice',
,minarea=0.1,maxarea=50,colorcut=c(0,.6,1),
border=NA,
pen=cols[mtrans+1])
})