...
|
...
|
@@ -200,11 +200,20 @@ ggplot_add.facet_plot <- function(object, plot, object_name) {
|
200
|
200
|
##' @export
|
201
|
201
|
ggplot_add.tiplab <- function(object, plot, object_name) {
|
202
|
202
|
layout <- get_layout(plot)
|
|
203
|
+ if (layout == 'dendrogram' && object$hjust == 0 ){
|
|
204
|
+ object$hjust <- .5
|
|
205
|
+ }
|
203
|
206
|
if (object$as_ylab) {
|
204
|
207
|
if (layout != "rectangular" && layout != "dendrogram") {
|
205
|
208
|
stop("displaying tiplab as y labels only supports rectangular layout")
|
206
|
209
|
}
|
207
|
210
|
## remove parameters that are not useful
|
|
211
|
+ fontsize <- object$size
|
|
212
|
+ object$size <- 0
|
|
213
|
+ object$as_ylab <- NULL
|
|
214
|
+ ly <- do.call(geom_tiplab_rectangular, object)
|
|
215
|
+ plot <- ggplot_add(ly, plot, object_name)
|
|
216
|
+ object$size <- fontsize
|
208
|
217
|
object$mapping <- NULL
|
209
|
218
|
object$align <- NULL
|
210
|
219
|
object$linetype <- NULL
|
...
|
...
|
@@ -212,16 +221,13 @@ ggplot_add.tiplab <- function(object, plot, object_name) {
|
212
|
221
|
object$geom <- NULL
|
213
|
222
|
object$offset <- NULL
|
214
|
223
|
object$nodelab <- NULL
|
215
|
|
- object$as_ylab <- NULL
|
216
|
|
-
|
217
|
224
|
res <- ggplot_add.tiplab_ylab(object, plot, object_name)
|
218
|
225
|
return(res)
|
219
|
226
|
}
|
220
|
227
|
|
221
|
228
|
object$as_ylab <- NULL
|
222
|
|
- if (layout == 'circular' || layout == 'fan' || layout == "unrooted" ||
|
223
|
|
- layout == "equal_angle" || layout == "daylight" || layout == "ape" ||
|
224
|
|
- layout == "inward_circular") {
|
|
229
|
+ if (layout %in% c('circular', 'fan', "unrooted",
|
|
230
|
+ "equal_angle", "daylight", "ape", "inward_circular")){
|
225
|
231
|
ly <- do.call(geom_tiplab_circular, object)
|
226
|
232
|
} else {
|
227
|
233
|
#object$nodelab <- NULL
|