在likert堆叠式比例直方图中显示每个类别的百分比

Question

我是新手（非常抱歉，如果这太基本了，但是）我试图在Likert类型数据集中使用plot.likert显示每个答案选项的百分比（）来自'HH'包。而且，在某种程度上，我使用下面的代码（我从likert plot showing percentage values中得到）得到了期望的结果，但问题是，如果没有特定类别的值（= 0％），则会与％中央类别的价值。 see my output here

• 是否有使这一代码可以被修改，以防止这种情况的发生（例如，不显示类别百分比即等于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 
) 

我试图解决这个overplotting在调用panel.text（）之前，在函数末尾添加了一行代码，但是它将该代码应用于每个零实例，即使gsub（）的fixed = T参数应该将确切的字符串作为更换标准。所以在应该有'50％'的情况下，我只能得到'5'。 my output with this fix

new.labels = paste0(DF$perc,'%') 
new.labels = gsub("0%", " ", new.labels, fixed = T) 

我真的很感激任何帮助在这方面，我无法找到，将做到这一点plot.likert（）函数的参数，但正如我所说，我不是真的经历这种事情。

Answer 1

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

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