Permalink
Browse files

Fixes to address new R CMD CHECK notes and warnings.

  • Loading branch information...
1 parent acdc8c2 commit 95a808133f60ae2fe9bb45951fc2896969508634 @jbryer committed Sep 25, 2013
Showing with 43 additions and 37 deletions.
  1. +1 −1 NAMESPACE
  2. +12 −6 R/align.R
  3. +2 −1 R/likert-package.R
  4. +6 −6 R/plot.histogram.R
  5. +14 −16 R/plot.likert.bar.r
  6. +1 −1 R/plot.likert.density.R
  7. +1 −1 R/plot.likert.heat.r
  8. +2 −2 R/plot.likert.r
  9. +2 −1 demo/likert.R
  10. +2 −2 likert.dev.R
View
@@ -14,7 +14,7 @@ export(reverse.levels)
export(shinyLikert)
import(ggplot2)
import(gridExtra)
-import(psych)
import(reshape)
import(tools)
import(xtable)
+importFrom(psych)
View
@@ -1,5 +1,11 @@
utils::globalVariables(c('llply'))
+.zeroGrob <- grob(cl="zeroGrob", name="NULL")
+widthDetails.zeroGrob <- heightDetails <- grobWidth.zeroGrob <- grobHeigth.zeroGrob <- function(x) { unit(0, "cm") }
+drawDetails.zeroGrob <- function(x, recording) {}
+is.zero <- function(x) { is.null(x) || inherits(x, "zeroGrob") }
+zeroGrob <- function() .zeroGrob
+
#' Adapted from ggExtra package which is no longer available. This is related to
#' an experimental mlpsa plot that will combine the circular plot along with
#' the two individual distributions.
@@ -64,41 +70,41 @@ align.plots <- function(gl, ...) {
plottitles <- lapply(dots, function(.g) {
if(!is.null(getGrob(.g, 'plot.title.text', grep=TRUE)))
editGrob(getGrob(.g, "plot.title.text", grep=TRUE), vp=NULL)
- else ggplot2:::.zeroGrob
+ else .zeroGrob
})
xtitles <- lapply(dots, function(.g) {
#.g <- ggplotGrob(.g)
if(!is.null(getGrob(.g, "axis.title.x.text", grep=TRUE)))
editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL)
- else ggplot2:::.zeroGrob
+ else .zeroGrob
})
xlabels <- lapply(dots, function(.g) {
#.g <- ggplotGrob(.g)
if(!is.null(getGrob(.g, "axis.text.x.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL)
- else ggplot2:::.zeroGrob
+ else .zeroGrob
})
ytitles <- lapply(dots, function(.g) {
#.g <- ggplotGrob(.g)
if(!is.null(getGrob(.g,"axis.title.y.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL)
- else ggplot2:::.zeroGrob
+ else .zeroGrob
})
ylabels <- lapply(dots, function(.g) {
#.g <- ggplotGrob(.g)
if(!is.null(getGrob(.g,"axis.text.y.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL)
- else ggplot2:::.zeroGrob
+ else .zeroGrob
})
legends <- lapply(dots, function(.g) {
if(!is.null(.g$children$legends))
editGrob(.g$children$legends, vp=NULL)
- else ggplot2:::.zeroGrob
+ else .zeroGrob
})
widths.left <- mapply(`+`, e1=lapply(ytitles, grobWidth),
View
@@ -5,7 +5,8 @@
#' @title Likert Analysis and Visualization
#' @author \email{jason@@bryer.org}
#' @keywords package institutional research likert
-#' @import reshape ggplot2 tools xtable gridExtra psych
+#' @import reshape ggplot2 tools xtable gridExtra
+#' @importFrom psych
NULL
#' Programme of International Student Assessment
View
@@ -51,9 +51,9 @@ likert.histogram.plot <- function(l,
items <- l$items
if(is.null(l$grouping)) {
hist <- nacount(items)
- hist$Item <- likert:::label_wrap_mod(hist$Item, width=wrap)
+ hist$Item <- label_wrap_mod(hist$Item, width=wrap)
hist$Item <- factor(hist$Item,
- levels=likert:::label_wrap_mod(order, width=wrap),
+ levels=label_wrap_mod(order, width=wrap),
ordered=TRUE)
p <- ggplot(hist, aes(x=Item, y=value, fill=missing))
@@ -63,7 +63,7 @@ likert.histogram.plot <- function(l,
p <- p +
geom_bar(data=hist[!hist$missing,], stat='identity') +
geom_hline(yintercept=0) +
- scale_y_continuous(label=likert:::abs_formatter) +
+ scale_y_continuous(label=abs_formatter) +
coord_flip() + ylab(xlab) + xlab('') +
theme(legend.position=legend.position) +
scale_fill_manual('',
@@ -78,9 +78,9 @@ likert.histogram.plot <- function(l,
hist <- rbind(hist, h)
}
- hist$Item <- likert:::label_wrap_mod(hist$Item, width=wrap)
+ hist$Item <- label_wrap_mod(hist$Item, width=wrap)
hist$Item <- factor(hist$Item,
- levels=likert:::label_wrap_mod(order, width=wrap),
+ levels=label_wrap_mod(order, width=wrap),
ordered=TRUE)
p <- ggplot(hist, aes(x=group, y=value, fill=missing))
@@ -90,7 +90,7 @@ likert.histogram.plot <- function(l,
p <- p +
geom_bar(data=hist[!hist$missing,], stat='identity') +
geom_hline(yintercept=0) +
- scale_y_continuous(label=likert:::abs_formatter) +
+ scale_y_continuous(label=abs_formatter) +
coord_flip() + ylab(xlab) + xlab('') +
scale_fill_manual('',
limits=c(TRUE,FALSE),
View
@@ -93,15 +93,15 @@ likert.bar.plot <- function(likert,
p <- NULL
if(!is.null(likert$grouping)) {
- lsum$Item <- likert:::label_wrap_mod(lsum$Item, width=wrap)
- likert$results$Item <- likert:::label_wrap_mod(likert$results$Item, width=wrap)
- names(likert$items) <- likert:::label_wrap_mod(names(likert$items), width=wrap)
- lsum$Group <- likert:::label_wrap_mod(lsum$Group, width=wrap.grouping)
+ lsum$Item <- label_wrap_mod(lsum$Item, width=wrap)
+ likert$results$Item <- label_wrap_mod(likert$results$Item, width=wrap)
+ names(likert$items) <- label_wrap_mod(names(likert$items), width=wrap)
+ lsum$Group <- label_wrap_mod(lsum$Group, width=wrap.grouping)
results <- melt(likert$results, id=c('Group', 'Item'))
results$variable <- factor(results$variable, ordered=TRUE)
results$Item <- factor(results$Item,
- levels=likert:::label_wrap_mod(names(likert$items), width=wrap),
+ levels=label_wrap_mod(names(likert$items), width=wrap),
ordered=TRUE)
ymin <- 0
@@ -200,10 +200,6 @@ likert.bar.plot <- function(likert,
if(ordered) {
order <- lsum[order(lsum$high),'Item']
results$Item <- factor(results$Item, levels=order)
- } else {
- results$Item <- factor(results$Item,
- levels=likert:::label_wrap_mod(names(likert$items), width=wrap),
- ordered=TRUE)
}
ymin <- 0
if(centered) {
@@ -266,31 +262,33 @@ likert.bar.plot <- function(likert,
if(plot.percents) {
lpercentpos <- ddply(results[results$value > 0,], .(Item), transform,
pos = cumsum(value) - 0.5*value)
- p <- p + geom_text(data=lpercentpos, aes(x=Item, y=pos, label=paste0(round(value), '%')),
- size=text.size)
+ p <- p + geom_text(data=lpercentpos, aes(x=Item, y=pos,
+ label=paste0(round(value), '%')),
+ 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, .(Item), transform,
pos = cumsum(value) - 0.5*value)
lpercentneg$pos <- lpercentneg$pos * -1
- p <- p + geom_text(data=lpercentneg, aes(x=Item, y=pos, label=paste0(round(abs(value)), '%')),
- size=text.size)
+ p <- p + geom_text(data=lpercentneg, aes(x=Item, y=pos,
+ label=paste0(round(abs(value)), '%')),
+ size=text.size)
}
}
p <- p +
coord_flip() + ylab('Percentage') + xlab('') +
theme(axis.ticks=element_blank())
if(!missing(group.order)) {
p <- p + scale_x_discrete(limits=rev(group.order),
- labels=likert:::label_wrap_mod(rev(group.order), width=wrap))
+ labels=label_wrap_mod(rev(group.order), width=wrap))
} else {
p <- p + scale_x_discrete(breaks=likert$results$Item,
- labels=likert:::label_wrap_mod(likert$results$Item, width=wrap))
+ labels=label_wrap_mod(likert$results$Item, width=wrap))
}
}
- p <- p + scale_y_continuous(label=likert:::abs_formatter,
+ p <- p + scale_y_continuous(label=abs_formatter,
limits=c(ymin - ybuffer, ymax + ybuffer))
p <- p + theme(legend.position=legend.position)
@@ -21,7 +21,7 @@ likert.density.plot <- function(likert,
lsum <- summary(likert)
items <- likert$items
items.density <- data.frame()
- labels <- likert:::label_wrap_mod(
+ labels <- label_wrap_mod(
paste0(levels(items[,1]), ' (', 1:likert$nlevels, ')'), width=10)
if(is.null(likert$grouping)) { #No Grouping
@@ -44,7 +44,7 @@ likert.heat.plot <- function(likert,
axis.ticks=element_blank(),
panel.background=element_blank()) +
scale_x_discrete(breaks=likert$results$Item,
- labels=likert:::label_wrap_mod(likert$results$Item, width=wrap))
+ labels=label_wrap_mod(likert$results$Item, width=wrap))
class(p) <- c('likert.heat.plot', class(p))
return(p)
}
View
@@ -71,7 +71,7 @@ plot.likert <- function(x, type=c('bar','heat','density'),
grid.newpage()
pushViewport( viewport( layout=grid_layout ) )
suppressWarnings({ #HACK to remove "Stacking not well defined when ymin != 0"
- likert:::align.plots(grid_layout,
+ align.plots(grid_layout,
list(p, 1, 1),
list(phist, 1, 2))
})
@@ -80,7 +80,7 @@ plot.likert <- function(x, type=c('bar','heat','density'),
grid.newpage()
pushViewport( viewport( layout=grid_layout ) )
suppressWarnings({ #HACK to remove "Stacking not well defined when ymin != 0"
- likert:::align.plots(grid_layout,
+ align.plots(grid_layout,
list(p, 1, 1),
list(phist, 2, 1))
})
View
@@ -52,7 +52,8 @@ plot(l24, type='density', facet=FALSE)
plot(l24, type='heat', wrap=30, text.size=4)
# Reverse the levels
-l24.reverse <- likert(items24, reverse.levels=TRUE)
+items24.reverse <- reverse.levels(items24)
+l24.reverse <- likert(items24.reverse)
print(l24.reverse)
plot(l24.reverse)
View
@@ -8,11 +8,11 @@ document("likert")
check_doc("likert")
install("likert")
check("likert")
-library(likert)
+require(likert)
ls('package:likert')
#Run shiny app. See also shinyLikert to run from the installed package.
-shiny::runApp('likert/inst/doc/shiny')
+shiny::runApp('likert/inst/shiny')
##### Data setup. We will use a few of the student items from North America PISA
require(pisa)

0 comments on commit 95a8081

Please sign in to comment.