r - 使填充的值成为ggplot2中的实际填充

Question

有没有办法让填充的值(标签)成为填充本身？例如，在堆积条形图中，我有

require(ggplot2)
big_votes_movies = movies[movies$votes > 100000,]
p = ggplot(big_votes_movies, aes(x=rating, y=votes, fill=year)) + geom_bar(stat="identity")

1997 年之类的值可以作为填充本​​身吗？一个主题情节，如果你愿意的话？主题图的示例是:

如果可能的话，我是否也可以在极坐标上绘制这些值，以便填充成为值？

p + coord_polar(theta="y")

Answer 1

有一种方法可以做到，但是有点难看。

当我第一次看到它时，我想知道是否可以使用 geom_text 来完成，但是虽然它给出了一种表示，但它并不真正适合主题结构。这是第一次尝试:

require(ggplot2)

big_votes_movies = movies[movies$votes > 100000,]
p <- ggplot(big_votes_movies, aes(x=rating, y=votes, label=year))
p + geom_text(size=12, aes(colour=factor(year), alpha=0.3)) + geom_jitter(alpha=0) + 
  scale_x_continuous(limits=c(8, 9.5))   + scale_y_continuous(limits=c(90000,170000)) 

然后我意识到你必须在 grid/ggplot 框架内实际渲染图像。你可以做到这一点，但你需要每年都有物理图像(我使用 ggplot 创建了基本图像，只是为了只使用一个工具，但也许 Photoshop 会更好!)，然后制作你自己的 grobs，你可以将其添加为自定义注释。然后，您需要制作自己的直方图箱并使用 apply 进行绘图。见下文(它可以很容易地美化)。遗憾的是仅适用于笛卡尔坐标:(

require(ggplot2)
require(png)
require(plyr)
require(grid)

years<-data.frame(year=unique(big_votes_movies$year))
palette(rainbow(nrow(years)))
years$col<-palette() # manually set some different colors

# create a function to write the "year" images
writeYear<-function(year,col){

  png(filename=paste(year,".png",sep=""),width=550,height=300,bg="transparent")
  im<-qplot(1,1,xlab=NULL,ylab=NULL) + 
    theme(axis.text.x = element_blank(),axis.text.y = element_blank()) +
    theme(panel.background = element_rect(fill = "transparent",colour = NA),     plot.background = element_rect(fill = "transparent",colour = NA), panel.grid.minor =     element_line(colour = "white")) +
    geom_text(label=year, size=80, color=col)
  print(im)
  dev.off()
}
#call the function to create the placeholder images
apply(years,1,FUN=function(x)writeYear(x["year"],x["col"]))

# then roll up the data
summarydata<-big_votes_movies[,c("year","rating","votes")]
# make own bins (a cheat)
summarydata$rating<-cut(summarydata$rating,breaks=c(0,8,8.5,9,Inf),labels=c(0,8,8.5,9))
aggdata <- ddply(summarydata, c("year", "rating"), summarise, votes  = sum(votes) )
aggdata<-aggdata[order(aggdata$rating),]
aggdata<-ddply(aggdata,.(rating),transform,ymax=cumsum(votes),ymin=c(0,cumsum(votes))[1:length(votes)])
aggdata$imgname<-apply(aggdata,1,FUN=function(x)paste(x["year"],".png",sep=""))

#work out the upper limit on the y axis
ymax<-max(aggdata$ymax)

#plot the basic chart
z<-qplot(x=10,y=10,geom="blank") + scale_x_continuous(limits=c(8,9.5)) + scale_y_continuous(limits=c(0,ymax))  

#make a function to create the grobs and call the annotation_custom function
callgraph<-function(df){
  tiles<-apply(df,1,FUN=function(x)return(annotation_custom(rasterGrob(image=readPNG(x["imgname"]),
                                                      x=0,y=0,height=1,width=1,just=c("left","bottom")),
                                                          xmin=as.numeric(x["rating"]),xmax=as.numeric(x["rating"])+0.5,ymin=as.numeric(x["ymin"]),ym    ax=as.numeric(x["ymax"]))))
      return(tiles)
    }

# then add the annotations to the plot
z+callgraph(aggdata)

这是经过 Photoshop 处理的图像的情节。我只是将它们保存在生成​​的图像上，然后运行脚本的后半部分，以免重新生成它们。

好的 - 然后因为它困扰我，我决定安装 extrafont 并仅使用 R 构建更漂亮的图表:

这是代码:

  require(ggplot2)
  require(png)
  require(plyr)
  require(grid)
  require(extrafont)

  #font_import(pattern="Show") RUN THIS ONCE ONLY
  #load the fonts
  loadfonts(device="win")

  #create a subset of data with big votes
  big_votes_movies = movies[movies$votes > 100000,]

  #create a custom palette and append to a table of the unique years (labels) 
  years<-data.frame(year=unique(big_votes_movies$year))
  palette(rainbow(nrow(years)))
  years$col<-palette()

  #function to create the labels as png files
  writeYear<-function(year,col){

    png(filename=paste(year,".png",sep=""),width=440,height=190,bg="transparent")
    im<-qplot(1,1,xlab=NULL,ylab=NULL,geom="blank") + 
      geom_text(label=year,size=70, family="Showcard Gothic", color=col,alpha=0.8) +
      theme(axis.text.x = element_blank(),axis.text.y = element_blank()) +
      theme(panel.background = element_rect(fill = "transparent",colour = NA), 
            plot.background = element_rect(fill = "transparent",colour = NA), 
            panel.grid.minor = element_line(colour = "transparent"), 
            panel.grid.major = element_line(colour = "transparent"),
            axis.ticks=element_blank())
    print(im)
    dev.off()
  }

  #call the function to create the placeholder images
  apply(years,1,FUN=function(x)writeYear(x["year"],x["col"]))

  #summarize the data, and create bins manually
  summarydata<-big_votes_movies[,c("year","rating","votes")]
  summarydata$rating<-cut(summarydata$rating,breaks=c(0,8,8.5,9,Inf),labels=c(0,8,8.5,9))

  aggdata <- ddply(summarydata, c("year", "rating"), summarise, votes  = sum(votes) )
  aggdata<-aggdata[order(aggdata$rating),]
  aggdata<-ddply(aggdata,.(rating),transform,ymax=cumsum(votes),ymin=c(0,cumsum(votes))[1:length(votes)])
  #identify the image placeholders
  aggdata$imgname<-apply(aggdata,1,FUN=function(x)paste(x["year"],".png",sep=""))
  ymax<-max(aggdata$ymax)

  #do the basic plot
  z<-qplot(x=10,y=10,geom="blank",xlab="Rating",ylab="Votes \n",main="Big Movie Votes \n") + 
    theme_bw() +
    theme(panel.grid.major = element_line(colour = "transparent"),
          text = element_text(family="Kalinga", size=20,face="bold")        
          ) +
    scale_x_continuous(limits=c(8,9.5)) + 
    scale_y_continuous(limits=c(0,ymax))  

  #creat a function to create the grobs and return annotation_custom() calls
  callgraph<-function(df){
    tiles<-apply(df,1,FUN=function(x)return(annotation_custom(rasterGrob(image=readPNG(x["imgname"]),
                                                        x=0,y=0,height=1,width=1,just=c("left","bottom")),
                                                 xmin=as.numeric(x["rating"]),xmax=as.numeric(x["rating"])+0.5,ymin=as.numeric(x["ymin"]),ymax=as.numeric(x["ymax"]))))
    return(tiles)
  }
  #add the tiles to the base chart
  z+callgraph(aggdata)