Question

我正在为按国家/地区分组的公司绘制销售点图。所以我的代码是dotchart(sales, labels=company, groups=country, data=mydata)。我还创建了一个按国家/地区划分的平均销售额表。有没有办法在dotplot中包含此表作为图例？

四小时后......我偶然发现了一种使用addtable2plot包中的plotrix命令向表格添加表格信息的非常简洁的方法。跟进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)

Answer 1

以下是我的grid（以及Iris数据集）：

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

enter image description here

只有ggplot2的另一个解决方案可以在Hadley Wickham的github页面Mixing ggplot2 graphs with other graphical output上找到。最后，gridExtra::grid.arrange()的在线帮助页面包含其他示例。

要在图表中显示表格，我们可以按如下方式修改代码：

grid.newpage() 
pushViewport(viewport(layout=grid.layout(1, 1, widths=unit(c(5,4), "inches"))))

pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) 
print(dp, 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, "mm"), 
          gp=gpar(fontsize=6, lwd=.5)))
popViewport()

产生

enter image description here

（调用theme=时，可以使用tableGrob()更改单元格的背景颜色。）

Answer 2

也许一个选择是将图例转换为表格：

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),2),nsmall=2) ),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], sep=paste(replicate(maxdif, " "), 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],data[,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[,ncol(data)+1]<-paste(data[,ncol(data)],data[,x3+1],sep=" ")  
      minchar<-min(nchar(data[,x3+1]))
      maxchar<-max(c(nchar(colnames(data)[x3+1]),(nchar(data[,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[,ncol(data)]) == y2, ][,ncol(data)], y2-y, y2-y)<- "  "
        }
      }
    }
  }
    data<-  as.data.frame(data[,c(1,ncol(data))])
    names(data)[2]<-paste(namecol)
    data[,1]<-gsub("\\s+$", "", data[,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

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

2 个答案: