File: plotGroves.R

package info (click to toggle)
r-cran-treespace 1.1.4.1%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 1,444 kB
  • sloc: cpp: 24; sh: 13; makefile: 2
file content (251 lines) | stat: -rw-r--r-- 8,800 bytes parent folder | download | duplicates (4)
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
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
#'
#' Scatterplot of groups of trees
#'
#' This function displays the scatterplot of the Multidimensional
#' Scaling (MDS) output by treespace, superimposing group information
#' (derived by \code{\link{findGroves}}) using colors.
#'
#' This function relies on \code{\link[adegraphics]{s.class}}
#' from the \code{adegraphics} package.
#'
#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
#'
#' @importFrom adegraphics s.class
#' @importFrom adegraphics s.label
#' @importFrom adegraphics s1d.barchart
#' @importFrom adegraphics insert
#' @importFrom adegenet funky
#' @importFrom adegenet bluepal
#' @importFrom adegenet transp
#'
#' @param x a list returned by \code{\link{findGroves}} or a MDS with class \code{dudi}
#' @param groups a factor defining groups of trees
#' @param xax a number indicating which principal component to be used as 'x' axis
#' @param yax a number indicating which principal component to be used as 'y' axis
#' @param type a character string indicating which type of graph to use
#' @param col.pal a color palette to be used for the groups
#' @param bg the background color
#' @param lab.show a logical indicating whether labels should be displayed
#' @param lab.col a color for the labels
#' @param lab.cex the size of the labels
#' @param lab.optim a logical indicating whether label positions should be optimized to avoid overlap; better display but time-consuming for large datasets
#' @param point.cex the size of the points
#' @param scree.pal a color palette for the screeplot
#' @param scree.size a size factor for the screeplot, between 0 and 1
#' @param scree.posi either a character string or xy coordinates indicating the position of the screeplot.
#' @param ... further arguments passed to \code{\link{s.class}}
#'
#' @return
#' An \code{adegraphics} object (class: \code{ADEgS})
#'
#' @seealso
#' \code{\link{findGroves}} to find any clusters in the tree landscape
#' \code{\link[adegraphics]{s.class}}
#' 
#'
#' @examples
#'
#' \dontrun{
#' if(require("adegenet") && require("adegraphics")){
#' ## load data
#' data(woodmiceTrees)
#'
#' ## run findGroves: treespace+clustering
#' res <- findGroves(woodmiceTrees, nf=5, nclust=6)
#'
#' ## basic plot
#' plotGroves(res)
#'
#' ## adding labels
#' plotGroves(res, lab.show=TRUE)
#'
#' ## customizing
#' plotGroves(res, lab.show=TRUE,
#' bg="black", lab.col="white", scree.size=.35)
#'
#' ## customizing
#' plotGroves(res, type="ellipse", lab.show=TRUE,
#' lab.optim=FALSE, scree.size=.35)
#'
#' ## example with no group information
#' plotGroves(res$treespace$pco)
#'
#' ## adding labels
#' plotGroves(res$treespace$pco, lab.show=TRUE, lab.cex=2)
#'
#' }
#' }
#'
#' @export
plotGroves <- function(x, groups=NULL, xax=1, yax=2,
                        type=c("chull","ellipse"), col.pal=funky, bg="white",
                        lab.show=FALSE, lab.col="black", lab.cex=1, lab.optim=TRUE,
                        point.cex=1, scree.pal=NULL, scree.size=.2,
                        scree.posi=c(.02,.02), ...){
    ## HANDLE ARGUMENTS ##
    ## checks
    type <- match.arg(type)
    if(is.null(scree.pal)) scree.pal <- function(n) rev(bluepal(n))

    ## x is a list returned by findGroves
    if(is.list(x) && !is.data.frame(x) && !inherits(x,"dudi")){
        if(is.null(x$treespace)) stop("if x is a list, it should contain a slot $treespace")
        groups <- x$groups
        x <- x$treespace$pco
    }

    ## x is a dudi object
    if(inherits(x,"dudi")){
        eig <- x$eig
        x <- x$li
    }

    ## groups missing - just s.label
    if(is.null(groups)) {
        ## with labels
        if(lab.show){
            out <- s.label(x, xax=xax, yax=yax,
                           plabels=list(optim=lab.optim, col=lab.col, cex=lab.cex),
                           ppoints=list(cex=point.cex),
                           pbackground.col=bg,
                           pgrid.text.col=lab.col, plot=FALSE, ...)
        } else {
            ## just points
            out <- s.label(x, xax=xax, yax=yax,
                           plabels=list(optim=FALSE,cex=0),
                           ppoints=list(cex=point.cex, col=lab.col),
                           pbackground.col=bg,
                           pgrid.text.col=lab.col, plot=FALSE, ...)
        }
    } else {
        ## if groups are provided
        if(!is.factor(groups)) groups <- factor(groups)
        n.lev <- length(levels(groups))


        ## MAKE GRAPH ##
        ## base scatterplot
        if(type=="chull"){
            out <- s.class(x, xax=xax, yax=yax, fac=groups, col=col.pal(n.lev),
                           ellipseSize=0, chullSize=1,
                           pbackground.col=bg,
                           ppoints.cex=point.cex,
                           pgrid.text.col=lab.col, plot=FALSE, ...)
        }
        if(type=="ellipse"){
            out <- s.class(x, xax=xax, yax=yax, fac=groups, col=col.pal(n.lev),
                           ellipseSize=1,
                           pbackground.col=bg,
                           ppoints.cex=point.cex,
                           pgrid.text.col=lab.col, plot=FALSE, ...)
        }

        ## add labels
        if(lab.show){
            out <- out + s.label(x, plabel.optim=lab.optim, plabel.col=lab.col,
                                 ppoints.cex=0, plabels.cex=lab.cex)
        }
    }
    ## add inset
    if(!is.null(scree.posi[1]) && !is.na(scree.posi[1]) && scree.posi[1]!="none"){
        screeplot <- s1d.barchart(c(0,eig), p1d.horizontal=FALSE, ppolygons.col=scree.pal(length(eig)+1),
                                  pbackground=list(col=transp("white"), box=TRUE),
                                  layout.width=list(left.padding=2),
                                  pgrid.draw=FALSE, plot=FALSE)
        out <- insert(screeplot, out, posi=scree.posi, ratio=scree.size, plot=FALSE)

    }


    ## RETURN ##
    return(out)
} # end plotGroves






