Fix grouped plot.percent labels

- jbryer#130
shirdekel · Oct 10, 2022 · d6d4254 · d6d4254
1 parent 6fc296a
commit d6d4254
Showing 1 changed file with 51 additions and 0 deletions.
diff --git a/R/plot.likert.bar.r b/R/plot.likert.bar.r
@@ -103,6 +103,7 @@ likert.bar.plot <- function(l,
 				if(include.center) {
 					tmp <- results[rows.mid,]
 					tmp$value <- tmp$value / 2 * -1
+          lpercentmid <- results[rows.mid, ]
 					results[rows.mid,'value'] <- results[rows.mid,'value'] / 2
 					results <- rbind(results, tmp)
 				} else {
@@ -165,6 +166,55 @@ likert.bar.plot <- function(l,
 		}
 		if(plot.percents) {
 			#warning('plot.percents is not currently supported for grouped analysis.')
+
+      if(centered) {
+        middle_response <- names(l$results)[center + 2]
+        lpercentpos <- results[results$value > 0, ]
+        lpercentpos <- ddply(lpercentpos, .(Group, Item), transform,
+                             pos = cumsum(value) - 0.5 * value
+                             )
+        lpercentpos <- lpercentpos[lpercentpos$variable != middle_response, ]
+        p <- p + geom_text(
+                   data = lpercentpos,
+                   aes(
+                     x = Group, y = pos,
+                     label = paste0(prettyNum(value, digits = digits, drop0trailing = drop0trailing, zero.print = zero.print), "%"),
+                     group = Item
+                   ), size = text.size
+                 )
+        lpercentneg <- results[results$value < 0, ]
+        if (nrow(lpercentneg) > 0) {
+          lpercentneg <- lpercentneg[nrow(lpercentneg):1, ]
+          lpercentneg$value <- abs(lpercentneg$value)
+          lpercentneg <-
+            ddply(lpercentneg,
+                  .(Group, Item),
+                  transform,
+                  pos = cumsum(value) - 0.5 * value
+                  )
+          lpercentneg$pos <- lpercentneg$pos * -1
+          lpercentneg <- lpercentneg[lpercentneg$variable != middle_response, ]
+          p <- p + geom_text(
+                     data = lpercentneg,
+                     aes(
+                       x = Group, y = pos,
+                       label = paste0(prettyNum(abs(value), digits = digits, drop0trailing = drop0trailing, zero.print = zero.print), "%")
+                     ),
+                     size = text.size
+                   )
+        }
+        if (include.center) {
+          lpercentmid$pos <- 0
+          p <- p + geom_text(
+                     data = lpercentmid,
+                     aes(
+                       x = Group, y = pos,
+                       label = paste0(prettyNum(abs(value), digits = digits, drop0trailing = drop0trailing, zero.print = zero.print), "%")
+                     ),
+                     size = text.size
+                   )
+        }
+      } else {
 			lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform,
 								 pos = cumsum(value) - 0.5 * value)
 			p <- p + geom_text(data = lpercentpos, 
@@ -186,6 +236,7 @@ likert.bar.plot <- function(l,
 								   label = paste0(prettyNum(abs(value), digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')),
 								   size = text.size)
 			}
+      }
 		}
 		p <- p + coord_flip() + ylab(ylabel) + xlab('') +
 			theme(axis.ticks=element_blank(),