R/qmap.R

In ggobi/cranvas: Interactive statistical graphics based on Qt

#' Draw a map
#'
#' This function creates a map based on the data of polygon coordinates.
#' Cartograms can be made by providing appropriate coordinates generated by
#' \code{\link{cart_polygon}}.
#'
#' Common interactions are documented in \code{\link{common_key_press}}.
#' Currently the brushing may be slightly different with other plots: when a
#' region contains multiple sub-regions (polygons), and the whole region will be
#' brushed if any of the sub-regions is brushed.
#'
#' The other feature is that a map can be linked to other datasets so that
#' colors and the brushed status can be obtained from an additional data. This
#' is useful due to the special format of map data: usually it is a waste of
#' memory to store colors for every single boundary points in each region.
#' @param data the map data created by \code{\link{map_qdata}}
#' @param linkto a mutaframe to link to so that the colors and the brushed
#'   status are in sync with this data
#' @param linkby the variable in the \code{linkto} data to be used as a linking
#'   variable (see \code{\link{link_cat}})
#' @param unibrushcolor whether to use multiple colors for the brush, i.e.,
#'   whether to transparentize the unbrushed polygons.
#' @param googleMap whether to have a google map background. The packages
#'   \pkg{ggmap} and \pkg{RgoogleMaps} must be installed.
#' @param place a mutaframe created by \code{\link{qdata}} indicating the
#'   locations that will be shown on the map.
#' @param path a mutaframe of locations created by \code{\link{qdata}}. A path
#'   will be drawn on the map in the order of the mutaframe.
#' @param text a mutaframe of locations and names.
#' @param cartostep a value between 0 and 1. When a cartogram is drawn, the left
#'   arrow and right arrow can be used to evolve the map between the original
#'   map and the cartogram. cartostep controls the evolving speed.
#' @inheritParams qbar
#' @return A map
#' @export
#' @author Heike Hofmann, Yihui Xie, and Xiaoyue Cheng
#' @example inst/examples/qmap-ex.R
qmap = function(
  data, linkto = NULL, linkby = NULL, main = '', xlim = NULL, ylim = NULL,
  unibrushcolor = TRUE, googleMap = FALSE, place = NULL, path = NULL, text = NULL,
  cartostep = 0.05, ...
) {
  data = check_data(data)
  if (is.null(md <- attr(data, 'MapData')))
    stop('data must be created from map_qdata()')
  b = brush(data)
  b$select.only = TRUE; b$draw.brush = FALSE  # a selection brush
  b$alpha = 1
  z = as.list(match.call()[-1])

  ## initialize meta
  meta = Map.meta$new(
    alpha = 1, main = main, active = TRUE, drag.mode = FALSE, cartopar = 1,
    group = cumsum(is.na(md$x) & is.na(md$y)) + 1
  )

  ## compute coordinates/axes-related stuff
  compute_coords = function() {
    r = cbind(
      if (is.null(xlim)) range(md$x, na.rm = TRUE, finite = TRUE) else xlim,
      if (is.null(ylim)) range(md$y, na.rm = TRUE, finite = TRUE) else ylim
    )
    meta$limits = extend_ranges(r)
  }
  compute_coords()
  meta$start.range = as.vector(meta$limits)

  compute_colors = function() {
    meta$border = data$.border
    if (is.null(linkto)) {
      meta$color = if (googleMap) {alpha(data$.color, 0)} else {data$.color}
    } else {
      if (is.null(linkby)) stop("must specify a linking variable in 'linkto'")
      tmp = tapply(linkto$.color, linkto[, as.character(z$linkby)], `[`, 1)
      # use labels to find colors
      meta$color = if (googleMap) {alpha (tmp[data$labels], 0.5)} else {tmp[data$labels]}
    }
  }
  compute_colors()

  ## initialize brush size (1/15 of the layer size)
  meta$brush.size = c(1, -1) * apply(meta$limits, 2, diff) / 15

  ## draw points
  main_draw = function(layer, painter) {
    qdrawPolygon(
      painter, md$x, md$y, stroke = meta$border,
      fill = if (unibrushcolor) {meta$color} else {alpha(meta$color,0.3)}
    )

    # draw warning lines, if points are outside the drawing area r is current range
    #
    # binary array with one column for each variable shouldn't need to check for
    # every single draw, but I'm not sure where the boundaries are changed -
    # compute coord is not called for every zooms e.g.
    meta$outofbounds <- meta$limits
    meta$outofbounds[1,1] <- min(md$x, na.rm=T) < meta$limits[1,1]
    meta$outofbounds[2,1] <- max(md$x, na.rm=T) > meta$limits[2,1]
    meta$outofbounds[1,2] <- min(md$y, na.rm=T) < meta$limits[1,2]
    meta$outofbounds[2,2] <- max(md$y, na.rm=T) > meta$limits[2,2]

    if (sum(meta$outofbounds) > 0) {
      # at least one boundary is too tight
      if (meta$outofbounds[1,1]) qdrawSegment(
        painter, meta$limits[1,1], meta$limits[1,2], meta$limits[1,1], meta$limits[2,2],
        stroke = "red"
      )
      if (meta$outofbounds[1,2]) qdrawSegment(
        painter, meta$limits[1,1], meta$limits[1,2], meta$limits[2,1], meta$limits[1,2],
        stroke = "red"
      )
      # just to make sure that the right hand side and top line show up - they
      # get clipped at the limits, so only half of it shows.
      qlineWidth(painter) = 4
      if (meta$outofbounds[2,2]) qdrawSegment(
        painter, meta$limits[1,1], meta$limits[2,2], meta$limits[2,1], meta$limits[2,2],
        stroke = "red"
      )
      if (meta$outofbounds[2,1]) qdrawSegment(
        painter, meta$limits[2,1], meta$limits[1,2], meta$limits[2,1], meta$limits[2,2],
        stroke = "red"
      )
    }
  }

  ## draw brushed points
  brush_draw = function(layer, painter) {
    idx = selected(data)
    if (any(idx)) {
      i = meta$group %in% which(idx)
      if (unibrushcolor) {
        brush_color = alpha(b$color, b$alpha)  # transparent brush
        qdrawPolygon(painter, md$x[i], md$y[i], stroke = NA, fill = brush_color)
      } else {
        ii = if (is.na(md$x[i][1])) which(i)[-1] else i
        qdrawPolygon(painter, md$x[ii], md$y[ii], stroke = NA, fill = meta$color[idx])
      }
    } else if (!unibrushcolor) {
      qdrawPolygon(painter, md$x, md$y, stroke = meta$border, fill = meta$color)
    }
    draw_brush(layer, painter, data, meta)
  }

  ## draw Google maps
  if (googleMap) {
    meta$googlemaprange = data.frame(ll.lon=0,ur.lon=0,ll.lat=0,ur.lat=0)
    meta$googlecolor = rep('white',1280*1280)
    meta$googlex = meta$googley = rep(0, 1280*1280)
    meta$googlezoom = -1
    google_draw = function(layer,painter) {
      bound=as.matrix(meta$limits)
      googlezoom1=min(RgoogleMaps::MaxZoom(bound[,1], bound[,2], c(640, 640)))
      googlezoom2=round(log(360/max(diff(bound[,1]),diff(bound[,2])),1.8))
      googlezoom=min(googlezoom1,googlezoom2)
      rangecond=any(meta$googlemaprange$ll.lon>c(0.9,0.1)%*%bound[,1],
                    meta$googlemaprange$ur.lon<c(0.1,0.9)%*%bound[,1],
                    meta$googlemaprange$ll.lat>c(0.9,0.1)%*%bound[,2],
                    meta$googlemaprange$ur.lat<c(0.1,0.9)%*%bound[,2])
      if (meta$googlezoom!=googlezoom | rangecond) {
        meta$googlezoom=googlezoom
        message("Extracting the Google map...")
        map=ggmap::get_googlemap(center = c(lon = mean(bound[,1]), lat = mean(bound[,2])),zoom = meta$googlezoom, scale = 2, ...)
        meta$googlemaprange=attr(map, "bb")
        meta$googlecolor=as.vector(map[1:1280, 1:1280])
        realxy=RgoogleMaps::XY2LatLon(list(lat=mean(bound[,2]),lon=mean(bound[,1]),zoom=meta$googlezoom),seq(-320,319.5,0.5),seq(-320,319.5,0.5))
        reallocat=expand.grid(realxy[,2],rev(realxy[,1]))
        meta$googlex=reallocat$Var1
        meta$googley=reallocat$Var2
      }
      googleidx=(findInterval(meta$googlex,bound[,1],rightmost.closed=TRUE)==1 &
                   findInterval(meta$googley,bound[,2],rightmost.closed=TRUE)==1)
      drawgooglecolor=meta$googlecolor[googleidx]
      qdrawGlyph(painter, qglyphSquare(x = min(diff(bound[,1]),diff(bound[,2]))/sqrt(sum(googleidx))),
                 meta$googlex[googleidx], meta$googley[googleidx],
                 stroke = drawgooglecolor, fill = drawgooglecolor)
    }
  }

  ## draw path
  if (!is.null(path)) {
    path = check_data(path)
    path_draw = function(layer,painter) {
      idx = visible(path)
      qlineWidth(painter) <- median(path$.size[idx])
      qdrawLine(painter, path[idx,1], path[idx,2], stroke = path$.color[idx][1])
    }
  }

  ## draw points
  if (!is.null(place)) {
    place = check_data(place)
    place_draw = function(layer,painter) {
      idx = visible(place)
      if (all(place$.size==place$.size[1])) {
        qdrawGlyph(painter, qglyphCircle(r = place$.size[1]),
                   place[idx,1], place[idx,2],
                   stroke = place$.border[idx], fill = place$.color[idx])
      } else {
        qdrawCircle(painter, place[idx,1], place[idx,2], r = place$.size[idx],
                    stroke = place$.border[idx], fill = place$.color[idx])
      }
    }
  }

  ## draw text
  if (!is.null(text)) {
    text = check_data(text)
    text_draw = function(layer,painter) {
      idx = visible(text)
      qdrawText(painter, text[idx,3], text[idx,1], text[idx,2],
                color = text$.color[idx], ...)
    }
  }

  ## events
  brush_mouse_press = function(layer, event) {
    meta$drag.mode = (any(meta$limits[1,] > meta$start.range[c(1,3)]) ||
                        any(meta$limits[2,] < meta$start.range[c(2,4)])) &&
      event$button() == Qt$Qt$LeftButton
    if (meta$drag.mode) {
      meta$start = as.numeric(event$pos())
      b$cursor <- 18L
    } else {
      common_mouse_press(layer, event, data, meta)
    }
  }
  brush_mouse_move = function(layer, event) {
    if (event$button() != Qt$Qt$NoButton) b$cursor <- 0L
    if (meta$drag.mode) {
      meta$pos = as.numeric(event$pos())
      meta$limits = meta$limits + matrix(rep(-meta$pos+meta$start,each=2),nrow=2)
      qupdate(layer.main)
      if (googleMap) qupdate(layer.google)
      if (!is.null(path)) qupdate(layer.path)
      if (!is.null(place)) qupdate(layer.place)
      if (!is.null(text)) qupdate(layer.text)
      return()
    }
    rect = qrect(update_brush_size(meta, event))
    hits = layer$locate(rect) + 1
    if (length(hits)) {
      hits = data$labels %in% unique(data$labels[hits])
    }
    selected(data) = mode_selection(selected(data), hits, mode = b$mode)
    common_mouse_move(layer, event, data, meta)
  }
  brush_mouse_release = function(layer, event) {
    brush_mouse_move(layer, event)
    if (!meta$drag.mode) common_mouse_release(layer, event, data, meta)
  }
  key_press = function(layer, event) {
    common_key_press(layer, event, data, meta)
    if (ncol(md)==6 & !googleMap & is.null(path) & is.null(place) & is.null(text)
        & length(i <- which(match_key(c('Left', 'Right'))))) {
      cartopar = max(0, min(1, c(-1, 1)[i] * cartostep + meta$cartopar))
      if (cartopar != meta$cartopar) {
        meta$cartopar = cartopar
        md$x = md$finalx * meta$cartopar + md$origx * (1 - meta$cartopar)
        md$y = md$finaly * meta$cartopar + md$origy * (1 - meta$cartopar)
        compute_coords()
        meta$start.range = as.vector(meta$limits)
        layer.main$invalidateIndex()
      }
    }
  }
  key_release = function(layer, event) {
    common_key_release(layer, event, data, meta)
  }
  mouse_wheel = function(layer, event) {
    pos = as.numeric(event$pos())
    lim = meta$limits
    p = (pos - lim[1, ]) / (lim[2, ] - lim[1, ])  # proportions to left/bottom
    meta$limits = extend_ranges(
      meta$limits, -sign(event$delta()) * 0.1 * c(p[1], 1 - p[1], p[2], 1 - p[2])
    )
    if (googleMap) qupdate(layer.google)
    if (!is.null(path)) qupdate(layer.path)
    if (!is.null(place)) qupdate(layer.place)
    if (!is.null(text)) qupdate(layer.text)
  }
  identify_hover = function(layer, event) {
    if (!b$identify) return()
    b$cursor = 2L
    meta$pos = as.numeric(event$pos())
    hits = layer$locate(identify_rect(meta)) + 1
    if (length(hits)) {
      hits = which(data$labels %in% unique(data$labels[hits]))
    }
    meta$identified = hits
    qupdate(layer.identify)
  }
  identify_draw = function(layer, painter) {
    if (!b$identify || !length(idx <- meta$identified)) return()
    if (any(idx)) {
      meta$identify.labels = paste(unique(data$labels[idx]), collapse = '\n')
      draw_identify(layer, painter, data, meta)
      i = meta$group %in% idx
      qdrawPolygon(painter, md$x[i], md$y[i], stroke = b$color, fill = NA)
    }
  }

  ## create layers
  scene = qscene()
  layer.root = qlayer(scene)
  layer.main = qlayer(
    paintFun = main_draw,
    mousePressFun = brush_mouse_press, mouseReleaseFun = brush_mouse_release,
    mouseMoveFun = brush_mouse_move, hoverMoveFun = identify_hover,
    keyPressFun = key_press, keyReleaseFun = key_release,
    wheelFun = mouse_wheel,
    focusInFun = function(layer, event) {
      common_focus_in(layer, event, data, meta)
    }, focusOutFun = function(layer, event) {
      common_focus_out(layer, event, data, meta)
    },
    limits = qrect(meta$limits), clip = TRUE, cache = TRUE
  )
  layer.brush = qlayer(paintFun = brush_draw, limits = qrect(meta$limits))
  layer.identify = qlayer(paintFun = identify_draw, limits = qrect(meta$limits))
  layer.title = qmtext(meta = meta, side = 3)
  layer.root[0, 0] = layer.title
  if (googleMap) {
    layer.google = qlayer(paintFun = google_draw, limits = qrect(meta$limits),
                          clip = TRUE, cache = TRUE)
    layer.root[1, 0] = layer.google
  }
  layer.root[1, 0] = layer.main
  layer.root[1, 0] = layer.brush
  layer.root[1, 0] = layer.identify
  if (!is.null(path)) {
    layer.path = qlayer(paintFun = path_draw, limits = qrect(meta$limits),
                        clip = TRUE, cache = TRUE)
    layer.root[1, 0] = layer.path
  }
  if (!is.null(place)) {
    layer.place = qlayer(paintFun = place_draw, limits = qrect(meta$limits),
                         clip = TRUE, cache = TRUE)
    layer.root[1, 0] = layer.place
  }
  if (!is.null(text)) {
    layer.text = qlayer(paintFun = text_draw, limits = qrect(meta$limits),
                        clip = TRUE, cache = TRUE)
    layer.root[1, 0] = layer.text
  }
  layer.root[1, 1] = qlayer()

  ## set sizes of layers (arrange the layout)
  set_layout = function() {
    fix_dimension(layer.root,
                  row = list(id = 0, value = prefer_height(meta$main)),
                  column = list(id = 1, value = 10))
  }
  set_layout()

  ## layout is dynamic (listen to changes in xlab/ylab/xlabels/ylabels...)
  meta$mainChanged$connect(set_layout)

  ## finally create the view and set window title
  view = qplotView(scene = scene)
  view$setWindowTitle(paste("Map:", as.character(z$data)))

  ## listeners on the data (which column updates which layer(s))
  d.idx = add_listener(data, function(i, j) {
    idx = which(j == c('.brushed', '.color', '.border'))
    if (length(idx) < 1) {
      compute_coords()
      layer.main$invalidateIndex(); qupdate(layer.main)
      return()
    } else idx = c(1, 2, 2)[idx]
    switch(idx, qupdate(layer.brush), {
      compute_colors(); qupdate(layer.main)
    })
  })

  if (!is.null(linkto)) {
    id = link_cat(linkto, as.character(z$linkby), data, 'labels')
  }
  ## when layer is destroyed, remove the listener from data
  qconnect(layer.main, 'destroyed', function(x) {
    ## b$colorChanged$disconnect(b.idx)
    remove_listener(data, d.idx)
    if (!is.null(linkto)) {
      remove_link(linkto, id[1]); remove_link(data, id[2])
    }
  })

  ## when b$cursor is changed, update cursor on screen
  b$cursorChanged$connect(function() {
    set_cursor(view, b$cursor)
  })

  ## these layers have the same limits from meta$limits
  sync_limits(
    meta, layer.main, layer.brush, layer.identify,
    if (googleMap) layer.google,
    if (!is.null(path)) layer.path,
    if (!is.null(place)) layer.place,
    if (!is.null(text)) layer.text
  )

  ## simulate brushing
  meta$manual.brush = function(pos) {
    brush_mouse_move(layer = layer.main, event = list(pos = function() pos))
  }

  ## attach meta to the returned value (for post-processing or debugging)
  attr(view, 'meta') = meta
  view
}