######################
### ScatterD3 version
######################

#'
#' Scatterplot of groups of trees using \code{scatterD3}
#'
#' This function displays the scatterplot of the Multidimensional
#' Scaling (MDS) output by treespace, superimposing group information
#' (derived by \code{\link{findGroves}}) using colors.
#' \code{scatterD3} enables interactive plotting based on d3.js, including zooming, panning and fading effects in the legend.
#'
#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
#'
#' @import scatterD3
#' @importFrom adegenet funky
#' @importFrom adegenet bluepal
#' @importFrom adegenet transp
#'
#' @param x a list returned by \code{\link{findGroves}} or a MDS with class \code{dudi}
#' @param groups a factor defining groups of trees. If x is a list returned by \code{\link{findGroves}} these will be detected automatically.
#' @param xax a number indicating which principal component to be used as 'x' axis
#' @param yax a number indicating which principal component to be used as 'y' axis
#' @param treeNames if a list of tree names or labels are given, these will be plotted alongside the points. Their size can be altered using \code{labels_size} - see \code{?scatterD3} for more information.
#' @param xlab the label for the 'x' axis. Defaults to use the value of 'xax'
#' @param ylab the label for the 'y' axis. Defaults to use the value of 'yax'
#' @param symbol_var a factor by which to vary the symbols in the plot
#' @param ... further arguments passed to \code{\link{scatterD3}}
#'
#' @return
#' A \code{scatterD3} plot
#' 
#' 
#' @seealso
#' \code{\link{findGroves}} to find any clusters in the tree landscape
#' 
#'
#' @examples
#'
#' \dontrun{
#' if(require("adegenet") && require("scatterD3")){
#' ## load data
#' data(woodmiceTrees)
#'
#' ## run findGroves: treespace+clustering
#' res <- findGroves(woodmiceTrees, nf=5, nclust=6)
#'
#' ## basic plot
#' plotGrovesD3(res)
#'
#' ## adding tree labels
#' plotGrovesD3(res, treeNames=1:201)
#'
#' ## customizing: vary the colour and the symbol by group
#' plotGrovesD3(res, symbol_var=res$groups)
#'
#' ## example with no group information
#' plotGrovesD3(res$treespace$pco)
#' }
#' }
#'
#' @export
plotGrovesD3 <- function(x, groups=NULL, xax=1, yax=2, treeNames=NULL, symbol_var=NULL,
                         xlab=paste0("Axis ",xax), ylab=paste0("Axis ",yax), ...){
  ## HANDLE ARGUMENTS ##
  ## checks

  ## x is a list returned by findGroves
  if(is.list(x) && !is.data.frame(x) && !inherits(x,"dudi")){
    if(is.null(x$treespace)) stop("if x is a list, it should contain a slot $treespace")
    groups <- x$groups
    x <- x$treespace$pco$li
  }
  
  ## x is a dudi object
  if(inherits(x,"dudi")){
    eig <- x$eig
    x <- x$li
  }

  scatterD3(x[,xax],x[,yax], lab=treeNames, col_var=groups, symbol_var=symbol_var,
            xlab=xlab, ylab=ylab, ...)
} # end plotGrovesD3