File: plotLetters.R

package info (click to toggle)
r-cran-multcompview 0.1-10-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 268 kB
  • sloc: makefile: 2
file content (228 lines) | stat: -rw-r--r-- 8,539 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
#' plot multcomp displays
#' 
#' Helper functions for plot.multcompTs and plot.multcompLetters.  These not
#' intended to be called directly and are hidden in a namespace.  You can use
#' 'getAnywhere' to see them.
#' 
#' The requested graphic is either plotted by itself or added to an existing
#' plot as specified by the arguments.
#' 
#' "plotTs" and "plotBoxes" use traditional R graphics and will not be
#' discussed further here.
#' 
#' "plotLetters" uses 'grid' graphics, because it seems to provide more support
#' for controlling the side-by-side placement of "Letters" of possibly
#' different colors and widths.  The "Letters" display will be positioned in
#' the "plot region" defined by fig and mar, assuming the entire device region
#' is 37 lines both wide and tall.  Thus, the plot region is diff(fig[1:2])*37
#' lines wide and diff(fig(1:2])*37 lines high.  If, for example, fig = c(0.9,
#' 1, 0, 1), this makes the plot region 3.7 lines wide.  With the default
#' mar=c(5, 4, 4, 2)+0.1 lines, the "width" of the plot region is therefore 3.7
#' - (4.1+2.1) = (-2.5) lines.  "plotLetters" initially ignores this
#' contradictory negative width, and centers the plot at the midpoint of h0 =
#' fig[1]+mar[2]/37, h1 = fig[2]-mar[4]/37, v0 = fig[3]+mar[1]/37, and v1 =
#' fig[4]-mar[3]/37.  The "Letters" for the different levels compared are
#' rescaled from at[, "center"] to fit inside At.rng = if(horizontal) c(h0, h1)
#' else c(v0, v1).  With "n" levels compared and at.rng = range(at[,
#' "center"]), at[, "center"] is expanded to (at.rng+/-0.5) and rescaled to
#' match At.rng; if(diff(At.rng)<=0), an error message is issued.
#' 
#' Meanwhile, the "Letters" are centered at the midpoint of W.rng =
#' if(horizontal) c(v0, v1) else v(h0, h1) [the opposite of At.rng]; the
#' argument "width" used by plotTs and plotBoxes is not used (and not even
#' accepted) by plotLetters.  If(label.levels), these are positioned in the
#' midpoint of the right margin in the "W" direction.
#' 
#' @aliases plotLetters
#' @param obj a matrix describing which levels (rows) will be plotted with
#' which groups (columns).  For plotTs and plotBoxes, obj is a matrix of
#' numbers from (-1, 0, 1).  For plotLetters, obj is a logical matrix = TRUE if
#' that "letter" (group or column of obj) is to be plotted with that level (row
#' of obj).
#' @param at an array with one row for each level and 3 columns giving low,
#' middle and high levels for the display for that level.
#' @param horizontal A logical scalar indicating whether the list of items
#' compared reads left to right (horizontal = TRUE) or top to bottom
#' (horizontal = FALSE).  If this multcomp graphic accompanies boxplots for
#' different levels or groups compared, the 'boxplot' argument 'horizontal' is
#' the negation of the multcomp plot 'horizontal' argument.
#' @param col The color for each group of items or factor levels.  The colors
#' will cross the different items or factor levels and will therefore have the
#' orientation specified via 'horizontal'.  If the number of columns exceeds
#' length(col), col is recycled.  For alternative choices for col, see "Color
#' Specification" in the \code{\link{par}} help page.
#' @param add TRUE to add to an existing plot; FALSE to start a new plot.  The
#' names of the factor levels or items compared will be plotted only if
#' add=FALSE.
#' @param label.levels Distance from the plot region to print the names of the
#' levels as a proportion of the plot range; NA for no level labels.
#' @param font.family character string naming the font family used by
#' "plotLetters".  This function plots the different "Letters" in different
#' colors by plotting one color at a time.  It's currently not smart enough to
#' align the letters properly except by assuming a mono-spaced font.
#' @param fig figure region = (x0, x1, y0, y1) as a proportion of the device
#' region.
#' @param mar margin = (lower, left, upper, right) in lines.
#' @param ...  graphical parameters can be given as described on the
#' \code{\link{plot}} help page or the \code{\link[grid]{gpar}} help page.
#' @return "Done"
#' @author Spencer Graves
#' @seealso \code{\link{plot.multcompTs}} \code{\link{plot.multcompLetters}}
#' \code{\link[grid]{gpar}}
#' @keywords aplot internal
#' @examples
#' 
#' # Designed to be called from plot.multcompTs
#' # or plot.multcompLetters, NOT directly by users.  
#' @importFrom grid grid.newpage viewport pushViewport unit textGrob gpar grobHeight
#' @importFrom grid convertHeight grobWidth convertWidth grid.text popViewport
#' @export