Map.meta = setRefClass(
  "Map_meta", contains = "CommonMeta",
  fields = properties(list(
    group = 'numeric', start.range = 'numeric', drag.mode = 'logical',
    outofbounds = 'matrix', googlezoom = 'integer', googlemaprange = 'data.frame',
    googlecolor = 'character', googlex = 'numeric', googley = 'numeric',
    cartopar = 'numeric'
  ))
)



#' Create data for drawing maps
#'
#' This function converts maps data in the \pkg{maps} package to a suitable
#' format for \pkg{cranvas}. Optionally it transforms the data to make
#' cartograms.
#'
#' The function \code{\link[maps]{map}} is used to convert maps data to a list,
#' then the region names are stored in a mutaframe created by
#' \code{\link{qdata}}; the polygon coordinates are stored in an attribute
#' \code{MapData}. If multiple polygons belong to the same upper-level region,
#' the column \code{labels} will store the upper-level region names.
#' @param database see \code{\link[maps]{map}}
#' @param regions see \code{\link[maps]{map}}
#' @inheritParams qdata
#' @param cartogram whether to transform the map data in order to create a
#'   cartogram; if \code{TRUE}, the shape of the cartogram will be determined by
#'   the \code{size} parameter in the data (i.e. \code{data$.size}); see
#'   \code{\link{cart_polygon}} for details
#' @param ... passed to \code{\link{cart_polygon}}
#' @return A mutaframe of region names and labels, with an attribute
#'   \code{MapData} containing the coordinates of polygons.
#' @author Yihui Xie and Xiaoyue Cheng
#' @export
#' @examples library(cranvas); map_qdata('state'); map_qdata('county', 'iowa')
map_qdata = function(
  database, regions = '.',  color = 'gray50', border = 'gray90', size = 4,
  cartogram = FALSE, label = NULL, ...
) {
  library(maps)
  df = map(database, regions, plot = FALSE, fill = TRUE)
  ## usually ':' is the separator but sometimes it is ','
  if (length(label) == length(df$names))
    message('Self-defined labels will build a link between brushed and',
            'unbrushed areas which share the same label.')
  labels = if (length(label) == length(df$names)) {
    label
  } else if (any(grepl(':', df$names, fixed = TRUE))) {
    sapply(strsplit(df$names, ':', fixed = TRUE), `[`, 1)
  } else if (any(grepl(',', df$names, fixed = TRUE))) {
    sapply(strsplit(df$names, ',', fixed = TRUE), `[`, 1)
  } else df$names
  mf = qdata(data.frame(names = df$names, labels = labels, stringsAsFactors = FALSE),
             color = color, border = border, size = size, ...)
  xy = as.data.frame(df[1:2])
  if (cartogram && length(size) > 1 && !near_constant(size)) {
    ## FIXME: cartogram() depends on the magnitude of size!!! so I did not use mf$.size
    xy = cart_polygon(xy$x, xy$y, df$names, size, ...)
    xy$origx = df$x
    xy$origy = df$y
    xy$finalx = xy$x
    xy$finaly = xy$y
    xy = as.mutaframe(xy)
  }
  attr(mf, 'MapData') = xy
  mf
}

