r – 将填充值设为ggplot2中的实际填充

2019年7月21日 270次阅读

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

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")

最佳答案 有办法做到这一点,但它有点难看.

当我第一次看到它时,我想知道它是否可以使用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)

这是带有photoshopped图像的情节.我只是将它们保存在生成​​的imaage上,并运行脚本的后半部分以便不重新生成它们.

好的 – 然后因为它困扰我,我决定安装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)
点赞