The R Project SVN R

Rev

Rev 74653 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 74653 Rev 77447
Line 1... Line 1...
1 
#  File src/library/grDevices/R/utils.R
 1 
#  File src/library/grDevices/R/utils.R
2 
#  Part of the R package, https://www.R-project.org
 2 
#  Part of the R package, https://www.R-project.org
3 
#
 3 
#
4 
#  Copyright (C) 1995-2018 The R Core Team
 4 
#  Copyright (C) 1995-2019 The R Core Team
5 
#
 5 
#
6 
#  This program is free software; you can redistribute it and/or modify
 6 
#  This program is free software; you can redistribute it and/or modify
7 
#  it under the terms of the GNU General Public License as published by
 7 
#  it under the terms of the GNU General Public License as published by
8 
#  the Free Software Foundation; either version 2 of the License, or
 8 
#  the Free Software Foundation; either version 2 of the License, or
9 
#  (at your option) any later version.
 9 
#  (at your option) any later version.
Line 14... Line 14...
14 
#  GNU General Public License for more details.
 14 
#  GNU General Public License for more details.
15 
#
 15 
#
16 
#  A copy of the GNU General Public License is available at
 16 
#  A copy of the GNU General Public License is available at
17 
#  https://www.R-project.org/Licenses/
 17 
#  https://www.R-project.org/Licenses/
18 
 
 18 
 
19 
n2mfrow <- function(nr.plots)
 19 
n2mfrow <- function(nr.plots, asp = 1)
20 
{
 20 
{
- 
 
 21 
  nr.plots <- as.integer(nr.plots)
- 
 
 22 
  if(asp == 1 && nr.plots <= 12L) { # if only for back compatibility
- 
 
 23 
      if   (nr.plots <=  3L)
21 
  if      (nr.plots <=  3)  c(nr.plots,1) # 1, 2, 3
 24 
          c(nr.plots, 1L)        # nr.p = 1, 2, 3
- 
 
 25 
      else if (nr.plots <=  6L)
22 
  else if (nr.plots <=  6)  c((nr.plots+1)%/%2,2)#-- n.. = 4,5,6
 26 
           c((nr.plots+1L) %/% 2L, 2L)# = 4, 5, 6
23 
  else if (nr.plots <= 12)  c((nr.plots+2)%/%3,3)
 27 
      else c((nr.plots+2L) %/% 3L, 3L)# = 7, 8,.., 12
- 
 
 28 
  }
- 
 
 29 
  else {
24 
  else c(nrow <- ceiling(sqrt(nr.plots)),
 30 
      rc <- c(nrow <- ceiling(sqrt(nr.plots / asp)),
25 
         ceiling( nr.plots / nrow))
 31 
              ceiling(nr.plots / nrow))
- 
 
 32 
      ## improve (if easy):
- 
 
 33 
      do <- TRUE
- 
 
 34 
      while(do && prod(rc) > nr.plots) {
- 
 
 35 
          if(do <- prod(n <- rc - 0:1) >= nr.plots)
- 
 
 36 
              rc <- n
- 
 
 37 
          else if(do <- prod(n <- rc - 1:0) >= nr.plots)
- 
 
 38 
              rc <- n
- 
 
 39 
      }
- 
 
 40 
      rc
- 
 
 41 
  }
26 
}
 42 
}
27 
 
 43 
 
28 
extendrange <- function(x, r = range(x, na.rm = TRUE), f = 0.05)
 44 
extendrange <- function(x, r = range(x, na.rm = TRUE), f = 0.05)
29 
{
 45 
{
30 
    ## Purpose: extend a range by a factor 'f' - on each side
 46 
    ## Purpose: extend a range by a factor 'f' - on each side