"plotLetters" <- 
function(obj, at, horizontal, col, add,
    label.levels, font.family="mono",
    fig=par("fig"), mar=par("mar"), ...){
##
## 1.  Modify "par"
##
  if(!add) grid::grid.newpage()
#  
  op <- par(family=font.family)
  on.exit(par(op))  
##
## 2.  Set up 'grid' graphics 
##  
# Use 'grid' graphics for 2 reasons:
#   (1) I couldn't figure out how to get 
#       consistent alignment with overlays
#       using 'text'
#   (2) 'grid' will compute the size 
#       of characters, so I can use that
#       to determine plotting positions.  
  vpFig <- grid::viewport(name="vp.fig")
grid::pushViewport(vpFig)
#  
  angle <- 90*horizontal
  lvl.rng <- range(at[, "center"])
##
## 3.  Compute figure and plot regions
##
  n <- dim(obj)[1]
  k <- dim(obj)[2]
# Figure region 
  W.fig <- fig[(1:2)+2*horizontal]
  At.fig <- fig[(3:4)-2*horizontal]
# Figure margins
  At.mar <- mar[c(1, 3)+horizontal]
  W.mar <- mar[c(2, 4)-horizontal]
# Plot region
  At.rng <- (At.fig+c(1, -1)*At.mar/37)
  W.rng <- (W.fig+c(1, -1)*W.mar/37)
##
## 4.  Rescale "at" to Grid's "npc" 
##     = "normalized parent coordinates"
##     within fig and mar
##  
  at.rng <- (range(at[, "center"])+c(-0.5, 0.5))
  d.at <- diff(at.rng)
  d.At <- diff(At.rng)
  At <- (At.rng[1]+d.At*(
              at[, "center"]-at.rng[1])/d.at)
#  At.npc <- unit(At, "npc")
#  At.nat <- unit(At, "native")
##
## 5.  Convert "Letters" to grobs =
##     Grid "graphics objects" 
##  
  n <- dim(obj)[1]
  k <- dim(obj)[2]  
  Ltrs <- dimnames(obj)[[2]]
  k1 <- k+1
  LtrsM <- c(Ltrs, "M")
  LtrsM. <- c(Ltrs, "Ref.M.")
  gLtrs <- vector(k1, mode="list")
  names(gLtrs) <- LtrsM
#  npc0 <- unit(0, "npc")
  nat0 <- grid::unit(0, "native")
  for(j in 1:k1)
    gLtrs[[j]] <- grid::textGrob(LtrsM[j], rot=angle,x=nat0,
       y=nat0, name=LtrsM.[j], gp=grid::gpar(col=col[j], ...))
#          name=LtrsM.[j], gp=gpar(...))
##
## 6.  Compute character widths
##
  wLtrs <- rep(NA, k1)
  names(wLtrs) <- LtrsM
  {
    if(horizontal)
      for(j in 1:k1){
        gH.j <- grid::grobHeight(gLtrs[[j]])
        wLtrs[j] <- grid::convertHeight(gH.j, "native",
                       valueOnly=TRUE)
      }
    else
      for(j in 1:k1){
        gW.j <- grid::grobWidth(gLtrs[[j]])
        wLtrs[j] <- grid::convertWidth(gW.j, "npc",
                       valueOnly=TRUE)
      }
  }
##
## 7.  Rescale to W.rng
##
#     7.1.  maxX = max width including Ref.M.       
  maxW <- max(wLtrs)
#     7.2.  w.Ltrs = adj. width excl. Ref.M.      
  w.Ltrs <- 0.5*(wLtrs[-k1]+maxW)
#     7.3.  Convert to a scale in "npc"      
  sumW <- cumsum(w.Ltrs)
#     7.4.  width(in "npc") = adjustment to W.rng
  w0 <- mean(W.rng)
  W <- (w0+sumW-mean(range(sumW)))
#  W.npc <- unit(W, "npc")
#  W.nat <- unit(W, "native")
##
## 8.  Plot
##  
  {
    if(horizontal)
      for(j in 1:k){
        n.j <- sum(obj[, j])
        Ltr.j <- rep(Ltrs[j], n.j)
        W.j <- rep(W[j], n.j)
        At.j <- At[obj[, j]]
        grid::grid.text(Ltr.j, At.j, W.j, rot=90,
                  gp=grid::gpar(col=col[j], ...))
      }
    else
      for(j in 1:k){
        n.j <- sum(obj[, j])
        Ltr.j <- rep(Ltrs[j], n.j)
        W.j <- rep(W[j], n.j)
        At.j <- At[obj[, j]]
        grid::grid.text(Ltr.j, W.j, At.j,
                  gp=grid::gpar(col=col[j], ...))
      }
  }
##
## 9.  Label the levels?    
##
  if(!is.na(label.levels)){
    lvls <- dimnames(obj)[[1]]
#   W.mar = (W.rng[1]- 0.5*dW - label.levels)    
    W.mar <- (W[1]-0.5*wLtrs[1]-label.levels)
    W.n <- rep(W.mar, n)
    if(horizontal){
      grid::grid.text(lvls, At, W.n, rot=90)
    }else{
      grid::grid.text(lvls, W.n, At)
    }
  }
##
## 10.  Clean up and quit.
##      
grid::popViewport()
#  
  "Done"
}