Unexpected order of text labels when parse=TRUE

[slowkow]

The problem

Text labels can be displayed in an unexpected order if you use parse = TRUE:

library(ggplot2)
library(patchwork)

d <- data.frame(
  x = c(1, 2, 3),
  y = c(1, 0, 1),
  label = c("alpha", "", "gamma")
)

p <- ggplot(d, aes(x = x, y = y, label = label)) + geom_point(color = "red")

p1 <- p + geom_text(size = 5, parse = FALSE) + labs(title = "Good :)")

p2 <- p + geom_text(size = 5, parse = TRUE) + labs(title = "Bad :(")

ggsave(filename = "issue.png", plot = p1 + p2, width = 4, height = 2)

The culprit: parse() drops empty strings

To my surprise, the parse() function silently drops the empty string:

x <- c("alpha", "", "gamma")
x
#> [1] "alpha" ""      "gamma"
length(x)
#> [1] 3

y <- parse(text = x)
y
#> expression(alpha, gamma)
length(y)
#> [1] 2

c(expression(alpha), expression(), expression(gamma))
#> expression(alpha, gamma)

Unfortunately, I don't know how to deal with this. Do you have any ideas?

A workaround

One workaround is to create a second dataframe just for the text labels. That way, you can avoid passing an empty string to the parse() function.

d2 <- d[d$label != "",]

p3 <- p + geom_text(size = 5, parse = TRUE, data = d2) + labs(title = "Yay :)")

ggsave(filename = "workaround.png", plot = p1 + p3, width = 4, height = 2)

Related issues

@pakidermo5000 originally reported this here: slowkow/ggrepel#114

[aphalo]

NA does behave correctly. parse() does not drop NA, but NAs trigger warnings.
geom_label() also has problems with ""

library(patchwork)

d <- data.frame(
  x = c(1, 2, 3),
  y = c(1, 0, 1),
  label = c("alpha", NA, "gamma")
)

p <- ggplot(d, aes(x = x, y = y, label = label)) + geom_point()

p1 <- p + geom_label(parse = TRUE) + ggtitle("parse = TRUE")

p2 <- p + geom_label(parse = FALSE) + ggtitle("parse = FALSE")

p3 <- p + geom_text(parse = TRUE) + ggtitle("parse = TRUE")

p4 <- p + geom_text(parse = FALSE) + ggtitle("parse = FALSE")

p1 + p2 + p3 + p4

[clauswilke]

This is the code that parses labels for geom_text():

ggplot2/R/geom-text.r

Line 179 in 519a55d

lab <- parse(text = as.character(lab))

I think replacing it by the following would help:

lab <- lapply(lab, function(x) {
    e <- parse(text = x)
    if (length(e) > 0) e[[1]] else ""
  })

Example:

lab <- c("a", "", "c")
lab <- lapply(lab, function(x) {
    e <- parse(text = x)
    if (length(e) > 0) e[[1]] else ""
  })
tg <- grid::textGrob(lab, x = c(.2, .4, .6), y = c(.2, .4, .6))
pg <- grid::pointsGrob(
  x = c(.2, .4, .6), y = c(.2, .4, .6),
  default.units = "npc", size = grid::unit(1.5, "char")
)
grid::grid.newpage()
grid::grid.draw(pg)
grid::grid.draw(tg)

Created on 2018-08-27 by the reprex package (v0.2.0).

Do you want to prepare a pull request? It might make sense to encapsulate the parsing code into a function and use throughout ggplot2.

[slowkow]

Thanks for sharing your code, Claus. I'll try to prepare a pull request today.

[slowkow]

First, let's see how ggplot2 behaves before I make any modifications.

ggplot2 before modification

Example 0

dev.off()
library(ggplot2)
library(patchwork)

d <- data.frame(
  x = c(1, 2, 3),
  y = c(1, 0, 1),
  label = c("alpha", "", "gamma"),
  stringsAsFactors = FALSE
)

p <- ggplot(d, aes(x = x, y = y, label = label)) + geom_point(color = "red")

p1 <- p + geom_text(size = 5) + labs(title = "parse = FALSE")

p2 <- p + geom_text(size = 5, parse = TRUE) + labs(title = "parse = TRUE")

p1 + p2

I get exactly the same result for stringsAsFactors = TRUE and stringsAsFactors = FALSE.

