在likert堆叠比例条形图中显示每个类别的百分比

我是一个新手（如果这太基本了，很抱歉），我正在尝试使用“HH”包中的plot.Likert（）在Likert类型的数据集中显示我的每个答案选项的百分比。在某种程度上，我使用下面的代码（我取自代码）得到了期望的结果，但问题是，如果某个特定类别没有值（=0%），那么这将与中心类别的%值冲突

• 是否有办法修改此代码以防止发生这种情况（例如，不显示等于0的类别百分比，或将它们并排放置）

我的df看起来像这样：

      Question Entirely Disagree Disagree Neutral Agree Entirely Agree
TQ_3      TQ_3                 3        4       4     2              1
TQ_4      TQ_4                 1        2       6     5              0
TQ_5      TQ_5                 2        3       3     5              1
TQ_6      TQ_6                 5        5       0     3              1
TQ_7      TQ_7                 0        1       1     6              6
TQ_8      TQ_8                 0        2       0     7              5
TQ_9      TQ_9                 2        1       4     3              4
TQ_10    TQ_10                 2        5       3     2              2

我使用的整个代码如下：

# store the original col names used in custom panel function
origNames = colnames(summd_trDat)

# 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 <- round(ave(DF$abs,DF$y,FUN=function(x){x/sum(x) * 100}), 0)
  ###

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

# plot passing our custom panel function
plot.likert(summd_trDat,
            as.percent=TRUE, 
            main = "Graph title",
            xlab = "Percent",  
            positive.order = F, 
            ylab = "Question",    
            key.border.white=F,
            panel=myPanelFunc,    # ***
            rightAxis=F   
)

---

我非常感谢在这方面提供的任何帮助，我在plot.likert（）函数中找不到可以这样做的参数，但正如我所提到的，我对这类事情没有太多经验

您应该只替换自定义函数中关于标签的部分

library(HH)

text <- "ID Question Entirely_Disagree Disagree Neutral Agree Entirely_Agree
TQ_3      TQ_3                 3        4       4     2              1
TQ_4      TQ_4                 1        2       6     5              0
TQ_5      TQ_5                 2        3       3     5              1
TQ_6      TQ_6                 5        5       0     3              1
TQ_7      TQ_7                 0        1       1     6              6
TQ_8      TQ_8                 0        2       0     7              5
TQ_9      TQ_9                 2        1       4     3              4
TQ_10    TQ_10                 2        5       3     2              2"

df <- read.table(text=text, header = TRUE)


origNames = colnames(df)

# 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 <- round(ave(DF$abs,DF$y,FUN=function(x){x/sum(x) * 100}), 0)


  ## Here goes 6 lines that have been changes - AK
  # here we modify the column with labels a bit:
  DF$perc <- paste0(DF$perc,'%')
  # change all "0%" to blanks
  DF$perc[DF$perc == "0%"] <- ""
  # the argument label is a bit modified too
  panel.text(x=DF$correctX, y=DF$y, label=DF$perc, cex=0.7)
}

# plot passing our custom panel function
p <- plot.likert(df,
            as.percent=TRUE, 
            main = "Graph title",
            xlab = "Percent",  
            positive.order = F,
            ylab = "Question",    
            key.border.white=F,
            panel=myPanelFunc,  
            rightAxis=F   
)

p

库（HH）
短信嘿，你到底想要什么还不清楚。你能把你的结果的图片（图表）和你想要的结果贴出来吗？你好，非常感谢你的关注。因为我是这个社区的新成员，所以我不能发布图片，但应该有一个链接“我的输出…”如果你看图表，中心的一些百分比无法读取，因为在同一位置显示的百分比不止一个。我想知道是否有办法解决这个问题。（我希望我说得更清楚些。）非常感谢你！这比我想象的要简单得多；-）我真的很感谢你抽出时间来回复我的帖子。希望其他尝试做类似事情的人也能从中受益。
library(HH)

text <- "ID Question Entirely_Disagree Disagree Neutral Agree Entirely_Agree
TQ_3      TQ_3                 3        4       4     2              1
TQ_4      TQ_4                 1        2       6     5              0
TQ_5      TQ_5                 2        3       3     5              1
TQ_6      TQ_6                 5        5       0     3              1
TQ_7      TQ_7                 0        1       1     6              6
TQ_8      TQ_8                 0        2       0     7              5
TQ_9      TQ_9                 2        1       4     3              4
TQ_10    TQ_10                 2        5       3     2              2"

df <- read.table(text=text, header = TRUE)


origNames = colnames(df)

# 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 <- round(ave(DF$abs,DF$y,FUN=function(x){x/sum(x) * 100}), 0)


  ## Here goes 6 lines that have been changes - AK
  # here we modify the column with labels a bit:
  DF$perc <- paste0(DF$perc,'%')
  # change all "0%" to blanks
  DF$perc[DF$perc == "0%"] <- ""
  # the argument label is a bit modified too
  panel.text(x=DF$correctX, y=DF$y, label=DF$perc, cex=0.7)
}

# plot passing our custom panel function
p <- plot.likert(df,
            as.percent=TRUE, 
            main = "Graph title",
            xlab = "Percent",  
            positive.order = F,
            ylab = "Question",    
            key.border.white=F,
            panel=myPanelFunc,  
            rightAxis=F   
)

p