在R图形中的图例中包含小表

编程问答 2022-04-26

问题描述

| 我正在绘制按国家/地区分组的公司的销售点图。所以我的代码是
dotchart(sales,labels=company,groups=country,data=mydata)
。我还创建了一个按国家/地区划分的平均销售额的表格。有没有办法将此表作为点图内的图例包括在内？ 四个小时后...我偶然发现了一种非常整洁的方法，可以使用
plotrix
软件包中的
addtable2plot
命令将图表信息添加到绘图中。跟进chl的示例： 
res <- matrix(nc=3,nr=4)
for (i in 1:4) res[i,] <- tapply(iris[,i],iris[,5],mean)
colnames(res) <- levels(iris[,5])
rownames(res) <- colnames(iris)[1:4]

library(plotrix)
dotchart(res,auto.key=list(position=\"top\",column=3),xlab=\"Mean\"); addtable2plot(3,15,res,cex=.8)
    

解决方法

        这是我的看法
grid
（和虹膜数据集）： 
library(lattice)
library(grid)
library(gridExtra)
res <- matrix(nc=3,nr=4)
for (i in 1:4) res[i,] <- tapply(iris[,i],iris[,5],mean)
colnames(res) <- levels(iris[,5])
rownames(res) <- colnames(iris)[1:4]
dp <- dotplot(res,auto.key=list(position=\"top\",column=3),xlab=\"Mean\")

pdf(\"1.pdf\",width=10,height=5)
grid.newpage() 
pushViewport(viewport(layout=grid.layout(1,2,widths=unit(c(5,4),\"inches\"))))

pushViewport(viewport(layout.pos.col=1,layout.pos.row=1)) 
print(dp,newpage=FALSE) 
popViewport(1)

pushViewport(viewport(layout.pos.col=2,layout.pos.row=1,clip=\"on\"))
grid.draw(tableGrob(head(iris),gp=gpar(fontsize=6,lwd=.5)))
popViewport()
dev.off()
在Hadley Wickham的github页面上可以找到仅用ѭ6表示的另一种解决方案，将ggplot2图与其他图形输出混合。最后，ѭ7的在线帮助页面还包含其他示例。 为了显示图中的表格，我们可以修改代码，如下所示： 
grid.newpage() 
pushViewport(viewport(layout=grid.layout(1,1,newpage=FALSE) 
popViewport(1)

pushViewport(viewport(x=0.5,y=0.3,clip=\"off\"))
grid.draw(tableGrob(head(iris),padding.v=unit(1,\"mm\"),padding.h=unit(1,lwd=.5)))
popViewport()
产生 （调用
tableGrob()
时可使用ѭ9changed更改单元格的背景色。）     ,        也许一个选择是将图例转换为表格： 
library(dplyr)
library(stringr)
library(ggplot2)
windowsFonts(CourierNew=windowsFont(\"Courier New\")) # ONLY FOR WINDOWS

#1. GET THE SUMMARY STATS FROM YOUR TABLE
data<-iris %>% group_by(Species) %>% 
  summarise(Sepal.Len = paste(format(round(median(Sepal.Length),2),nsmall=2) ),P.len = tryCatch(paste(format(round(median(Petal.Length),error = function(e) {\"NA\" ; \"NA\"} ),counts=n() )


data<-as.data.frame(data)
data
#      Species Sepal.Len P.len counts
# 1     setosa      5.00  1.50     50
# 2 versicolor      5.90  4.35     50
# 3  virginica      6.50  5.55     50

# 2. CREATE THE TITLE OF THE LEGEND BASED ON YOUR STATS
  make.title.legend <- function(data) {
  list<-list()
  x<-1
  nchar1<-max(nchar(as.character(data[,x])) )
  nchar2<-nchar(colnames(data)[x])
  maxdif<-max(c(nchar2,nchar1))-min(c(nchar2,nchar1))
  first <-  paste0(colnames(data)[x],sep=paste(replicate(maxdif,\" \"),collapse = \"\")) 
  list[[first]] <-first
  for (i in 1:(ncol(data)-1)) {
    x<-i+1
    nchar1<-max(nchar(as.character(data[,x])) )
    nchar2<-nchar(colnames(data)[x])
    maxdif<-if(nchar2>nchar1){0} else {nchar1-nchar2}#
    first <-  paste0(colnames(data)[x],collapse = \"\")) 
    list[[first]] <-first
    title<-str_c(list,collapse = \" \")
  }
  return(title)
}

title<-make.title.legend(data)
title
#[1] \"Species    Sepal.Len P.len counts\"

# 3. CONCATENATE STAT COLUMNS IN A NEW JUSTIFIED COLUMN WITH ALL STATS
make.legend.withstats <- function(data,namecol) {
  nchar1<-nchar(as.character(data[,1])) 
  nchar2<-nchar(colnames(data)[1])
  maxlen<-max(c(nchar1,nchar2))
  data[,1]<-sprintf(paste0(\"%-\",maxlen,\"s\"),data[,1])    
  data[,ncol(data)+1]<-paste(data[,1],2],sep=\" \")
  ncharmin2<-min(nchar(data[,2]))
  y<- ncharmin2-1
  nchara1<-nchar(data[,ncol(data)] ) # 7
  init1<-min(nchara1)
  y2<-init1-1
  minchar<-min(nchar(data[,2]))
  maxchar<-max(c(nchar(colnames(data)[2]),(nchar(data[,2]))))
  dif<-maxchar-minchar
  if (dif>0){ 
    for (i3 in minchar:(maxchar-1)) { 
      y2<-y2+1
      y<-y+1
      str_sub(data[nchar(data[,ncol(data)]) == y2,][,ncol(data)],y2-y,y2-y)<- \"  \"
    } 
  }
  nd<-ncol(data)-2
  if(ncol(data)>3){ 
    for (i in 2:nd) {  
      x3<-i
      data[,x3+1],sep=\" \")  
      minchar<-min(nchar(data[,x3+1]))
      maxchar<-max(c(nchar(colnames(data)[x3+1]),x3+1]))))
      ncharmin2<-min(nchar(data[,x3+1]))
      y<- ncharmin2-1
      nchara1<-nchar(data[,ncol(data)] ) 
      init1<-min(nchara1)
      y2<-init1-1
      dif<-maxchar-minchar
      if (dif>0){ 
        for (i2 in minchar:(maxchar-1)) { 
          y2<-y2+1
          y<-y+1
          str_sub(data[nchar(data[,y2-y)<- \"  \"
        }
      }
    }
  }
    data<-  as.data.frame(data[,c(1,ncol(data))])
    names(data)[2]<-paste(namecol)
    data[,1]<-gsub(\"\\\\s+$\",\"\",1]) 
    data
}   
newlabel<-make.legend.withstats(data,title)
newlabel

#     Species Species    Sepal.Len P.len counts
# 1     setosa     setosa     5.00      1.50  50
# 2 versicolor     versicolor 5.90      4.35  50
# 3  virginica     virginica  6.50      5.55  50

# 4. MERGE ORIGINAL DATAFRAME WITH DATAFRAME WITH STATS
newirislabel=merge(iris,newlabel,all.x = TRUE)
head(newirislabel)
#  Species Sepal.Length Sepal.Width Petal.Length Petal.Width Species    Sepal.Len P.len counts
#1  setosa          5.1         3.5          1.4         0.2     setosa     5.00      1.50  50

# 5. GRAPH
g1 <- ggplot(newirislabel,aes(Sepal.Length,Petal.Length,colour=as.factor(newirislabel[,ncol(newirislabel)] ) ) )   
g2 <- g1+ guides(color = guide_legend(keywidth = 1,keyheight = 1)) # for histogram use guides(fill =
g3 <- g2+ geom_point() + labs(color=paste0(\"   \",title) )+ theme(legend.position=c(0.75,0.15),legend.direction=\"vertical\"
)+ theme(legend.title=element_text(family=\"CourierNew\",size=rel(1),face = \"italic\"),legend.text=element_text(family=\"CourierNew\",size=rel(1))) + labs(x = \"Sepal len\",y = \" Petal len \")
g3
    
包含包含图例图形图形图形小表