229229# ' ARSA, BBURCG, BBWRCG, MDS, TSP, Chen and so forth.
230230# '
231231# ' @example vignettes/example-corrplot.R
232- # ' @keywords hplot
233232# ' @import graphics grDevices stats
234233# ' @export
235234corrplot <- function (corr ,
@@ -394,8 +393,8 @@ corrplot <- function(corr,
394393 apply_mat_filter <- function (mat ) {
395394 x <- matrix (1 : n * m , n , m )
396395 switch (type ,
397- upper = mat [row(x ) > col(x )] <- Inf ,
398- lower = mat [row(x ) < col(x )] <- Inf
396+ upper = mat [row(x ) > col(x )] <- Inf ,
397+ lower = mat [row(x ) < col(x )] <- Inf
399398 )
400399
401400 if (! diag ) {
@@ -419,14 +418,14 @@ corrplot <- function(corr,
419418 # we use this for rending NA cells differently
420419 getPos.NAs <- function (mat ) {
421420 tmp <- apply_mat_filter(mat )
422- ind <- which(is.na(tmp ), arr.ind = TRUE )
421+ ind <- which(is.na(tmp ), arr.ind = TRUE )
423422 Pos <- ind
424423 Pos [,1 ] <- ind [,2 ]
425424 Pos [,2 ] <- - ind [,1 ] + 1 + n
426425 return (Pos )
427426 }
428427
429- Pos <- getPos.Dat(corr )[[1 ]]
428+ Pos <- getPos.Dat(corr )[[1 ]]
430429
431430 # rows
432431 n2 <- max(Pos [,2 ])
@@ -460,11 +459,11 @@ corrplot <- function(corr,
460459
461460 # # assign colors
462461 assign.color <- function (dat = DAT , color = col ){
463- newcorr <- (dat + 1 ) / 2
464- newcorr [newcorr < = 0 ] <- 0
465- newcorr [newcorr > = 1 ] <- 1 - 1e-16
462+ newcorr <- (dat + 1 ) / 2
463+ newcorr [newcorr < = 0 ] <- 0
464+ newcorr [newcorr > = 1 ] <- 1 - 1e-16
466465
467- color [floor(newcorr * length(color )) + 1 ] # new color returned
466+ color [floor(newcorr * length(color )) + 1 ] # new color returned
468467 }
469468
470469 col.fill <- assign.color()
@@ -503,39 +502,54 @@ corrplot <- function(corr,
503502 # # calculate label-text width approximately
504503 if (! add ) {
505504 plot.new()
506- xlabwidth <- ylabwidth <- 0
507505
506+ # Issue #10: code from Sébastien Rochette (github user @statnmap)
507+ xlabwidth <- max(strwidth(newrownames , cex = tl.cex ))
508+ ylabwidth <- max(strwidth(newcolnames , cex = tl.cex ))
509+ laboffset <- strwidth(" W" , cex = tl.cex ) * tl.offset
510+
511+ # Issue #10
508512 for (i in 1 : 50 ) {
509- xlim <- c(m1 - 0.5 - xlabwidth ,
510- m2 + 0.5 + mm * cl.ratio * (cl.pos == " r" ))
511- ylim <- c(n1 - 0.5 - nn * cl.ratio * (cl.pos == " b" ),
512- n2 + 0.5 + ylabwidth )
513- plot.window(xlim + c(- 0.2 , 0.2 ), ylim + c(- 0.2 , 0.2 ), asp = 1 ,
514- xaxs = " i" , yaxs = " i" )
513+ xlim <- c(
514+ m1 - 0.5 - laboffset -
515+ xlabwidth * (grepl(" l" , tl.pos ) | grepl(" d" , tl.pos )),
516+ m2 + 0.5 + mm * cl.ratio * (cl.pos == " r" ) +
517+ xlabwidth * abs(cos(tl.srt * pi / 180 )) * grepl(" d" , tl.pos )
518+ ) + c(- 0.35 , 0.15 ) +
519+ c(- 1 ,0 ) * grepl(" l" , tl.pos ) # margin between text and grid
520+
521+ ylim <- c(
522+ n1 - 0.5 - nn * cl.ratio * (cl.pos == " b" ),
523+ n2 + 0.5 + laboffset +
524+ ylabwidth * abs(sin(tl.srt * pi / 180 )) * grepl(" t" , tl.pos )
525+ ) +
526+ c(- 0.15 , 0 ) +
527+ c(0 , - 1 ) * (type == " upper" ) + # nasty hack
528+ c(0 ,1 ) * grepl(" d" , tl.pos ) # margin between text and grid
529+
530+ plot.window(xlim , ylim , asp = 1 , xaxs = " i" , yaxs = " i" )
531+
515532 x.tmp <- max(strwidth(newrownames , cex = tl.cex ))
516533 y.tmp <- max(strwidth(newcolnames , cex = tl.cex ))
517534
518- if (min(x.tmp - xlabwidth , y.tmp - ylabwidth ) < 0.0001 ) {
535+ laboffset.tmp <- strwidth(" W" , cex = tl.cex ) * tl.offset
536+ if (max(x.tmp - xlabwidth ,
537+ y.tmp - ylabwidth ,
538+ laboffset.tmp - laboffset ) < 1e-03 ) {
519539 break
520540 }
521541
522542 xlabwidth <- x.tmp
523543 ylabwidth <- y.tmp
524- }
525544
526- if (tl.pos == " n" || tl.pos == " d" ) {
527- xlabwidth <- ylabwidth <- 0
528- }
545+ laboffset <- laboffset.tmp
529546
530- if (tl.pos == " td" ) ylabwidth <- 0
531- if (tl.pos == " ld" ) xlabwidth <- 0
532-
533- laboffset <- strwidth(" W" , cex = tl.cex ) * tl.offset
534- xlim <- c(m1 - 0.5 - xlabwidth - laboffset ,
535- m2 + 0.5 + mm * cl.ratio * (cl.pos == " r" )) + c(- 0.35 , 0.15 )
536- ylim <- c(n1 - 0.5 - nn * cl.ratio * (cl.pos == " b" ),
537- n2 + 0.5 + ylabwidth * abs(sin(tl.srt * pi / 180 )) + laboffset )
538- + c(- 0.15 , 0.35 )
547+ if (i == 50 ) {
548+ warning(c(" Not been able to calculate text margin, " ,
549+ " please try again with a clean new empty window using " ,
550+ " {plot.new(); dev.off()} or reduce tl.cex" ))
551+ }
552+ }
539553
540554 if (.Platform $ OS.type == " windows" ) {
541555 grDevices :: windows.options(width = 7 ,
0 commit comments