Question

我是新手（很抱歉，如果这太基础但是）我试图使用来自＆＃39的plot.likert（）在Likert类型数据集中显示每个答案选项的百分比; HH＆＃39;包。并且，在某种程度上，我使用下面的代码（我从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   
)

我尝试通过在函数末尾包含以下代码行来解决这种过度绘图，就在调用panel.text（）之前，但是它会将其应用于每个零实例，即使fixed = gsub（）的T参数应该将精确的字符串作为替换标准。因此，如果应该有50％的＆＃39;绘制，我得到一个＆＃39; 5＆＃39;代替。 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

显示Likert堆积比例条形图中每个类别的百分比

1 个答案: