Permalink
Browse files

Fixes to pass R CMD CHECK

  • Loading branch information...
1 parent 6968b52 commit 2b633803acec116bc0d5923ca3861c74a06bcd8e @jbryer committed Sep 20, 2013
View
@@ -2,7 +2,7 @@ Package: likert
Type: Package
Title: Functions to analyze and visualize likert type items
Version: 1.1
-Date: 2012-05-04
+Date: 2013-09-20
Author: Jason Bryer <jason@bryer.org>, Kimberly Speerschneider
<kimkspeer@gmail.com>
Maintainer: Jason Bryer <jason@bryer.org>
@@ -12,15 +12,11 @@ Description: Functions to analyze and visualize likert type itemss
License: GPL
LazyLoad: yes
Depends:
- R (>= 3.0),
- ggplot2,
- xtable,
- psych,
- reshape
+ R (>= 3.0),ggplot2,gridExtra,xtable
+Imports:
+ reshape,psych
Suggests:
- devtools,
- shiny,
- gridExtra
+ devtools,shiny
Collate:
'likert-package.R'
'likert.R'
View
@@ -1,6 +1,7 @@
S3method(plot,likert)
S3method(print,likert)
S3method(print,likert.bar.plot)
+S3method(print,xlikert)
S3method(summary,likert)
S3method(xtable,likert)
export(likert)
@@ -12,6 +13,8 @@ export(recode)
export(reverse.levels)
export(shinyLikert)
import(ggplot2)
+import(gridExtra)
+import(psych)
import(reshape)
import(tools)
import(xtable)
View
@@ -1,3 +1,5 @@
+utils::globalVariables(c('llply'))
+
#' 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.
View
@@ -5,7 +5,7 @@
#' @title Likert Analysis and Visualization
#' @author \email{jason@@bryer.org}
#' @keywords package institutional research likert
-#' @import reshape ggplot2 tools xtable
+#' @import reshape ggplot2 tools xtable gridExtra psych
NULL
#' Programme of International Student Assessment
View
@@ -1,3 +1,5 @@
+utils::globalVariables(c('group'))
+
#' Histogram of number of responses.
#'
#' Plots a histogram of the number of responses for each item and group (if specified).
View
@@ -1,4 +1,5 @@
-utils::globalVariables(c('value','Group','variable','low','Item','high','neutral','x','y'))
+utils::globalVariables(c('value','Group','variable','low','Item','high',
+ 'neutral','x','y','pos','ddply','.'))
#' Bar Plot for Likert Items.
#'
View
@@ -56,7 +56,6 @@ plot.likert <- function(x, type=c('bar','heat','density'),
if(include.histogram) {
if(type[1] == 'bar') {
- require(gridExtra)
item.order <- attr(p, 'item.order')
phist <- likert.histogram.plot(x,
legend.position=legend.position,
View
@@ -20,74 +20,108 @@
#' <= 3 are low levels and >= 4 are high levels (i.e. used for forced choice
#' items or those without a neutral option). This also influences which levels
#' are summarized in the low and high groups.
+#' @param ordered whether the results should be ordered. See \code{\link{summary.likert}}
#' @param ... other parameters passed to \link{xtable}.
#' @seealso \link{xtable}, \link{print.xtable}
#' @S3method xtable likert
#' @method xtable likert
-
-xtable.likert <- function(x, caption=NULL, label=NULL, align=NULL, digits=NULL,
- display=NULL, include.n=TRUE, include.mean=TRUE, include.sd=TRUE,
- include.low=TRUE, include.neutral=TRUE, include.high=TRUE,
- include.levels=TRUE, include.missing=TRUE,
- center=(x$nlevels-1)/2 + 1, ordered=TRUE,...) {
- if(!is.null(x$grouping)){
- tab<-data.frame()
- for(g in unique(x$results$Group)){
- s<-summary(x, center=center,ordered=ordered)
- s<-s[which(s$Group==g),]
- gtab<-as.data.frame(cbind(as.character(s$Group),as.character(s$Item)))
- names(gtab)<-c('Group','Item')
- missing<-as.numeric()
- for(i in 1:ncol(x$items)){
- missing<- c(missing, prop.table(table(is.na(x$items[i])))[2])
- }
- names(missing)<-NULL
- if(include.n){gtab<-cbind(gtab, rep(nrow(x$items),length(x$items)))
- names(gtab)<-c(names(gtab[1:ncol(gtab)-1]),'n')
- gtab$n<-as.integer(gtab$n-(gtab$n*missing))}
- if(include.mean){gtab<-cbind(gtab, s$mean)
- names(gtab)<-c(names(gtab[1:ncol(gtab)-1]),'mean')}
- if(include.sd){gtab<-cbind(gtab, s$sd)
- names(gtab)<-c(names(gtab[1:ncol(gtab)-1]),'sd')}
- if(include.low){gtab<-cbind(gtab,s$low)
- names(gtab)<-c(names(gtab[1:ncol(gtab)-1]),'low')}
- if(include.neutral){gtab<-cbind(gtab, s$neutral)
- names(gtab)<-c(names(gtab[1:ncol(gtab)-1]),'neutral')}
- if(include.high){gtab<-cbind(gtab, s$high)
- names(gtab)<-c(names(gtab[1:ncol(gtab)-1]),'high')}
- tab<-rbind(tab,gtab)
-# hline <- c(-1,0, nrow(tab))
- }
- }else{
- s<-summary(x, center=center,ordered=ordered)
- tab<-as.data.frame(as.character(s$Item))
- names(tab)<-'Item'
- missing<-as.numeric()
- for(i in 1:ncol(x$items)){
- missing<- c(missing, prop.table(table(is.na(x$items[i])))[2])
- }
- names(missing)<-NULL
- if(include.n){tab<-cbind(tab, rep(nrow(x$items),nrow(x$results)))
- names(tab)<-c(names(tab[1:ncol(tab)-1]),'n')
- tab$n<-as.integer(tab$n-(tab$n*missing))}
- if(include.mean){tab<-cbind(tab, s$mean)
- names(tab)<-c(names(tab[1:ncol(tab)-1]),'mean')}
- if(include.sd){tab<-cbind(tab, s$sd)
- names(tab)<-c(names(tab[1:ncol(tab)-1]),'sd')}
- if(include.low){tab<-cbind(tab,s$low)
- names(tab)<-c(names(tab[1:ncol(tab)-1]),'low')}
- if(include.neutral){tab<-cbind(tab, s$neutral)
- names(tab)<-c(names(tab[1:ncol(tab)-1]),'neutral')}
- if(include.high){tab<-cbind(tab, s$high)
- names(tab)<-c(names(tab[1:ncol(tab)-1]),'high')}
-# hline<-c(-1,0,nrow(tab))
+xtable.likert <- function(x, caption=NULL,
+ label=NULL,
+ align=NULL,
+ digits=NULL,
+ display=NULL,
+ include.n=TRUE,
+ include.mean=TRUE,
+ include.sd=TRUE,
+ include.low=TRUE,
+ include.neutral=(x$nlevels %% 2 != 0),
+ include.high=TRUE,
+ include.levels=TRUE,
+ include.missing=TRUE,
+ center=(x$nlevels-1)/2 + 1,
+ ordered=TRUE,
+ ...) {
+ if(!is.null(x$grouping)) {
+ tab <- data.frame()
+ for(g in unique(x$results$Group)){
+ s <- summary(x, center=center,ordered=ordered)
+ s <- s[which(s$Group==g),]
+ gtab <- as.data.frame(cbind(as.character(s$Group),as.character(s$Item)))
+ names(gtab) <- c('Group','Item')
+ missing <- as.numeric()
+ for(i in 1:ncol(x$items)){
+ missing <- c(missing, prop.table(table(is.na(x$items[i])))[2])
+ }
+ names(missing) <- NULL
+ if(include.n) {
+ gtab <- cbind(gtab, rep(nrow(x$items),length(x$items)))
+ names(gtab) <- c(names(gtab[1:ncol(gtab)-1]),'n')
+ gtab$n <- as.integer(gtab$n-(gtab$n*missing))}
+ if(include.mean) {
+ gtab <- cbind(gtab, s$mean)
+ names(gtab) <- c(names(gtab[1:ncol(gtab)-1]),'mean')}
+ if(include.sd) {
+ gtab <- cbind(gtab, s$sd)
+ names(gtab) <- c(names(gtab[1:ncol(gtab)-1]),'sd')
+ }
+ if(include.low) {
+ gtab <- cbind(gtab,s$low)
+ names(gtab) <- c(names(gtab[1:ncol(gtab)-1]),'low')
+ }
+ if(include.neutral) {
+ gtab <- cbind(gtab, s$neutral)
+ names(gtab) <- c(names(gtab[1:ncol(gtab)-1]),'neutral')
+ }
+ if(include.high) {
+ gtab <- cbind(gtab, s$high)
+ names(gtab) <- c(names(gtab[1:ncol(gtab)-1]),'high')
+ }
+ tab <- rbind(tab,gtab)
+ # hline <- c(-1,0, nrow(tab))
+ }
+ } else {
+ s <- summary(x, center=center, ordered=ordered)
+ tab <- as.data.frame(as.character(s$Item))
+ names(tab) <- 'Item'
+ missing <- as.numeric()
+ for(i in 1:ncol(x$items)) {
+ missing <- c(missing, prop.table(table(is.na(x$items[i])))[2])
+ }
+ names(missing) <- NULL
+ if(include.n) {
+ tab <- cbind(tab, rep(nrow(x$items),nrow(x$results)))
+ names(tab) <- c(names(tab[1:ncol(tab)-1]),'n')
+ tab$n <- as.integer(tab$n-(tab$n*missing))
+ }
+ if(include.mean) {
+ tab <- cbind(tab, s$mean)
+ names(tab) <- c(names(tab[1:ncol(tab)-1]),'mean')
+ }
+ if(include.sd) {
+ tab <- cbind(tab, s$sd)
+ names(tab) <- c(names(tab[1:ncol(tab)-1]),'sd')
+ }
+ if(include.low) {
+ tab <- cbind(tab,s$low)
+ names(tab) <- c(names(tab[1:ncol(tab)-1]),'low')
+ }
+ if(include.neutral) {
+ tab <- cbind(tab, s$neutral)
+ names(tab) <- c(names(tab[1:ncol(tab)-1]),'neutral')
+ }
+ if(include.high) {
+ tab <- cbind(tab, s$high)
+ names(tab) <- c(names(tab[1:ncol(tab)-1]),'high')
+ }
+ # hline <- c(-1,0,nrow(tab))
}
#caption=paste0('For these items, there were:',x$nlevels,'response categories including:',x$items$levels)#todo sep levels with commas etc
#TODO include.levels
- xtab<-xtable(tab, caption=caption, label=label, align=align, digits=digits,
- display=display, hline.after=hline, include.rownames=FALSE)
- class(xtab)<-c('xlikert',class(xtab))
- return(xtab)
+ #TODO: align should be defined, not passed through
+ xtab <- xtable(tab, caption=caption, label=label, align=align, digits=digits,
+ display=display, include.rownames=FALSE)
+ class(xtab) <- c('xlikert',class(xtab))
+ return(xtab)
}
#' Prints the results of \code{\link{xtable.likert}}.
@@ -101,18 +135,14 @@ xtable.likert <- function(x, caption=NULL, label=NULL, align=NULL, digits=NULL,
#' @S3method print xlikert
#' @method print xlikert
#' @export
-
-print.xlikert<-function(x, tabular.environment='longtable',floating=FALSE, ...){
-if(is.null(x$Group)){
- hlineafter <- c(-1,0,nrow(x))
-}else{
- ng<-nlevels(x$Group)
- ni<-nrow(x)/ng
- hlineafter <- c(-1,0,seq(from=ni, to=ni*ng, by=ni))
-}
- print.xtable(x,
- floating=floating,
- include.rownames=FALSE,
- include.colnames=TRUE,
- hline.after=hlineafter,...)
+print.xlikert <- function(x, tabular.environment='longtable', floating=FALSE, ...) {
+ if(is.null(x$Group)) {
+ hlineafter <- c(-1,0,nrow(x))
+ } else {
+ ng<-nlevels(x$Group)
+ ni<-nrow(x)/ng
+ hlineafter <- c(-1,0,seq(from=ni, to=ni*ng, by=ni))
+ }
+ print.xtable(x, floating=floating, include.rownames=FALSE,
+ include.colnames=TRUE, hline.after=hlineafter, ...)
}
View
@@ -1,6 +1,7 @@
options(digits=2)
require(likert)
+require(reshape)
data(pisaitems)
##### Item 24: Reading Attitudes
View
@@ -0,0 +1,23 @@
+\name{print.xlikert}
+\alias{print.xlikert}
+\title{Prints the results of \code{\link{xtable.likert}}.}
+\usage{
+ \method{print}{xlikert} (x,
+ tabular.environment = "longtable", floating = FALSE,
+ ...)
+}
+\arguments{
+ \item{x}{results of \code{\link{xtable.likert}}.}
+
+ \item{tabular.environment}{see
+ \code{\link{print.xtable}}.}
+
+ \item{floating}{see \code{\link{print.xtable}}.}
+
+ \item{...}{other parameters passed to
+ \code{\link{print.xtable}}}
+}
+\description{
+ Print method for \code{\link{xtable.likert}}.
+}
+
View
@@ -6,9 +6,10 @@
align = NULL, digits = NULL, display = NULL,
include.n = TRUE, include.mean = TRUE,
include.sd = TRUE, include.low = TRUE,
- include.neutral = TRUE, include.high = TRUE,
- include.levels = TRUE, include.missing = TRUE,
- center = (x$nlevels - 1)/2 + 1, ordered = TRUE, ...)
+ include.neutral = (x$nlevels\%\%2 != 0),
+ include.high = TRUE, include.levels = TRUE,
+ include.missing = TRUE, center = (x$nlevels - 1)/2 + 1,
+ ordered = TRUE, ...)
}
\arguments{
\item{x}{likert class object.}
@@ -49,6 +50,9 @@
This also influences which levels are summarized in the
low and high groups.}
+ \item{ordered}{whether the results should be ordered. See
+ \code{\link{summary.likert}}}
+
\item{...}{other parameters passed to \link{xtable}.}
}
\description{
@@ -0,0 +1,58 @@
+%\VignetteIndexEntry{Examples of likert Tables}
+%\VignetteDepends{}
+%\VignetteKeyword{likert xtable}
+%\VignettePackage{likert}
+
+\documentclass[12pt]{article}
+
+\usepackage[margin=1.0in]{geometry}
+\usepackage[english]{babel}
+\usepackage{rotating}
+\usepackage{pdflscape}
+
+<<setup,echo=FALSE,results=hide>>=
+options(digits=3)
+options(width=80)
+options(continue=" ")
+@
+
+\begin{document}
+\begin{landscape}
+
+\setkeys{Gin}{width=\textwidth}
+
+<<>>=
+require(likert)
+require(reshape)
+data(pisaitems)
+
+##### Item 24: Reading Attitudes
+items24 <- pisaitems[,substr(names(pisaitems), 1,5) == 'ST24Q']
+items24 <- rename(items24, c(
+ ST24Q01="I read only if I have to.",
+ ST24Q02="Reading is one of my favorite hobbies.",
+ ST24Q03="I like talking about books with other people.",
+ ST24Q04="I find it hard to finish books.",
+ ST24Q05="I feel happy if I receive a book as a present.",
+ ST24Q06="For me, reading is a waste of time.",
+ ST24Q07="I enjoy going to a bookstore or a library.",
+ ST24Q08="I read only to get information that I need.",
+ ST24Q09="I cannot sit still and read for more than a few minutes.",
+ ST24Q10="I like to express my opinions about books I have read.",
+ ST24Q11="I like to exchange books with my friends."))
+l24 = likert(items24)
+l24g <- likert(items24, grouping=pisaitems$CNT)
+@
+
+\clearpage
+
+<<results=tex>>=
+xtable(l24)
+@
+
+<<results=tex>>=
+xtable(l24g)
+@
+
+\end{landscape}
+\end{document}
View
Binary file not shown.

0 comments on commit 2b63380

Please sign in to comment.