From 5bf9b1eb544fde8b6bd9939dd52a40a70ed00081 Mon Sep 17 00:00:00 2001 From: Jason Bryer Date: Wed, 6 Mar 2019 13:07:57 -0500 Subject: [PATCH] Changed precent formatting to use prettyNum. Added digits, drop0trailing, and zero.print parameters (pass through). --- R/likert.options.R | 11 ++++++++++- R/plot.likert.bar.r | 31 ++++++++++++++++++------------- man/likert.Rd | 2 +- man/likert.options.Rd | 9 ++++++++- 4 files changed, 37 insertions(+), 16 deletions(-) diff --git a/R/likert.options.R b/R/likert.options.R index e0dd233..d863a2c 100644 --- a/R/likert.options.R +++ b/R/likert.options.R @@ -28,6 +28,9 @@ #' Possible values are \code{v} (vertical, the default), \code{h} #' (horizontal), and \code{NULL} (auto fill horizontal and vertical) #' @param panel.strip.color the background color for panel labels. +#' @param digits the number of significant digits to print. +#' @param drop0trailing logical, indicating if trailing zeros, i.e., "0" after the decimal mark, should be removed +#' @param zero.print logical, character string or NULL specifying if and how zeros should be formatted specially. #' @param ... included for future expansion. #' #' @export @@ -52,6 +55,9 @@ likert.options <- function( legend.position='bottom', panel.arrange='v', panel.strip.color='#F0F0F0', + digits = 0, + drop0trailing = FALSE, + zero.print = TRUE, ... ) { opts <- list( @@ -74,7 +80,10 @@ likert.options <- function( legend = legend, legend.position = legend.position, panel.arrange = panel.arrange, - panel.strip.color = panel.strip.color + panel.strip.color = panel.strip.color, + digits = digits, + drop0trailing = drop0trailing, + zero.print = zero.print ) return(opts) diff --git a/R/plot.likert.bar.r b/R/plot.likert.bar.r index dd81133..951fc66 100644 --- a/R/plot.likert.bar.r +++ b/R/plot.likert.bar.r @@ -137,23 +137,24 @@ likert.bar.plot <- function(l, if(plot.percent.low) { p <- p + geom_text(data=lsum, y=ymin, aes(x=Group, - label=paste0(round(low), '%'), group=Item), + label=paste0(prettyNum(low, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%'), + group=Item), size=text.size, hjust=1, color=text.color) } if(plot.percent.high) { p <- p + geom_text(data=lsum, aes(x=Group, y=100, - label=paste0(round(high), '%'), + label=paste0(prettyNum(high, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%'), group=Item), size=text.size, hjust=-.2, color=text.color) } if(plot.percent.neutral & l$nlevels %% 2 == 1 & include.center) { if(centered) { p <- p + geom_text(data=lsum, y=0, aes(x=Group, group=Item, - label=paste0(round(neutral), '%')), + label=paste0(prettyNum(neutral, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, hjust=.5, color=text.color) } else { lsum$y <- lsum$low + (lsum$neutral/2) p <- p + geom_text(data=lsum, aes(x=Group, y=y, group=Item, - label=paste0(round(neutral), '%')), + label=paste0(prettyNum(neutral, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, hjust=.5, color=text.color) } } @@ -162,7 +163,8 @@ likert.bar.plot <- function(l, lpercentpos <- ddply(results[results$value > 0,], .(Group, Item), transform, pos = cumsum(value) - 0.5 * value) p <- p + geom_text(data = lpercentpos, - aes(x = Group, y = pos, label = paste0(round(value), '%'), + 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) { @@ -175,7 +177,8 @@ likert.bar.plot <- function(l, pos = cumsum(value) - 0.5 * value) lpercentneg$pos <- lpercentneg$pos * -1 p <- p + geom_text(data = lpercentneg, - aes(x = Group, y = pos, label = paste0(round(abs(value)), '%')), + aes(x = Group, y = pos, + label = paste0(prettyNum(abs(value), digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size = text.size) } } @@ -264,25 +267,27 @@ likert.bar.plot <- function(l, } if(plot.percent.low) { p <- p + geom_text(data=lsum, y=ymin, aes(x=Item, - label=paste0(round(low), '%')), + label=paste0(prettyNum(low, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, hjust=1, color=text.color) } if(plot.percent.high) { p <- p + geom_text(data=lsum, y=100, aes(x=Item, - label=paste0(round(high), '%')), + label=paste0(prettyNum(high, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, hjust=-.2, color=text.color) } if(plot.percent.neutral & l$nlevels %% 2 == 1 & include.center & !plot.percents) { if(centered) { p <- p + geom_text(data=lsum, y=0, - aes(x=Item, label=paste0(round(neutral), '%')), + aes(x=Item, + label=paste0(prettyNum(neutral, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, hjust=.5, color=text.color) } else { lsum$y <- lsum$low + (lsum$neutral/2) p <- p + geom_text(data=lsum, - aes(x=Item, y=y, label=paste0(round(neutral), '%')), + aes(x=Item, y=y, + label=paste0(prettyNum(neutral, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, hjust=.5, color=text.color) } } @@ -295,7 +300,7 @@ likert.bar.plot <- function(l, pos = cumsum(value) - 0.5*value) p <- p + geom_text(data=lpercentpos[lpercentpos$variable != center.label,], aes(x=Item, y=pos, - label=paste0(round(value), '%')), + label=paste0(prettyNum(value, digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, color=text.color) lpercentneg <- results[results$value < 0,] if(nrow(lpercentneg) > 0) { @@ -306,14 +311,14 @@ likert.bar.plot <- function(l, lpercentneg$pos <- lpercentneg$pos * -1 p <- p + geom_text(data=lpercentneg[lpercentneg$variable != center.label,], aes(x=Item, y=pos, - label=paste0(round(abs(value)), '%')), + label=paste0(prettyNum(abs(value), digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, color=text.color) } lpercentneutral <- results[results$variable == center.label,] if(nrow(lpercentneutral) > 0) { p <- p + geom_text(data=lpercentneutral, aes(x=Item, y=0, - label=paste0(round(abs(value * 2)), '%')), + label=paste0(prettyNum(abs(value * 2), digits=digits, drop0trailing=drop0trailing, zero.print=zero.print), '%')), size=text.size, color=text.color) } } diff --git a/man/likert.Rd b/man/likert.Rd index e4d6a86..b41834a 100644 --- a/man/likert.Rd +++ b/man/likert.Rd @@ -5,7 +5,7 @@ \title{Analyze Likert type items.} \usage{ likert(items, summary, grouping = NULL, factors = NULL, importance, - nlevels = length(levels(items[, 1]))) + nlevels = length(levels(items[[1]]))) } \arguments{ \item{items}{data frame containing the likert based items. The variables diff --git a/man/likert.options.Rd b/man/likert.options.Rd index 1ad5ecc..2f883ca 100644 --- a/man/likert.options.Rd +++ b/man/likert.options.Rd @@ -11,7 +11,8 @@ likert.options(low.color = "#D8B365", high.color = "#5AB4AC", text.color = "black", centered = TRUE, include.center = TRUE, ordered = TRUE, wrap = 50, wrap.grouping = 50, legend = "Response", legend.position = "bottom", - panel.arrange = "v", panel.strip.color = "#F0F0F0", ...) + panel.arrange = "v", panel.strip.color = "#F0F0F0", digits = 0, + drop0trailing = FALSE, zero.print = TRUE, ...) } \arguments{ \item{low.color}{color for low values.} @@ -61,6 +62,12 @@ Possible values are \code{v} (vertical, the default), \code{h} \item{panel.strip.color}{the background color for panel labels.} +\item{digits}{the number of significant digits to print.} + +\item{drop0trailing}{logical, indicating if trailing zeros, i.e., "0" after the decimal mark, should be removed} + +\item{zero.print}{logical, character string or NULL specifying if and how zeros should be formatted specially.} + \item{...}{included for future expansion.} } \description{