2013-05-29 16 views
5

Mam spersonalizowaną funkcję do kreślenia wypełnionych konturów, która jest w dużej mierze oparta na pracy Carey McGilliard i Bridget Ferris (http://wiki.cbr.washington.edu/qerm/sites/qerm/images/1/16/Filled.contour3.R) i http://wiki.cbr.washington.edu/qerm/index.php/R/Contour_Plots.filled.contour w R 3.0.x zgłasza błąd

funkcja filled.contour3 biegnie idealnie w R 2.15.3 ale zgłasza błąd w R 3.0.x

Error in .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), : 
    there is no .Internal function 'filledcontour' 

mógłbyś mi pomóc z roztworu lub workarround tak, że mogę korzystać z funkcji filled.contour3() w R 3.0.x. * Duża część mojej pracy zależy od tej funkcji i jestem na LInux, więc zmiana wersji R nie jest tak prosta w przypadku maszyn produkcyjnych. Będzie szczęśliwy oferując nagrodę. *

do odtworzenia błędu należy zaopatrywać się najpierw następujące

filled.contour3 <- 
    function (x = seq(0, 1, length.out = nrow(z)), 
         y = seq(0, 1, length.out = ncol(z)), z, xlim = range(x, finite = TRUE), 
         ylim = range(y, finite = TRUE), zlim = range(z, finite = TRUE), 
         levels = pretty(zlim, nlevels), nlevels = 20, color.palette = cm.colors, 
         col = color.palette(length(levels) - 1), plot.title, plot.axes, 
         key.title, key.axes, asp = NA, xaxs = "i", yaxs = "i", las = 1, 
         axes = TRUE, frame.plot = axes,mar, ...) 
    { 
     # modification by Ian Taylor of the filled.contour function 
     # to remove the key and facilitate overplotting with contour() 
     # further modified by Carey McGilliard and Bridget Ferris 
     # to allow multiple plots on one page 

     if (missing(z)) { 
      if (!missing(x)) { 
       if (is.list(x)) { 
        z <- x$z 
        y <- x$y 
        x <- x$x 
       } 
       else { 
        z <- x 
        x <- seq.int(0, 1, length.out = nrow(z)) 
       } 
      } 
      else stop("no 'z' matrix specified") 
     } 
     else if (is.list(x)) { 
      y <- x$y 
      x <- x$x 
     } 
     if (any(diff(x) <= 0) || any(diff(y) <= 0)) 
      stop("increasing 'x' and 'y' values expected") 
     # mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar 
     # on.exit(par(par.orig)) 
     # w <- (3 + mar.orig[2]) * par("csi") * 2.54 
     # par(las = las) 
     # mar <- mar.orig 
     plot.new() 
     # par(mar=mar) 
     plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp) 
     if (!is.matrix(z) || nrow(z) <= 1 || ncol(z) <= 1) 
      stop("no proper 'z' matrix specified") 
     if (!is.double(z)) 
      storage.mode(z) <- "double" 
     .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), 
                 col = col)) 
     if (missing(plot.axes)) { 
      if (axes) { 
       title(main = "", xlab = "", ylab = "") 
       Axis(x, side = 1) 
       Axis(y, side = 2) 
      } 
     } 
     else plot.axes 
     if (frame.plot) 
      box() 
     if (missing(plot.title)) 
      title(...) 
     else plot.title 
     invisible() 
    } 


filled.legend <- 
    function (x = seq(0, 1, length.out = nrow(z)), y = seq(0, 1, 
                               length.out = ncol(z)), z, xlim = range(x, finite = TRUE), 
         ylim = range(y, finite = TRUE), zlim = range(z, finite = TRUE), 
         levels = pretty(zlim, nlevels), nlevels = 20, color.palette = cm.colors, 
         col = color.palette(length(levels) - 1), plot.title, plot.axes, 
         key.title, key.axes, asp = NA, xaxs = "i", yaxs = "i", las = 1, 
         axes = TRUE, frame.plot = axes, ...) 
    { 
     # modification of filled.contour by Carey McGilliard and Bridget Ferris 
     # designed to just plot the legend 
     if (missing(z)) { 
      if (!missing(x)) { 
       if (is.list(x)) { 
        z <- x$z 
        y <- x$y 
        x <- x$x 
       } 
       else { 
        z <- x 
        x <- seq.int(0, 1, length.out = nrow(z)) 
       } 
      } 
      else stop("no 'z' matrix specified") 
     } 
     else if (is.list(x)) { 
      y <- x$y 
      x <- x$x 
     } 
     if (any(diff(x) <= 0) || any(diff(y) <= 0)) 
      stop("increasing 'x' and 'y' values expected") 
     # mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar 
     # on.exit(par(par.orig)) 
     # w <- (3 + mar.orig[2L]) * par("csi") * 2.54 
     #layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w))) 
     # par(las = las) 
     # mar <- mar.orig 
     # mar[4L] <- mar[2L] 
     # mar[2L] <- 1 
     # par(mar = mar) 
     # plot.new() 
     plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i", 
           yaxs = "i") 
     rect(0, levels[-length(levels)], 1, levels[-1L], col = col) 
     if (missing(key.axes)) { 
      if (axes) 
       axis(4) 
     } 
     else key.axes 
     box() 
    } 
