How to set symbol to line in grid_legend in R

Question

I am plotting a legend in a new grid page in R. The code is as following:

grid.newpage()
grid_legend(x=unit(0.5, "npc"),y=unit(0.1, "npc"), pch = c(1,1), col = c("red", "blue"), labels = c("Loess Regression", "Linear Regression"), title = "Line")

I would like to change the symbol to line because I am plotting regression lines. Also, I would like to make two labels in one line. How can I do it? Thanks.

Answer 1

I guess your refer to the function grid_legend() from R package vcd.

Find below a modified version which is more flexible and allows to draw lines instead of symbols.

(The code to generate the figure is also posted.)

grid_legend <- function (x, y, pch = NA, col = par('col'), labels, frame = TRUE, 
  hgap = unit(0.8, "lines"), vgap = unit(0.8, "lines"), default_units = "lines", 
  gp = gpar(), draw = TRUE, title = NULL, just = 'center', lwd = NA, lty = NA, 
  gp.title = NULL, gp.labels = NULL, gp.frame = gpar(fill = "transparent")) 
{

  if(is.character(x))
    switch(x,
           topleft = {x = unit(0,'npc'); y = unit(1,'npc'); just = c(0,1)},
           topright = {x = unit(1,'npc'); y = unit(1,'npc'); just = c(1,1)},
           bottomright = {x = unit(1,'npc'); y = unit(0,'npc'); just = c(1,0)},
           bottomleft = {x = unit(0,'npc'); y = unit(0,'npc'); just = c(0,0)})

  labels <- as.character(labels)
  nlabs <- length(labels)

  if(length(pch) == 1)
    pch <- rep(pch, nlabs)
  if(length(lwd) == 1)
    lwd <- rep(lwd, nlabs)
  if(length(lty) == 1)
    lty <- rep(lty, nlabs)
  if(length(col) == 1)
    col <- rep(col, nlabs)
  if(length(gp.labels) == 1)
    gp.labels <- rep(list(gp.labels), nlabs)


  if (is.logical(title) && !title) 
    title <- NULL
  ifelse(is.null(title), tit <- 0, tit <- 1)

  if (!is.unit(hgap)) 
    hgap <- unit(hgap, default_units)
  if (length(hgap) != 1) 
    stop("hgap must be single unit")
  if (!is.unit(vgap)) 
    vgap <- unit(vgap, default_units)
  if (length(vgap) != 1) 
    stop("vgap must be single unit")

  if(tit)
    legend.layout <- grid.layout(nlabs + tit, 3,
                                 widths = unit.c(unit(2, "lines"),
                                 max(unit(rep(1, nlabs), "strwidth", as.list(c(labels))),
                                 unit(1, "strwidth", title) - unit(2, "lines")), hgap),
                                 heights = unit.pmax(unit(1, "lines"),
                                 vgap + unit(rep(1, nlabs + tit ),
                                           "strheight", as.list(c(labels,title)))))
  else
     legend.layout <- grid.layout(nlabs, 3, widths = unit.c(unit(2, 
      "lines"), max(unit(rep(1, nlabs), "strwidth", as.list(labels))), 
      hgap), heights = unit.pmax(unit(1, "lines"), vgap + unit(rep(1, 
      nlabs), "strheight", as.list(labels))))

  fg <- frameGrob(layout = legend.layout, gp = gp)

  if (tit)
    fg <- placeGrob(fg, textGrob(title, x = .2, y = 0.5, just = c("left", "center"), gp = gp.title), col = 1, row = 1)

  for (i in 1:nlabs) {
    if(!is.na(pch[i]))
      fg <- placeGrob(fg, pointsGrob(0.5, 0.5, pch = pch[i], gp = gpar(col = col[i])), col = 1, row = i + tit)
      else if(!is.na(lwd[i]) || !is.na(lty[i]))
        fg <- placeGrob(fg, linesGrob( unit(c(0.2, .8), "npc"),  unit(c(.5), "npc"), 
                                gp = gpar(col = col[i], lwd = lwd[i], lty=lty[i])), col = 1, row = i + tit)

    fg <- placeGrob(fg, textGrob(labels[i], x = .1, y = 0.5, just = c("left", "center"), gp = gp.labels[[i]]), col = 2, row = i + tit)
  }

  pushViewport(viewport(x, y, height = grobHeight(fg), width = grobWidth(fg), just = just ))

  if (frame) 
    fg <- placeGrob(fg, rectGrob(gp = gp.frame))
  if (draw) 
    grid.draw(fg)
  popViewport(1)
  invisible(fg)
}

Example

require(grid)
png("grid_legend.png", 500, 400)
grid.newpage()
pushViewport(viewport(height = .9, width = .9 ))
grid.rect(gp = gpar(lwd = 2, lty = 2))

grid_legend(x = unit(.05,'npc'),
            y = unit(.05,'npc'),
            just = c(0,0),
            pch = c(1,2,3),
            col = c(1,2,3),
            lwd=NA, 
            lty=NA,
            labels = c("b",'r','g'),
            title = NULL,
            gp=gpar(lwd=2, cex=1),
            hgap = unit(.8, "lines"),
            vgap = unit(.9, "lines"))

grid_legend(x = unit(1,'npc'),
            y = unit(1,'npc'),
            just = c(1,1),
            pch = NA,
            col = c(1,2,3,4),
            lwd=c(1,1,1,3), 
            lty=c(1,2,1,3),
            labels = c("black",'red','green','blue'),
            gp.labels = list(gpar(col = 1), gpar(col = 2), 
                             gpar(col = 3), gpar(col = 4)),
            title = NULL,
            gp=gpar(lwd=2, cex=1),
            hgap = unit(.8, "lines"),
            vgap = unit(.9, "lines"))

grid_legend(x = 'topleft',
            pch = c(1,NA,2,NA),
            col = c(1,2,3,4),
            lwd=NA, 
            lty=c(NA,2,NA,3),
            labels = c("black",'red','green','blue'),
            title = 'Some LONG Title',
            gp.title = gpar(col = 3),
            gp.frame = gpar(col = 4, lty = 2, fill = "transparent"),
            gp.labels = gpar(col = 6),
            gp=gpar(lwd=2, cex=2, col = 1),
            hgap = unit(.8, "lines"),
            vgap = unit(.9, "lines"))


grid_legend(x = .7,
            y = .7,
            pch = c(1,NA,2,NA),
            col = c(1,2,3,4),
            lwd=1, 
            lty=c(NA,2,NA,3),
            labels = c("black",'red','green','blue'),
            title = 'short T',
            gp=gpar(lwd=1, cex=.7,col = 1),
            hgap = unit(.8, "lines"),
            vgap = unit(.9, "lines"))

grid_legend(x = 'bottomright',
            pch = c(1,NA,2,NA),
            col = c(2),
            lwd=NA, 
            lty=c(NA,2,NA,3),
            labels = c("black",'red','green','blue'),
            title = NULL,
            gp=gpar(lwd=2, cex=1,col = 1),
            hgap = unit(.8, "lines"),
            vgap = unit(.9, "lines"))
dev.off()