#' Calculate coordinates of transformed polygons to make cartograms
#'
#' Based on the given sizes of polygons, this function calculates the
#' transformed coordinates using the \pkg{Rcartogram} package.
#' @param x,y the x and y coordinates of original polygons (polygons are
#'   separated by \code{NA}'s)
#' @param name the names of original polygons
#' @param size the size vector of polygons (length must be equal to the number
#'   of polygons, i.e. the number of \code{NA}'s plus 1)
#' @param nrow,ncol numbers to define a grid for the cartogram algorithm (see
#'   references in \pkg{Rcartogram}); this can affect the convergence and speed
#'   of the algorithm, so may need to be adjusted for a few times
#' @param blank.init weight to fill the NA's of the grids between the range
#'   of density. It will control the diffusing/shrinking within the boundary.
#' @param sea.init weight between the range of density to fill in the sea.
#'   It will control the diffusing/shrinking out of the map boundary.
#' @param sea.width a positive multiplier to pass to the argument \code{sea}
#'   in function \code{\link[Rcartogram]{addBoundary}}.
#' @param blur a non-negative value passed to \code{\link[Rcartogram]{cartogram}}
#' @return A data frame of two columns \code{x} and \code{y} (coordinates of
#'   transformed polygons)
#' @author Yihui Xie and Xiaoyue Cheng
#' @export
#' @example inst/examples/cart_polygon-ex.R
cart_polygon = function(x, y, name, size, nrow = 100, ncol = 100, blank.init=0, sea.init=0,  sea.width=1, blur=0) {
  library(Rcartogram)
  if (length(size) != sum(is.na(x)) + 1)
    stop("the length of 'size' vector must be the same as the number of polygons")
  if (sea.width <= 0) {
    message("sea.width must be greater than 0. Set to be 1.")
    sea.width = 1
  }
  if (blur < 0) {
    message("blur must be non-negative. Set to be 0.")
    blur = 0
  }
  xlim = range(x, na.rm = TRUE); ylim = range(y, na.rm = TRUE)
  dx = c(0, diff(xlim)/1000); dy = c(0, diff(ylim)/1000)  # to construct query rectangle
  gridsize = gridcount = gridrecog = matrix(NA, nrow = nrow, ncol = ncol)
  gx = seq(xlim[1], xlim[2], length = ncol); gy = seq(ylim[1], ylim[2], length = nrow)

  ## we use Qt to query the sizes for grid points
  h = qlayer(paintFun = function(layer, painter) {
    qdrawPolygon(painter, x, y)
  }, limits = qrect(xlim, ylim))
  ## generate the population density matrix (time consuming)
  message(paste('Generating the',nrow,'x',ncol,'population density grid...'))
  pb = txtProgressBar(min = 0, max = nrow, style = 3)
  on.exit(close(pb))
  for (i in seq_len(nrow)) {
    for (j in seq_len(ncol)) {
      hit = h$locate(qrect(gx[j] + dx, gy[i] + dy))
      if (length(hit)) gridsize[i, j] = size[hit[1] + 1]; gridrecog[i,j] = name[hit[1]+1]
    }
    setTxtProgressBar(pb, i)
  }
  #gridrecog[is.na(gridrecog)] = 0
  gridcount = matrix(sapply(gridrecog, function(x){sum(gridrecog==x,na.rm=TRUE)}),nrow=nrow(gridrecog))
  gridcount[is.na(gridsize)] = 1
  # fill NA's with 1% less than min; add margin with min too later
  gridsize[is.na(gridsize)] = min(gridsize, na.rm = TRUE)
  tmp=as.vector(gridsize)/as.vector(gridcount)
  tmp[is.na(gridrecog)] = sum(range(tmp[!is.na(gridrecog)])*c(1-blank.init,blank.init))
  grid = matrix(tmp,nrow=nrow,ncol = ncol)
  grid = addBoundary(grid, sea=sea.width, land.mean = sum(range(grid)*c(1-sea.init,sea.init)))
  extra = attr(grid, 'extra')  # extra rows/cols added
  message(paste('Calculating cartogram coordinates for a',dim(grid)[1],'x',dim(grid)[2],'matrix...'))
  res = cartogram(grid, zero=TRUE, blur=blur, sea=NA)
  pred = predict(res, (x - xlim[1]) / (diff(xlim)) * (ncol - 1) + 1 + extra[1],
                 (y - ylim[1]) / (diff(ylim)) * (nrow - 1) + 1 + extra[2])
  data.frame(x = (pred$x - extra[1] - 1) / (ncol - 1) * diff(xlim) + xlim[1],
             y = (pred$y - extra[2] - 1) / (nrow - 1) * diff(ylim) + ylim[1])
}