# 
# if (!missing(key.title)) 
#  key.title 
# mar <- mar.orig 
# mar[4L] <- 1 
# par(mar = mar) 
# plot.new() 
# plot.window(xlim, ylim, "", xaxs = xaxs, yaxs = yaxs, asp = asp) 
# if (!is.matrix(z) || nrow(z) <= 1L || ncol(z) <= 1L) 
#  stop("no proper 'z' matrix specified") 
# if (!is.double(z)) 
#  storage.mode(z) <- "double" 
# .Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), 
#  col = col)) 
# if (missing(plot.axes)) { 
#  if (axes) { 
#   title(main = "", xlab = "", ylab = "") 
#   Axis(x, side = 1) 
#   Axis(y, side = 2) 
#  } 
# } 
# else plot.axes 
# if (frame.plot) 
#  box() 
# if (missing(plot.title)) 
#  title(...) 
# else plot.title 
# invisible() 
#} 

a następnie uruchomić

#Example Four Panel Contour Plot with One Legend 
#Author: Carey R McGilliard 
#September 2010 

#This code uses a modified version of filled.contour called filled.contour3 (created by Carey McGilliard, Ian Taylor, and Bridget Ferris) 
#to make an example figure of four contour plots sharing a legend (to the right). 
#The example demonstrates how to use various color schemes for the contour plots and legend, but the user will want to 
#pick one color scheme for all four plots such that the legend matches the plots. 
#Changing the x- and y-axis values will change the placement of text added to the figure using the text() function and adjustments will be necessary 


#Source the following functions (change the paths as necessary) 
#source("./print.letterTrevor.R") 

#gplots has the function colorpanel, which is handy for making gray-scale contour plots 
library(gplots) 

#------------------------------------------------------ 
#Generate some fake data 
x = rep(c(10,11,12),length = 9) 
y = rep(c(1,2,3),each = 3) 
z = rnorm(n=9,mean = 0,sd = 1) 


xcoords = unique(x) 
ycoords = unique(y) 
surface.matrix = matrix(z,nrow=length(xcoords),ncol=length(ycoords),byrow=T) 
#------------------------------------------------------ 

#plot.new() is necessary if using the modified versions of filled.contour 
plot.new() 

#I am organizing where the plots appear on the page using the "plt" argument in "par()" 
par(new = "TRUE",    
     plt = c(0.1,0.4,0.60,0.95), # using plt instead of mfcol (compare 
     # coordinates in other plots) 
     las = 1,      # orientation of axis labels 
     cex.axis = 1,     # size of axis annotation 
     tck = -0.02)     # major tick size and direction, < 0 means outside 

#Top left plot: 
# 
# the filled contour - coloured areas 
filled.contour3(xcoords, 
           ycoords, 
           surface.matrix, 
           color=terrain.colors, 
           xlab = "",  # suppress x-axis annotation 
           ylab = "",  # suppress y-axis annotation 
           xlim = c(min(xcoords),max(xcoords)), 
           ylim = c(min(ycoords),max(ycoords)), 
           zlim = c(min(surface.matrix),max(surface.matrix)) 
) 
# the contour part - draw iso-lines 
contour(xcoords, 
       ycoords, 
       surface.matrix, 
       color=terrain.colors, 
       xlab = "", 
       ylab = "", 
       xlim = c(min(xcoords),max(xcoords)), 
       ylim = c(min(ycoords),max(ycoords)), 
       zlim = c(min(surface.matrix),max(surface.matrix)), 
       add=TRUE,     # add the contour plot to filled-contour, 
       #thus making an overlay 
       col = grey(0.4)   # color of overlay-lines 
) 
# 
# An annotation inside first plot 
#The xpd=NA allows for writing outside the plot limits, but still using the the x and y axes to place the text 
par(xpd = NA) 
text(x=11,y=1.5,"x",cex = 1.5,font = 2) 
print.letter(text = "(a)") 

###################################################################### 
# 
# 
#Top right plot: 
par(new = "TRUE", 
     plt = c(0.5,0.8,0.60,0.95), # defining window for second plot 
     las = 1, 
     cex.axis = 1) 