---

ggplot2 after modification

I made this modification to geom-text.r:

    lab <- data$label
    if (parse) {
      # lab <- parse(text = as.character(lab))
      lab <- sapply(lab, function(x) {
        e <- parse(text = x)
        if (length(e) > 0) e else ""
      })
    }

Now let's see some examples of how this new code behaves:

Example 1 - Good

dev.off()
library(ggplot2)
library(patchwork)

d <- data.frame(
  x = c(1, 2, 3),
  y = c(1, 0, 1),
  label = c("alpha", "", "gamma"),
  stringsAsFactors = FALSE
)

p <- ggplot(d, aes(x = x, y = y, label = label)) + geom_point(color = "red")

p1 <- p + geom_text(size = 5) + labs(title = "parse = FALSE")

p2 <- p + geom_text(size = 5, parse = TRUE) + labs(title = "parse = TRUE")

p1 + p2

Example 2 - Bad

dev.off()
library(ggplot2)
library(patchwork)

d <- data.frame(
  x = c(1, 2, 3),
  y = c(1, 0, 1),
  label = c("alpha", "", "gamma"),
  stringsAsFactors = TRUE
)

p <- ggplot(d, aes(x = x, y = y, label = label)) + geom_point(color = "red")

p1 <- p + geom_text(size = 5) + labs(title = "parse = FALSE")

p2 <- p + geom_text(size = 5, parse = TRUE) + labs(title = "parse = TRUE")

p1 + p2

[slowkow]

In summary:

Claus, your code almost worked, but I got undesired behavior when I used stringsAsFactors = TRUE.

So, I wrote this new function inspired by your code:

parse_safe <- function(text) {
  text <- as.character(text)
  ix <- which(sapply(text, function(x) {
    length(parse(text = x)) == 0
  }))
  text[ix] <- NA
  parse(text = text)
}

x <- c("alpha", " ", "gamma")
length(parse(text = x))
#> [1] 2
length(parse_safe(text = x))
#> [1] 3

There might be some edge cases that I haven't thought about. Any comments or suggestions are more than welcome.

[clauswilke]

It seems awkward to parse twice. Could you provide a reprex that generates issues when using stringsAsFactors = TRUE? Maybe we can solve the problem differently.

[hadley]

I think you'll need something like this:

parse_safe <- function(x) {
  unlist(lapply(x, parse_one), recursive = FALSE)
}

parse_one <- function(x) {
  expr <- parse(text = x)
  if (length(expr) == 0) list("") else list(expr[[1]])
}

str(parse_safe(c("", " ")))
#> List of 2
#>  $ : chr ""
#>  $ : chr ""
str(parse_safe(c("x", "y", "z")))
#> List of 3
#>  $ : symbol x
#>  $ : symbol y
#>  $ : symbol z
str(parse_safe(c("x\ny", "y;z")))
#> List of 2
#>  $ : symbol x
#>  $ : symbol y

I'm not sure what to do when the label contains multiple expressions. It might be better to combine them with some plotmath syntax.

[hadley]

Slightly nicer with a for loop

parse_safe <- function(x) {
  out <- vector("list", length(x))
  for (i in seq_along(x)) {
    expr <- parse(text = x[[i]])  
    out[[i]] <- if (length(expr) == 0) "" else expr[[1]]
  }
  out
}

str(parse_safe(c("", " ")))
#> List of 2
#>  $ : chr ""
#>  $ : chr ""
str(parse_safe(c("x", "y", "z")))
#> List of 3
#>  $ : symbol x
#>  $ : symbol y
#>  $ : symbol z
str(parse_safe(c("x\ny", "y;z")))
#> List of 2
#>  $ : symbol x
#>  $ : symbol y

Created on 2018-08-28 by the reprex
package (v0.2.0).

[slowkow]

Hadley, your function is not working for me.

parse_kamil <- function(text) {
  text <- as.character(text)
  ix <- which(sapply(text, function(x) {
    length(parse(text = x)) == 0
  }))
  text[ix] <- NA
  parse(text = text)
}

parse_claus <- function(text) {
  sapply(text, function(x) {
    e <- parse(text = x)
    if (length(e) > 0) e else ""
  })
}

