stp25plot: meine plots

# 
# 
# # ?HH::plot.likert
# 
# HH_plot.likert.formula <-
#   function (x,
#             data,
#             ReferenceZero = NULL,
#             value,
#             levelsName = "",
#             scales.in = NULL,
#             between = list(x = 1 + (horizontal), y = 0.5 +2 * (!horizontal)),
#             auto.key.in = NULL,
#             panel.in = NULL,
#             horizontal = TRUE,
#             par.settings.in = NULL,
#             ...,
#             as.percent = FALSE,
#             ylab = if (horizontal) {
#                       if (length(x) == 3) deparse(x[[2]])
#                       else "Question"
#                    } else if (as.percent != FALSE) "Percent"
#                           else "Count",
#             xlab = if (!horizontal) {
#                         if (length(x) == 3) deparse(x[[2]])
#                         else "Question"
#                    } else if (as.percent != FALSE) "Percent"
#                           else"Count",
#             main = x.sys.call,
#             rightAxisLabels = rowSums(data.list$Nums),
#             rightAxis = !missing(rightAxisLabels),
#             ylab.right = if (rightAxis) "Row Count Totals"
#                          else NULL,
#             xlab.top = NULL,
#             right.text.cex = if (horizontal) {
#                                   if (!is.null(scales$y$cex)) scales$y$cex
#                                   else 0.8
#                              } else {
#                                   if (!is.null(scales$x$cex)) scales$x$cex
#                                   else 0.8},
#             xscale.components = xscale.components.top.HH,
#             yscale.components = yscale.components.right.HH,
#             xlimEqualLeftRight = FALSE,
#             xTickLabelsPositive = TRUE,
#             as.table = TRUE,
#             positive.order = FALSE,
#             data.order = FALSE,
#             reverse = ifelse(horizontal, as.table, FALSE),
#             h.resizePanels = sapply(result$y.used.at, length),
#             w.resizePanels = sapply(result$x.used.at, length),
#             reference.line.col = "gray65",
#             col.strip.background = "gray97",
#             key.border.white = TRUE,
#             col = likertColor(
#               Nums.attr$nlevels,
#               ReferenceZero = ReferenceZero,
#               colorFunction = colorFunction,
#               colorFunctionOption = colorFunctionOption
#             ),
#             colorFunction = "diverge_hcl",
#             colorFunctionOption = "lighter")
#   {
#     rightAxisMissing <- missing(rightAxis)
#     if (positive.order) data.order <- FALSE
#     if (!missing(value)) {
#       x.sys.call <- deparse(match.call()[1:4], width.cutoff = 500L)
#       varNamesUsedLong <- c(getVarNames(x, data), list(Value = value))
#       levelsName <- varNamesUsedLong$LevelNames[[1]]
#       data.list.list <- getLikertDataLong(x, data, varNamesUsedLong)
#       data.list <- data.list.list$data.list
#       varNamesUsed <- data.list.list$varNamesUsed
#       x <- data.list.list$x
#     }
#     else {
#       x.sys.call <- deparse(match.call()[1:3], width.cutoff = 500L)
#       varNamesUsed <- getVarNames(x, data)
#       data.list <- getLikertData(data, varNamesUsed)
#     }
#     
#     if (as.percent != FALSE) {
#       Nums.pct <- data.list$Nums / rowSums(data.list$Nums) *
#         100
#       Nums.pct[data.list$Nums == 0] <- 0
#       Nums.lik <- as.likert(Nums.pct, 
#                             ReferenceZero = ReferenceZero)
#       if (rightAxisMissing && as.percent != "noRightAxis") {
#         rightAxis <- TRUE
#         if (missing(ylab.right))
#           ylab.right <- "Row Count Totals"
#       }
#     }
#     else {
#       Nums.lik <- as.likert(data.list$Nums, 
#                             ReferenceZero = ReferenceZero)
#     }
#     par.settings <-
#       list(strip.background = list(col = col.strip.background))
#     par.settings[names(par.settings.in)] <- par.settings.in
#     if (rightAxis) {
#       par.settings$clip$panel <- "off"
#       if (horizontal) {
#         par.settings$layout.widths$ylab.right <-
#           max(6, par.settings$layout.widths$ylab.right,
#               na.rm = TRUE)
#         par.settings$layout.widths$axis.key.padding <- 
#           max(2,par.settings$layout.widths$axis.key.padding,na.rm = TRUE)
#       }
#       else {
#         par.settings$layout.heights$main.key.padding <- 
#           max(2,par.settings$layout.heights$main.key.padding,na.rm = TRUE)
#         par.settings$layout.heights$key.axis.padding <- 
#           max(1.5,par.settings$layout.heights$key.axis.padding,na.rm = TRUE)
#       }
#     }
#     Nums.attr <- attributes(Nums.lik)
#     
#    # print(str(Nums.lik))
#     scales <-
#       list(x = list(alternating = 1), y = list(alternating = 1))
#     if (!missing(scales.in)) {
#       scales.x <- scales$x
#       scales.y <- scales$y
#       if (is.null(scales.in$x) && is.character(scales.in$y))
#         scales.in$y <- list(relation = scales.in$y)
#       if (is.null(scales.in$y) && is.character(scales.in$x))
#         scales.in$x <- list(relation = scales.in$x)
#       if (is.character(scales.in))
#         scales.in <- list(x = list(relation = scales.in$x),
#                           y = list(relation = scales.in$y))
#       scales.x[names(scales.in$x)] <- scales.in$x
#       scales.y[names(scales.in$y)] <- scales.in$y
#       scales[names(scales.in)] <- scales.in
#       scales$x <- scales.x
#       scales$y <- scales.y
#     }
#     lim <- NULL
#     if (horizontal) {
#       xlim <- list(...)$xlim
#       if (!is.null(xlim) && is.null(scales.in$x$limits))
#         lim <- xlim
#       if (!is.null(scales.in$x$limits))
#         lim <- scales.in$x$limits
#     }
#     else {
#       ylim <- list(...)$ylim
#       if (!is.null(ylim) && is.null(scales.in$y$limits))
#         lim <- ylim
#       if (!is.null(scales.in$y$limits))
#         lim <- scales.in$y$limits
#     }
#     if (((
#       horizontal && is.null(scales$x$at) && is.null(scales$x$labels)
#     ) ||
#     (
#       !horizontal &&
#       is.null(scales$y$at) && is.null(scales$y$labels)
#     )) &&
#     (xlimEqualLeftRight || xTickLabelsPositive)) {
#       if (is.null(lim)) {
#         tmp <- Nums.lik
#         tmp[Nums.lik < 0] <- 0
#         data.max <- max(rowSums(tmp))
#         tmp <- Nums.lik
#         tmp[Nums.lik > 0] <- 0
#         data.min <- min(rowSums(tmp))
#         lim <- c(data.min, data.max)
#         lim <- lim + c(-0.04, 0.04) * diff(lim)
#       }
#       if (xlimEqualLeftRight)
#         lim <- c(-1, 1) * max(abs(lim))
#       at <- pretty(lim)
#       if (horizontal && !is.null(scales.in$x$at))
#         at <- scales.in$x$at
#       if (!horizontal && !is.null(scales.in$y$at))
#         at <- scales.in$y$at
#       if (xTickLabelsPositive)
#         labels <- abs(at)
#       else
#         labels <- at
#       if (horizontal && !is.null(scales.in$x$labels))
#         at <- scales.in$x$labels
#       if (!horizontal && !is.null(scales.in$y$labels))
#         at <- scales.in$y$labels
#       if (horizontal) {
#         scales$x$limits <- lim
#         scales$x$at <- at
#         scales$x$labels <- labels
#       }
#       else {
#         scales$y$limits <- lim
#         scales$y$at <- at
#         scales$y$labels <- labels
#       }
#     }
#     if (horizontal)
#       FormulaString <- with(varNamesUsed,
#                             paste(
#                               "`",
#                               QuestionName,
#                               "` ~ .value",
#                               if (is.null(CondNames)) NULL
#                               else paste(" |", paste(CondNames, collapse = " + ")),
#                               sep = ""
#                             ))
#     else
#       FormulaString <- with(varNamesUsed,
#                             paste(
#                               ".value ~ `",
#                               QuestionName,
#                               "`",
#                               if (is.null(CondNames)) NULL
#                               else paste(" |", paste(CondNames, collapse = " + ")),
#                               sep = ""
#                             ))
#     if (is.logical(auto.key.in) && length(auto.key.in) == 1 &&
#         auto.key.in == FALSE)
#       auto.key <- FALSE
#     else {
#       auto.key = list(
#         title = levelsName,
#         text = Nums.attr$original.levels,
#         columns = ifelse(horizontal, Nums.attr$nlevels, 1),
#         space = ifelse(horizontal, "bottom", "right"),
#         reverse.rows = ifelse(horizontal,
#                               FALSE, TRUE),
#         size = 2,
#         cex = 0.8,
#         between = 0.6,
#         points = FALSE,
#         rectangles = FALSE,
#         rect = list(col = col,
#                     border = if (key.border.white) "white"
#                               else col)
#       )
#       if (!missing(auto.key.in))
#         auto.key[names(auto.key.in)] <- auto.key.in
#     }
#     data2 <-
#       with(
#         data.list,
#         data.frame(
#           rightAxisLabels = rightAxisLabels,
#           Question,
#           Conditions,
#           Nums.lik,
#           check.names = FALSE
#         )
#       )
#     names(rightAxisLabels) <- data.list$Question[[1]]
#     {
#       if (positive.order || data.order) {
#         if (positive.order) {
#           cat("\nin positive.order \n")
#           print( data2)
#           print(Nums.attr$positive.order)
#           
#           if (reverse){
#             cat("\n reverse \n")
#          
#             data2 <- data2[Nums.attr$positive.order, ]
#             print( data2)
#            
#             
#            
#             }
#           else{
#             cat("\n reverse FALSE \n")
#             data2 <- data2[rev(Nums.attr$positive.order), ]
#             
#               print( data2)
#          
#             }
#         }
#         else {
#           do <- 1:nrow(data2)
#           if (reverse)
#             data2 <- data2[do, ]
#           else
#             data2 <- data2[rev(do), ]
#         }
#         newQ <- factor(data2[[varNamesUsed$QuestionName]],
#                        levels = unique(data2[[varNamesUsed$QuestionName]]))
#         new.order <-
#           do.call(order, data.frame(data2[, varNamesUsed$CondNames,
#                                           drop = FALSE], newQ = newQ, check.names = FALSE))
#         data2[[varNamesUsed$QuestionName]] <-
#           factor(data2[[varNamesUsed$QuestionName]],
#                  levels = unique(newQ[new.order]))
#       }
#       if (!positive.order && reverse && !data.order)
#         data2[[varNamesUsed$QuestionName]] <-
#         factor(data2[[varNamesUsed$QuestionName]],
#                levels = rev(levels(data2[[varNamesUsed$QuestionName]])))
#     }
#     if (rightAxis)
#       data2.melt <-
#       reshape2::melt((data2[match(unique(names(data2)),
#                                   names(data2))]),
#                      id.vars = c(unique(unlist(varNamesUsed[1:2])),
#                                  "rightAxisLabels"),
#                      variable.name = ".variable"
#       )
#     else
#       data2.melt <-
#       reshape2::melt((data2[match(unique(names(data2)),
#                                   names(data2))])[, -1],
#                      id.vars = unique(unlist(varNamesUsed[1:2])),
#                      variable.name = ".variable")
#     names(data2.melt)[ncol(data2.melt)] <- ".value"
#     panel <- function(x,
#                       y,
#                       subscripts,
#                       ...,
#                       horizontal = horizontal,
#                       rightAxis = rightAxis,
#                       rightAxisLabels = rightAxisLabels,
#                       reference.line.col = reference.line.col,
#                       right.text.cex = 0.8) {
#       if (horizontal)
#         panel.abline(v = 0, col = reference.line.col)
#       else
#         panel.abline(h = 0, col = reference.line.col)
#       panel.barchart(x, y, subscripts = subscripts, ..., horizontal = horizontal)
#       if (rightAxis) {
#         if (horizontal) {
#           at.which <- match(levels(y), y)
#           labels <- (rightAxisLabels[subscripts])[at.which]
#           panel.axis(
#             "right",
#             at = seq(along = levels(y)),
#             labels = labels,
#             outside = TRUE,
#             half = FALSE,
#             text.cex = right.text.cex
#           )
#         }
#         else {
#           at.which <- match(levels(x), x)
#           labels <- (rightAxisLabels[subscripts])[at.which]
#           panel.axis(
#             "top",
#             at = seq(along = levels(x)),
#             labels = paste(labels, "\n", sep = ""),
#             outside = TRUE,
#             half = FALSE,
#             rot = 0,
#             text.cex = right.text.cex
#           )
#         }
#       }
#     }
#     if (!is.null(panel.in))
#       panel <- panel.in
#     barchart.args <-
#       list(
#         as.formula(FormulaString),
#         groups = data2.melt$.variable,
#         data = data2.melt,
#         as.table = as.table,
#         xlab = xlab,
#         ylab = ylab,
#         ylab.right = ylab.right,
#         xlab.top = xlab.top,
#         main = main,
#         horizontal = horizontal,
#         stack = TRUE,
#         reference = TRUE,
#         col = col[Nums.attr$color.seq],
#         panel = panel,
#         scales = scales,
#         right.text.cex = right.text.cex,
#         between = between,
#         auto.key = auto.key,
#         par.settings = par.settings,
#         reference.line.col = reference.line.col,
#         ...,
#         xscale.components = xscale.components,
#         yscale.components = yscale.components,
#         rightAxis = rightAxis,
#         rightAxisLabels = data2.melt$rightAxisLabels,
#         subscripts = TRUE
#       )
#     if (is.null(list(...)$border))
#       barchart.args$border <- barchart.args$col
#     
#     return(barchart.args)
#     result <- do.call("barchart", barchart.args)
#     if (length(h.resizePanels) > 0) {
#       if (is.character(h.resizePanels) && h.resizePanels ==
#           "rowSums")
#         h.resizePanels <- rowSums(data.list$Nums)
#       result <- resizePanels(result, h = h.resizePanels)
#     }
#     if (length(w.resizePanels) > 0) {
#       if (is.character(w.resizePanels) && w.resizePanels ==
#           "rowSums")
#         w.resizePanels <- rowSums(data.list$Nums)
#       result <- resizePanels(result, w = w.resizePanels)
#     }
#     result
#   }
# 
# 
# # as.likert <- HH:::as.likert
# # xscale.components.top.HH <- HH:::xscale.components.top.HH
# # yscale.components.right.HH <- HH:::yscale.components.right.HH
# # getLikertData <- HH:::getLikertData
# # getVarNames <- HH:::getVarNames
# 
# 
# # 
# # 
# # getVarNames <- function(x, data) {
# #   switch(length(x),
# #          stop(paste("formula must be in form",
# #                     "  Question ~ . | Subtable",
# #                     "or",
# #                     "  Question ~ A+B+C | Subtable",
# #                     "or",
# #                     "  Question ~ .",
# #                     "or",
# #                     "  Question ~ A+B+C",
# #                     "or",
# #                     "  ~ . | Subtable",
# #                     "or",
# #                     "  ~ A+B+C | Subtable",
# #                     "or",
# #                     "  ~ .",
# #                     "or",
# #                     "  ~ A+B+C",
# #                     sep="\n"),
# #               call.=FALSE),
# #          {
# #            QuestionName <- 'rownames(data)'
# #            x <- as.formula(paste('` `', deparse(x, width.cutoff = 500L))) ## length(x) is now 3
# #          },
# #          QuestionName <- as.character(x[[2]]))
# #   
# #   x3 <- x[[3]]
# #   DOT <- as.call(~ .)[[2]]
# #   
# #   if (x3 == DOT) {
# #     CondNamesFormula <- NULL
# #     LevelNamesFormula <- NULL
# #   }
# #   else { ## ((x3 != DOT)
# #     if (length(x3) > 1 && x3[[1]] == '|' && x3[[2]] == DOT) {
# #       CondNamesFormula <- x3[[3]]
# #       LevelNamesFormula <- NULL
# #     }
# #     else {
# #       if (length(x3) > 1 && x3[[1]] == '|' && x3[[2]] != DOT) {
# #         LevelNamesFormula <- x3[[2]]
# #         CondNamesFormula <- x3[[3]]
# #       }
# #       else { ## length(x3) == 1 || x3[[1]] != '|'
# #         LevelNamesFormula <- x3
# #         CondNamesFormula <- NULL
# #       }
# #     }
# #   }
# #   
# #   if (is.null(CondNamesFormula))
# #     CondNames <- NULL
# #   else {
# #     CondNamesRaw <- strsplit(deparse(CondNamesFormula, width.cutoff = 500L),
# #                              "[\\*\\+]", fixed=FALSE)[[1]]
# #     CondNames <- sub('^[[:space:]]+', '', sub('[[:space:]]+$', '', CondNamesRaw )) ## remove leading and trailing white space, POSIX-style
# #     CondNames <- sub('^\"', '', sub('\"$', '', CondNames )) ## remove leading and trailing '\"' character
# #   }
# #   
# #   if (is.null(LevelNamesFormula))
# #     LevelNames <- NULL
# #   else {
# #     LevelNamesRaw <- strsplit(deparse(LevelNamesFormula, width.cutoff = 500L),
# #                               "[\\*\\+]", fixed=FALSE)[[1]]
# #     LevelNames <- sub('^[[:space:]]+', '', sub('[[:space:]]+$', '', LevelNamesRaw )) ## remove leading and trailing white space, POSIX-style
# #     LevelNames <- sub('^\"', '', sub('\"$', '', LevelNames )) ## remove leading and trailing '\"' character
# #   }
# #   
# #   list(QuestionName=QuestionName, CondNames=CondNames, LevelNames=LevelNames)
# # }
# # 
# # 
# # getLikertData <- function(data, varNamesUsed) {
# #   if (varNamesUsed$QuestionName == 'rownames(data)') {
# #     Question <- data.frame('rownames(data)'=factor(rownames(data), levels=unique(rownames(data))),
# #                            check.names=FALSE)
# #     RemainingNames <- names(data)
# #   }
# #   else {
# #     Question <- data[, varNamesUsed$QuestionName, drop=FALSE]
# #     if (!is.factor(Question[[1]]))
# #       Question[[1]] <- factor(Question[[1]], levels=unique(Question[[1]]))
# #     RemainingNames <- names(data)[! names(data) %in% varNamesUsed$QuestionName]
# #   }
# #   
# #   if (length(varNamesUsed$CondNames) > 0) {
# #     Conditions <- data.frame(
# #       lapply(data[, varNamesUsed$CondNames, drop=FALSE],
# #              function(ff) {
# #                if (is.factor(ff))
# #                  ff
# #                else
# #                  factor(ff, levels=unique(ff))
# #              }))
# #     RemainingNames <- RemainingNames[! RemainingNames %in% varNamesUsed$CondNames]
# #   }
# #   else
# #     Conditions <- data.frame(matrix(NA, nrow(Question), 0))
# #   
# #   Nums <- if (is.null(varNamesUsed$LevelNames)) {
# #     tmp <- data[, RemainingNames, drop=FALSE]
# #     tmp[, sapply(tmp, is.numeric), drop=FALSE]
# #   }  else
# #     data[, varNamesUsed$LevelNames, drop=FALSE]
# #   
# #   Nums <- data.matrix(Nums)
# #   names(dimnames(Nums)) <- if (is.null(attr(data, "names.dimnames")))
# #     c(varNamesUsed$QuestionName, "Level Names")
# #   else
# #     attr(data, "names.dimnames")
# #   list(Question=Question, Conditions=Conditions, Nums=Nums)
# #   
# # }
# # 
# # getLikertDataLong <- function(x, data, varNamesUsedLong) {
# #   if (inherits(x[[3]], "call")) {
# #     cond <- deparse(x[[3]][[3]])
# #     aaa <- strsplit(cond, " ", fixed=TRUE)[[1]]
# #     aaa[aaa=='+'] <- ' + '
# #     bbb <- paste(rev(aaa), collapse="")
# #     y <- paste(bbb, ' + ', as.character(x[[2]]), ' ~ ', x[[3]][[2]], sep='')
# #     levelsName <- as.character(x[[3]][[2]])
# #     x[[3]][[2]] <- as.name(".")
# #   } else {
# #     y <- x
# #     levelsName <- as.character(x[[3]])
# #     x[[3]] <- as.name(".")
# #   }
# #   
# #   varNamesUsed <- c(varNamesUsedLong[c("QuestionName","CondNames")],
# #                     Nums=levels(data[[varNamesUsedLong$LevelNames]]))
# #   data2 <- reshape2::dcast(y, data=data[unlist(varNamesUsedLong)], value.var=varNamesUsedLong$Value)
# #   list(data.list=getLikertData(data2, varNamesUsed), varNamesUsed=varNamesUsed, x=x)
# # }
# # 
# # likertStripDefault <- strip.custom(
# #   bg="gray97", ## col.strip.background,
# #   par.strip.text=list(cex=.6))
# # 
# ## if (FALSE) {
# 
# ##   require(HH)
# ##   require(reshape)
# 
# ##   data(SFF8121)
# ##   SFF <- as.likertDataFrame(SFF8121)
# 
# ##   ## These two statements are equivalent to each other and will be
# ##   ## equivalent to the next two in the special case that there are no
# ##   ## repetitions in the rownames(data).
# 
# ##   likert( ~ . | Subtable, data=SFF, layout=c(2,1))
# 
# ##   likert( ~
# ##          "Strongly Disagree" + Disagree + Neutral + Agree + "Strongly Agree" | Subtable,
# ##          data=SFF, layout=c(2,1))
# 
# ##   ## These two statements are equivalent
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1))
# 
# ##   likert(Question ~
# ##          "Strongly Disagree" + Disagree + Neutral + Agree + "Strongly Agree" | Subtable,
# ##          data=SFF, layout=c(2,1))
# 
# ##   ## fancy
# ##   fancy <-
# ##   update(par.strip.text=list(cex=.7), xlab="Percent", main="Student Evaluations", scales=list(x=list(limits=c(-20, 100))),
# ##          resizePanels(useOuterStrips(combineLimits(
# ##            likert(Question ~ . | Subtable+fake,
# ##                   data=cbind(SFF,
# ##                     fake=rep(
# ##                       factor(c("Instructor","Course","Instructor","Course"),
# ##                              levels=c("Instructor","Course")),
# ##                       c(8,3,8,3))),
# ##                   scales=list(y=list(relation="free")), between=list(y=.5, x=.5))
# ##            )), h=c(8,3))
# ##          )
# ##   fancy
# 
# ##   ## others
# ##   tmpvert <-
# ##   likert(Question ~ . | Subtable, data=SFF, ylab="Percent", layout=c(1,2), horizontal=FALSE,
# ##          between=list(y=1), scales=list(x=list(rot=90), y=list(limits=c(-30,110), alternating=1)))
# ##   tmpvert
# 
# ##   likert(Question ~ . | Subtable, data=SFF, ylab="Percent", layout=c(1,2), horizontal=FALSE,
# ##          between=list(y=1), scales=list(x=list(rot=90)), ylim=c(-30,110))
# 
# ##   tmp <- likert(Question ~ . | Subtable, data=SFF, layout=c(2,1),
# ##                 scales=list(x=list(limits=c(-30, 110), alternating=1, at=seq(-20, 100, 20), labels=abs(seq(-20, 100,20)))))
# ##   tmp
# 
# 
# ##   tmp2 <- likert(Question ~ . | Subtable, data=SFF, layout=c(2,1),
# ##                  scales=list(x=list(limits=c(-30, 110), alternating=1)))
# ##   tmp2
# 
# ##   ## ## if (!is.numeric(tmp2$x.scales$labels)) {
# ##   ## ##   if (!is.numeric(tmp2$x.scales$at))
# ##   ## ##     tmp2$x.scales$at <- pretty(tmp2$x.scales$limits)
# ##   ## ##   tmp2$x.scales$labels <- abs(tmp2$x.scales$at)
# ##   ## ## }
# ##   ## ## tmp2
# 
# ##   ## TickLabelsPositive <- function(trellis, horizontal=TRUE) { ## trellis is a trellis object
# ##   ##   scales <-if (horizontal) trellis$x.scales else trellis$y.scales
# ##   ##   if (!is.numeric(scales$labels)) {
# ##   ##     if (!is.numeric(scales$at))
# ##   ##       scales$at <- pretty(scales$limits)
# ##   ##     scales$labels <- abs(scales$at)
# ##   ##   }
# ##   ##   else
# ##   ##     scales$labels <- abs(scales$labels)
# ##   ##   if (horizontal) trellis$x.scales <- scales else trellis$y.scales <- scales
# ##   ##   trellis
# ##   ## }
# 
# ##   ## TickLabelsPositive(tmp2)
# 
# ##   ## TickLabelsPositive(tmpvert, FALSE)
# 
# 
# 
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1))
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1), xlimEqualLeftRight=TRUE)
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1), xTickLabelsPositive=FALSE, xlim=c(-80,110))
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1), xlim=c(-80,110))
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1), xlimEqualLeftRight=TRUE, xTickLabelsPositive=FALSE)
# 
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1))
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(2,1), as.percent=TRUE)  ## rightAxisLabels doesn't work with layout=c(2,1)
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(1,2), as.percent=TRUE)  ## rightAxisLabels doesn't work with layout=c(1,2)
# 
# ##   HH:::plot.likert.formula.old(Question ~ . | Subtable, data=SFF, layout=c(2,1), as.percent=TRUE)  ## Works but needs horizontal stretch to be useful
# ##   HH:::plot.likert.formula.old(Question ~ . | Subtable, data=SFF, layout=c(1,2), as.percent=TRUE)  ## Works
# 
# ##   likert(Question ~ . | Subtable, data=SFF, layout=c(1,2), as.percent=TRUE)
# 
# ## }
# 
# 
# 
# 
# 
# 
# #  # 
# # getVarNames <- function (x, data) 
# # {
# #   switch(length(x), stop(paste("formula must be in form", "  Question ~ . | Subtable", 
# #                                "or", "  Question ~ A+B+C | Subtable", "or", "  Question ~ .", 
# #                                "or", "  Question ~ A+B+C", "or", "  ~ . | Subtable", 
# #                                "or", "  ~ A+B+C | Subtable", "or", "  ~ .", "or", "  ~ A+B+C", 
# #                                sep = "\n"), call. = FALSE), {
# #                                  QuestionName <- "rownames(data)"
# #                                  x <- as.formula(paste("` `", deparse(x, width.cutoff = 500L)))
# #                                }, QuestionName <- as.character(x[[2]]))
# #   x3 <- x[[3]]
# #   DOT <- as.call(~.)[[2]]
# #   if (x3 == DOT) {
# #     CondNamesFormula <- NULL
# #     LevelNamesFormula <- NULL
# #   }
# #   else {
# #     if (length(x3) > 1 && x3[[1]] == "|" && x3[[2]] == DOT) {
# #       CondNamesFormula <- x3[[3]]
# #       LevelNamesFormula <- NULL
# #     }
# #     else {
# #       if (length(x3) > 1 && x3[[1]] == "|" && x3[[2]] != 
# #           DOT) {
# #         LevelNamesFormula <- x3[[2]]
# #         CondNamesFormula <- x3[[3]]
# #       }
# #       else {
# #         LevelNamesFormula <- x3
# #         CondNamesFormula <- NULL
# #       }
# #     }
# #   }
# #   if (is.null(CondNamesFormula)) 
# #     CondNames <- NULL
# #   else {
# #     CondNamesRaw <- strsplit(deparse(CondNamesFormula, width.cutoff = 500L), 
# #                              "[\\*\\+]", fixed = FALSE)[[1]]
# #     CondNames <- sub("^[[:space:]]+", "", sub("[[:space:]]+$", 
# #                                               "", CondNamesRaw))
# #     CondNames <- sub("^\"", "", sub("\"$", "", CondNames))
# #   }
# #   if (is.null(LevelNamesFormula)) 
# #     LevelNames <- NULL
# #   else {
# #     LevelNamesRaw <- strsplit(deparse(LevelNamesFormula, 
# #                                       width.cutoff = 500L), "[\\*\\+]", fixed = FALSE)[[1]]
# #     LevelNames <- sub("^[[:space:]]+", "", sub("[[:space:]]+$", 
# #                                                "", LevelNamesRaw))
# #     LevelNames <- sub("^\"", "", sub("\"$", "", LevelNames))
# #   }
# #   list(QuestionName = QuestionName, CondNames = CondNames, 
# #        LevelNames = LevelNames)
# # }