# 
filled.contour3(
    xcoords, 
    ycoords, 
    surface.matrix, 
    color=heat.colors, 
    xlab = "", 
    ylab = "", 
    xlim = c(min(xcoords),max(xcoords)), 
    ylim = c(min(ycoords),max(ycoords)), 
    zlim = c(-1,1) 
) 
# 
contour(
    xcoords, 
    ycoords, 
    surface.matrix, 
    xlab = "", 
    ylab = "", 
    xlim = c(min(xcoords),max(xcoords)), 
    ylim = c(min(ycoords),max(ycoords)), 
    zlim = c(-1,1), 
    add=TRUE 
) 
# 
#Alternatively, you could set z axis limits to depend 
#on the min and max values in surface.matrix. 
#filled.contour3(xcoords,ycoords,surface.matrix,color=heat.colors,xlab = "",ylab = "",xlim = c(min(xcoords),max(xcoords)),ylim = c(min(ycoords),max(ycoords)),zlim = c(min(surface.matrix),max(surface.matrix))) 
# 
# Add annotation 
text(x=11, 
     y=1.5, 
     "x", 
     cex = 1.5, 
     font = 2) 


###################################################################### 
# 
#Bottom left plot: 
par(new = "TRUE", 
     plt = c(0.1,0.4,0.15,0.5), 
     las = 1, 
     cex.axis = 1) 
# 
filled.contour3(xcoords, 
           ycoords, 
           surface.matrix, 
           col=colorpanel(11, "white", "grey10"), 
           nlevels=11, 
           xlab = "", 
           ylab = "", 
           xlim = c(min(xcoords),max(xcoords)), 
           ylim = c(min(ycoords),max(ycoords)), 
           zlim = c(-1,1)) 
# 
contour(xcoords, 
       ycoords, 
       surface.matrix, 
       xlab = "", 
       ylab = "", 
       xlim = c(min(xcoords),max(xcoords)), 
       ylim = c(min(ycoords),max(ycoords)), 
       zlim = c(-1,1), 
       add = TRUE) 
# 
text(x=11, 
     y=1.5, 
     "x", 
     cex = 1.5, 
     font = 2, 
     col = "white") 


###################################################################### 
# 
#Bottom right plot: 
par(new = "TRUE", 
     plt = c(0.5,0.8,0.15,0.5), 
     las = 1, 
     cex.axis = 1) 
# 
filled.contour3(
    xcoords, 
    ycoords, 
    surface.matrix, 
    color = terrain.colors, 
    xlab = "", 
    ylab = "", 
    xlim = c(min(xcoords),max(xcoords)), 
    ylim = c(min(ycoords),max(ycoords)), 
    zlim = c(-1,1) 
) 
# 
contour(
    xcoords, 
    ycoords, 
    surface.matrix, 
    xlab = "", 
    ylab = "", 
    xlim = c(min(xcoords),max(xcoords)), 
    ylim = c(min(ycoords),max(ycoords)), 
    zlim = c(-1,1), 
    add=TRUE 
) 

text(x=11, 
     y=1.5, 
     "hello", 
     cex = 1.5, 
     font = 2) 


# 
###################################################################### 
#Add a legend: 
par(new = "TRUE", 
     plt = c(0.85,0.9,0.25,0.85), # define plot region for legend 
     las = 1, 
     cex.axis = 1) 
# 
filled.legend(
    xcoords, 
    ycoords, 
    surface.matrix, 
    color = terrain.colors, 
    xlab = "", 
    ylab = "", 
    xlim = c(min(xintercepts),max(xintercepts)), 
    ylim = c(min(slopes),max(slopes)), 
    zlim = c(-1,1)) 

#Add some figure labels 
par(xpd=NA,cex = 1.3) 
text(x = -16.7,y = 0,"slope",srt = 90,cex = 1.3) 
text(x = -8,y = -1.62,expression(paste(italic(x),"-intercept",sep = "")),cex = 1.3) 

Odpowiedz

7

Dzieje się tak, jeśli używasz niestandardowego API. Możesz to zrobić, ale nie możesz oczekiwać, że zostanie on utrzymany.

Zmień

.Internal(filledcontour(as.double(x), as.double(y), z, as.double(levels), 
                 col = col)) 

do

.filled.contour(as.double(x), as.double(y), z, as.double(levels), 
          col = col) 

Zmiana została ogłoszona z release notes:

kodu C grafika bazowego bazowe zostały przeniesione do grafiki pakietowych (i dlatego nie używa już wywołań .Internal()).

Czy kiedykolwiek słyszałeś o "minimal reproducible example" (nacisk na "minimalny")?

+0

Wielkie dzięki. Użyłem niestandardowego interfejsu API, ponieważ podstawowa funkcja wypełniona.contour dysfunkcji R ze złożonymi wypełnionymi działkami (dodawanie tekstu, legend itp.). Zastanawiam się, czy ta zmiana w R 3.0.x jest udokumentowana w dowolnym miejscu? – ECII

+0

Oczywiście. Dodałem cytat do pytania. – Roland

+0

podobnie jak nacisk na "minimalny" w tej odpowiedzi. Byłoby bardzo łatwo zrobić to pytanie. – MHH

Powiązane problemy