Отображение процентного соотношения для каждой категории в столбчатых столбцах пропорций Ликерта с подтаблицей

Question

Я пытаюсь отобразить проценты на графике с подтаблицами для каждого из моих вариантов ответа в наборе данных типа Лайкерта, используя plot.likert () из пакета 'HH'.Цель графика - сравнить проценты внутри подгрупп населения, участвующего в опросе.Мой желаемый результат будет следующим:

Я получаю график с подтаблицами, используя код ниже

Пример кадра данных:

df <- data.frame ("Strongly_Disagree" =    c(1,28,5,33,18,14,8,9), "Disagree" = c(6,15,8,10,11,4,5,6),
"No_opinion" =c(4,3,8,10,9,20,45,2),
"Agree"=c(50,4,2,8,10,9,7,7),
"Strongly_Agree"=c(59,4,9,10,8,4,14,30),"Question" = c("CityA","CityB","CityC","Female","Male","Important","Not important","Neutral"),
"Subtable" = c("City","City","City","Gender","Gender","Attitude","Attitude","Attitude"))

Код для первого графика:

library("HH")
Plot1 <- likert(Question ~ . | Subtable, df,
     as.percent=TRUE,   
     ylab=NULL,
     main= 
       list("Multiple Panel Plot without Percentage Labeling",    x=unit(.35, "npc")), 

     strip.left=strip.custom(bg="gray85"),
     strip=FALSE,
     par.strip.text=list(cex=.6, lines=5),
     positive.order=TRUE,
     layout=c(1,3),  # Last number ist number of Subtables
     scales=list(y=list(relation="free")))

Мне также удается пометить проценты с помощью функции ниже (которая у меня есть из этого поста):

отображение процентного соотношения на категорию в столбчатых столбцах пропорций Ликерта

Я адаптировал функцию для округления процента до двух знаков после запятой.

myPanelFunc <- function(...){panel.likert(...)vals <- list(...) `DF <- data.frame(x=vals$x, y=vals$y, groups=vals$groups)` 
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(sprintf("%1.1f%%", DF$perc)), cex=0.7)}

Но проблема в том, что мне не удается объединить два кода, которые у меня естьУчасток с подтаблицами и процентной маркировкой.Есть ли способ, которым этот код может быть изменен для отображения процентов в графике с подтаблицами?Я был бы очень признателен за любую помощь в этом отношении, я не мог найти аргумент в описании пакета HH или где-либо еще в Интернете.Спасибо уже заранее!