parse_hadley <- function(text) {
  out <- vector("list", length(text))
  for (i in seq_along(text)) {
    expr <- parse(text = text[[i]])
    out[[i]] <- if (length(expr) == 0) "" else expr[[1]]
  }
  out
}

Factor:

x <- factor(c("alpha", " ", "gamma"))
length(parse(text = x))
#> [1] 3
length(parse_kamil(text = x))
#> [1] 3
length(parse_claus(text = x))
#> [1] 3
length(parse_hadley(text = x))
#> [1] 3

parse(text = x)
#> expression(a,  , g)
parse_kamil(text = x)
#> expression(alpha, NA, gamma)
parse_claus(text = x)
#> expression(2, 1, 3)
parse_hadley(text = x)
#> [[1]]
#> [1] 2
#> 
#> [[2]]
#> [1] 1
#> 
#> [[3]]
#> [1] 3

String:

x <- c("alpha", " ", "gamma")
length(parse(text = x))
#> [1] 2
length(parse_kamil(text = x))
#> [1] 3
length(parse_claus(text = x))
#> [1] 3
length(parse_hadley(text = x))
#> [1] 3

parse(text = x)
#> expression(alpha, gamma)
parse_kamil(text = x)
#> expression(alpha, NA, gamma)
parse_claus(text = x)
#> expression(alpha = alpha, ` ` = "", gamma = gamma)
parse_hadley(text = x)
#> [[1]]
#> alpha
#> 
#> [[2]]
#> [1] ""
#> 
#> [[3]]
#> gamma

[clauswilke]

Both Hadley's and my function need text <- as.character(text) to handle factors. Your version of Hadley's function also needs an unlist().

[clauswilke]

parse_kamil <- function(text) {
  text <- as.character(text)
  ix <- which(sapply(text, function(x) {
    length(parse(text = x)) == 0
  }))
  text[ix] <- NA
  parse(text = text)
}

parse_claus <- function(text) {
  text <- as.character(text)
  sapply(text, function(x) {
    e <- parse(text = x)
    if (length(e) > 0) e else ""
  })
}

parse_hadley <- function(text) {
  text <- as.character(text)
  out <- vector("list", length(text))
  for (i in seq_along(text)) {
    expr <- parse(text = text[[i]])
    out[[i]] <- if (length(expr) == 0) "" else expr[[1]]
  }
  unlist(out)
}

# factor
x <- factor(c("alpha", " ", "gamma"))
parse(text = x)
#> expression(a,  , g)
parse_kamil(text = x)
#> expression(alpha, NA, gamma)
parse_claus(text = x)
#> expression(alpha = alpha, ` ` = "", gamma = gamma)
parse_hadley(text = x)
#> [[1]]
#> alpha
#> 
#> [[2]]
#> [1] ""
#> 
#> [[3]]
#> gamma

# string
x <- c("alpha", " ", "gamma")
parse(text = x)
#> expression(alpha, gamma)
parse_kamil(text = x)
#> expression(alpha, NA, gamma)
parse_claus(text = x)
#> expression(alpha = alpha, ` ` = "", gamma = gamma)
parse_hadley(text = x)
#> [[1]]
#> alpha
#> 
#> [[2]]
#> [1] ""
#> 
#> [[3]]
#> gamma

Created on 2018-08-28 by the reprex package (v0.2.0).

[clauswilke]

Actually, I was wrong about the unlist(). It's not required. Note that textGrob() will happily take a list of expressions, it doesn't require an expression object as input.

[slowkow]

Here's what I see:

It looks like Hadley's function doesn't allow the expressions to render in the output.

Code:

library(ggplot2)
library(patchwork)

d1 <- data.frame(
  x = c(1, 2, 3),
  y = c(1, 0, 1),
  label = c("alpha ~ beta", " ", "gamma"),
  stringsAsFactors = FALSE
)
p <- ggplot(d1, aes(x = x, y = y, label = label)) + geom_point(size = 5, color = "red")
p1 <- p + geom_label() + labs(title = "stringsAsFactors = FALSE\nparse = FALSE")
p2 <- p + geom_label(parse = TRUE) + labs(title = "stringsAsFactors = FALSE\nparse = TRUE")
p1 + p2
ggsave(filename = "pullXXX/d1-label.png", plot = p1 + p2, width = 6, height = 3)