Question

下面，我有R代码绘制一个类似的情节。

set.seed(1234)
library(e1071)
probs <- cbind(c(.4,.2/3,.2/3,.2/3,.4),c(.1/4,.1/4,.9,.1/4,.1/4),c(.2,.2,.2,.2,.2))
my.n <- 100
my.len <- ncol(probs)*my.n
raw <- matrix(NA,nrow=my.len,ncol=2)
raw <- NULL
for(i in 1:ncol(probs)){
  raw <- rbind(raw, cbind(i,rdiscrete(my.n,probs=probs[,i],values=1:5)))
}

r <- data.frame( cbind(
  as.numeric( row.names( tapply(raw[,2], raw[,1], mean) ) ),
  tapply(raw[,2], raw[,1], mean),
  tapply(raw[,2], raw[,1], mean) + sqrt( tapply(raw[,2], raw[,1], var)/tapply(raw[,2], raw[,1], length) ) * qnorm(1-.05/2,0,1),
  tapply(raw[,2], raw[,1], mean) - sqrt( tapply(raw[,2], raw[,1], var)/tapply(raw[,2], raw[,1], length) ) * qnorm(1-.05/2,0,1)
))
names(r) <- c("group","mean","ll","ul")

gbar <- tapply(raw[,2], list(raw[,2], raw[,1]), length)

sgbar <- data.frame( cbind(c(1:max(unique(raw[,1]))),t(gbar)) )

sgbar.likert<- sgbar[,2:6]



require(grid)
require(lattice)
require(latticeExtra)
require(HH)
sgbar.likert<- sgbar[,2:6]


yLabels = c(expression(a[1*x]),expression(b[2*x]),expression(c[3*x]))

likert(sgbar.likert,
       scales = list(y = list(labels = yLabels)),
       xlab="Percentage",
       main="Example Diverging Stacked Bar Chart for Likert Scale",
       BrewerPaletteName="Blues",
       sub="Likert Scale")

如下所示。但是，我想显示每个类别的百分比值，如下图所示。

我试过这个：

likert(sgbar.likert,
       scales = list(y = list(labels = yLabels)),
       xlab="Percentage",
       main="Example Diverging Stacked Bar Chart for Likert Scale",
       BrewerPaletteName="Blues",
       plot.percent.low=TRUE, # added this one
       plot.percent.high=TRUE, # added this one, too
       sub="Likert Scale")

但是，它没有任何影响，也没有任何差异。

那么，如何显示每个类别的百分比值？

Answer 1

AFAIK没有任何参数可以实现，所以你需要以这种方式定义一个自定义面板功能：

### just reproduce your input
library(HH)
sgbar.likert <- data.frame(X1 = c(34L, 7L, 13L),X2 = c(1L, 4L, 13L),
                           X3 = c(7L, 84L, 24L), X4 = c(7L, 2L, 27L), X5 = c(51L, 3L, 23L))
yLabels = c(expression(a[1*x]),expression(b[2*x]),expression(c[3*x]))
### 

# store the original col names used in custom panel function
origNames <- colnames(sgbar.likert)

# define a custom panel function
myPanelFunc <- function(...){
  panel.likert(...)
  vals <- list(...)
  DF <- data.frame(x=vals$x, y=vals$y, groups=vals$groups)

  ### some convoluted calculations here...
  grps <- as.character(DF$groups)
  for(i in 1:length(origNames)){
    grps <- sub(paste0('^',origNames[i]),i,grps)
  }

  DF <- DF[order(DF$y,grps),]

  DF$correctX <- ave(DF$x,DF$y,FUN=function(x){
    x[x < 0] <- rev(cumsum(rev(x[x < 0]))) - x[x < 0]/2
    x[x > 0] <- cumsum(x[x > 0]) - x[x > 0]/2
    return(x)
  })

  subs <- sub(' Positive$','',DF$groups)
  collapse <- subs[-1] == subs[-length(subs)] & DF$y[-1] == DF$y[-length(DF$y)]
  DF$abs <- abs(DF$x)
  DF$abs[c(collapse,FALSE)] <- DF$abs[c(collapse,FALSE)] + DF$abs[c(FALSE,collapse)]
  DF$correctX[c(collapse,FALSE)] <- 0
  DF <- DF[c(TRUE,!collapse),]

  DF$perc <- ave(DF$abs,DF$y,FUN=function(x){x/sum(x) * 100})
  ###

  panel.text(x=DF$correctX, y=DF$y, label=paste0(DF$perc,'%'), cex=0.7)
}

# plot passing our custom panel function
likert(sgbar.likert,
       scales = list(y = list(labels = yLabels)),
       xlab="Percentage",
       main="Example Diverging Stacked Bar Chart for Likert Scale",
       BrewerPaletteName="Blues",
       panel=myPanelFunc,
       sub="Likert Scale")

代码非常复杂，但关键是面板函数接收（在省略号...参数中）每个条形的x，y坐标对和每个条形图的组因子（组是原始Likert输入的列）。默认面板功能为panel.likert;因此，在调用之后，我们可以将更改添加到绘制的面板（在这种情况下，根据条形坐标的标签）。

看似简单，但有两个问题：

组是偶数时重新定义的，因此中央列（在本例中为"X3"）分为两组："X3"和"X3 Positive"。
绘制的条形图是“堆叠的”，因此要正确计算它们的中心（为了放置标签），您需要使用原始列名称排序来计算坐标的累积总和。

上面的代码完成了所有这些计算，希望以一种非常通用的方式（读取：你可以改变输入，它应该工作......）。

喜欢的情节显示百分比值

1 个答案: