as.character removes backticks from parsed R script

Viewed 175

I'm searching R scripts and not sure why as.character() drops the `[`. Is there some way to get the code back correctly as a vector of strings?

Notice the `[`(. < 5) turns into (. < 5)[]

Note: I'm not looking for better ways to make this call as this isn't my code.

code <- 
  "1:10 %>% `[`(. < 5) %>% mean()
   a <- 1:3"

# fine
parse(text = code)
#> expression(1:10 %>% `[`(. < 5) %>% mean(), a <- 1:3)

# not fine
as.character(parse(text = code))
#> [1] "1:10 %>% (. < 5)[] %>% mean()" 
#> [2] "a <- 1:3"

Created on 2020-07-01 by the reprex package (v0.3.0)

The issue is that I need to substitute out parts of the code so that my function works. The function finds reactive commands and changes them to functions for the user to access in their environment. It's part of my shinyobjects package (shameless plug).

a <- reactive({
  input$n * 100
})

and converts it to

a <- function() {
  input$n *100
}

The methods I have been using have been fine until this edge case with the `[`.

The solution should be able to return each expression as something I can manipulate. This is a more complex example and should return a string vector of length 5. I'm also happy to take this discussion offline as I'm open to a better method overall for this functionality. You can find my contact here

code <- 
'library(tidyverse)
library(shiny)

1:10 %>% `[`(. < 5) %>% mean()

df <- reactive({
  mpg %>% 
  filter(cty > input$cty)
})

renderPlot(
  ggplot(df(), aes(class)) +
  geom_bar()
)'  
3 Answers

(I've edited this a bit to explain the behaviour some more):

The problem is that magrittr's pipe operator uses non-standard evaluation inconsistently.

The expression

`[`(. < 5)

is legal R code that is equivalent to what was deparsed:

 (. < 5)[]

However, it's a weird enough expression that magrittr gets confused by it, and doesn't transform

 1:10 %>% (. < 5)[] 

the same way it would transform

 1:10 %>% `[`(. < 5)

I wouldn't call this a bug in magrittr (it's documented behaviour, if you look closely enough), but it's certainly an inconvenience caused by the inconsistent handling of dots. Normally if you put a dot in a term in a magrittr chain, that's the only place that the previous result is put in. For example, this doesn't print "foobar" twice:

"foobar" %>% cat("arg1", ., "arg3")

However, if the dot is in a function call in the chain, it is also inserted at the start:

"foobar" %>% cat("arg1", identity(.), "arg3")

does print it twice.

magrittr is evaluating 1:10 %>% [(. < 5) as

`[`(1:10, 1:10 < 5)

i.e.

(1:10)[1:10 < 5]

Really for consistency it would require you to type

1:10 %>% `[`(., . < 5)

but it is trying to be helpful, which is what is so unhelpful for what you want to do.

I suppose you could write a function to detect these cases yourself, and insert the extra dot explicitly.

Edited to add: Here's such a function:

explicitDots <- function(expr) {
  nestedDot <- function(lang) {
    if (is.call(lang)) {
      for (i in seq_along(lang)) {
        if (nestedDot(lang[[i]]))
          return(TRUE)
      }
      return(FALSE)
    } else 
      identical(lang, quote(.))
  }
  fixLang <- function(lang) {
    if (is.call(lang)) {
      fn <- lang[[1]]
      if (as.character(fn) == "%>%") {
        lang[[2]] <- fixLang(lang[[2]])
        lang[[3]] <- fixLang(lang[[3]])
      } else {
        hasTopLevelDot <- FALSE
        hasNestedDot <- FALSE
        for (i in seq_along(lang)[-1]) {
          if (identical(lang[[i]], quote(.))) {
            hasTopLevelDot <- TRUE
            break
          }
          hasNestedDot <- hasNestedDot || nestedDot(lang[[i]])
        }
        if (hasNestedDot && !hasTopLevelDot) {
          # Insert a dot in position 2
          lang <- lang[c(1,seq_along(lang))]
          lang[[2]] <- quote(.)
        }
      }
    }
    lang
  }
  expr <- removeSource(expr)
  for (i in seq_along(expr)) {
    expr[[i]] <- fixLang(expr[[i]])
  }
  expr
}

And here's an example using it:

code <- 
  "1:10 %>% `[`(. < 5) %>% mean()
   a <- 1:3"

p <- parse(text = code)
explicitDots(p)

which produced this output:

expression(1:10 %>% .[. < 5] %>% mean(), a <- 1:3)

If we need to get a vector of strings, one option is strsplit on the nextline character followed by zero or more spaces

out <- strsplit(code, "\n\\s*")[[1]]
out
#[1] "1:10 %>% `[`(. < 5) %>% mean()" 
#[2] "a <- 1:3" 

sapply(out, function(x) eval(parse(text = x)))
#$`1:10 %>% `[`(. < 5) %>% mean()`
#[1] 2.5

#$`a <- 1:3`
#[1] 1 2 3

First of all, you should be aware of the "never use parse " rule -- there are always better ways.

Next, what you get back is an expression , not an object which tells you about an expression.
Similarly, you're explicitly barred from trying to pull this trick with a closure:

bar <- as.character(function(x) x+3)
Error in as.character(function(x) x + 3) : 
  cannot coerce type 'closure' to vector of type 'character'

Now,

foo <- parse(text = code)
as.character(deparse(foo))
[1] "structure(expression(1:10 %>% (. < 5)[] %>% mean(), a <- 1:3), srcfile = <environment>, wholeSrcref = structure(c(1L, "
[2] "0L, 3L, 0L, 0L, 0L, 1L, 3L), srcfile = <environment>, class = \"srcref\"))" 

Should give you a feel for what you're dealing with.

But it's not clear why you want/need to take a string, parse it, and then try to get it back again. Either follow akrun's approach or take another route to turn poorly structured text into executable commands.

Related