[R] how do I define a function which is equivalent to `deparse(substitute(x))`?

Fox, John jfox at mcmaster.ca
Tue Dec 13 15:09:49 CET 2016


Dear Bert,

I'm tempted to let this thread drop, since I like your last solution better than mine: it's clearer and more robust -- in fact, I don't see a way to break it -- and the approach you used to write it generalizes better to other problems. But if the object is to produce a function that behaves like deparse(substitute()), which is the subject of the original posting, then 

> g <- function(x) deparse(substitute(x))
> h <- function(foo) g(foo)
> h(log)
[1] "foo"

Best,
 John

> -----Original Message-----
> From: Bert Gunter [mailto:bgunter.4567 at gmail.com]
> Sent: December 13, 2016 12:52 AM
> To: Fox, John <jfox at mcmaster.ca>
> Cc: frederik at ofb.net; r-help at r-project.org
> Subject: Re: [R] how do I define a function which is equivalent to
> `deparse(substitute(x))`?
> 
> John:
> 
> If you insist:
> 
> > desub <- function(x)
>       deparse(sys.call(-length(sys.parents())+1)[[2]])
> 
> >
> > f <- function(y)desub(y)
> > g <- function(y)message(desub(y))
> >
> > f(log)
> [1] "log"
> 
> > g(log)
> log
> 
> 
> However, I would agree that searching backward through the call stack can be
> tricky. For example, suppose we have in addition to the above,
> 
> h <- function(foo) g(foo)
> 
> Then using desub() as I defined it above, one gets as desired:
> 
> > h(log)
> log
> 
> However, using your gsub(),
> 
> > desub <- function(y) {
>        deparse(eval(substitute(substitute(y)),
>          env=parent.frame()))
>  }
> 
> One then gets:
> 
> > h(log)
> foo  ## whoops!
> 
> I suspect one can find a way to break my approach that doesn't break yours --
> and if/when you find it, please post it. But on general principles I prefer
> accessing the call stack directly rather than indirectly through nested substitute
> calls. But beauty is in the eye of the beholder...
> 
> 
> Cheers,
> Bert
> 
> 
> 
> 
> 
> Cheers,
> Bert
> 
> 
> Bert Gunter
> 
> "The trouble with having an open mind is that people keep coming along and
> sticking things into it."
> -- Opus (aka Berkeley Breathed in his "Bloom County" comic strip )
> 
> 
> On Mon, Dec 12, 2016 at 5:45 PM, Fox, John <jfox at mcmaster.ca> wrote:
> > Dear Bert,
> >
> > Your current version satisfies the original posting, but, though simpler than
> mine, is a bit fragile, in the following sense:
> >
> >> desub <- function(x) (all.vars(sys.call(-2)))
> >
> >> f <- function(x){
> > +     message(desub(x))
> > + }
> >
> >> f(log)
> > log
> >
> >> g <- function(x){
> > +     desub(x)
> > + }
> >
> >> g(log)
> > character(0)
> >
> >
> > My version:
> >
> >> desub <- function(y) {
> > +     deparse(eval(substitute(substitute(y)),
> > +                  env=parent.frame())) }
> >
> >> f(log)
> > log
> >
> >> g(log)
> > [1] "log"
> >
> > The deparse(substitute()) idiom returns the argument to f() or g() as a
> character string and so desub() should too, I guess.
> >
> > Best,
> >  John
> >
> >> -----Original Message-----
> >> From: Bert Gunter [mailto:bgunter.4567 at gmail.com]
> >> Sent: December 12, 2016 7:26 PM
> >> To: Fox, John <jfox at mcmaster.ca>
> >> Cc: frederik at ofb.net; r-help at r-project.org
> >> Subject: Re: [R] how do I define a function which is equivalent to
> >> `deparse(substitute(x))`?
> >>
> >> John. et. al:
> >>
> >> I assumed the message call was there to convert a quoted string to an
> >> unquoted name and simply did this with as.name() in desub(). The
> >> point of using sys.call() is that you can go up the call stack as far
> >> as you need, so if you want to leave in the message() call, just go one farther
> up the call stack:
> >>
> >> > desub <- function(x) (all.vars(sys.call(-2))) ## note the -2 now
> >>
> >> > g <- function(y)message((desub(y)))
> >> > g(log)
> >> log
> >>
> >>
> >> -- Bert
> >>
> >> Bert Gunter
> >>
> >> "The trouble with having an open mind is that people keep coming
> >> along and sticking things into it."
> >> -- Opus (aka Berkeley Breathed in his "Bloom County" comic strip )
> >>
> >>
> >> On Mon, Dec 12, 2016 at 3:58 PM, Fox, John <jfox at mcmaster.ca> wrote:
> >> > Dear Bert,
> >> >
> >> > It's nitpicking, I guess, but the call to message() is in the
> >> > original posting. Your solution produces
> >> >
> >> >> desub <- function(x) as.name(all.vars(sys.call(-1)))
> >> >
> >> >> f <- function(x){
> >> > +     message(desub(x))
> >> > + }
> >> >
> >> >> f(log)
> >> > x
> >> >
> >> > Best,
> >> >  John
> >> >
> >> >> -----Original Message-----
> >> >> From: Bert Gunter [mailto:bgunter.4567 at gmail.com]
> >> >> Sent: Monday, December 12, 2016 6:41 PM
> >> >> To: Fox, John <jfox at mcmaster.ca>
> >> >> Cc: frederik at ofb.net; r-help at r-project.org
> >> >> Subject: Re: [R] how do I define a function which is equivalent to
> >> >> `deparse(substitute(x))`?
> >> >>
> >> >> *If* I understand correctly -- and please let me know if I don't
> >> >> -- this seems somewhat more straightforward and less "hacky" :
> >> >>
> >> >> > desub <- function(x) as.name(all.vars(sys.call(-1)))
> >> >>
> >> >> Yielding in the OP's example:
> >> >>
> >> >> > g <- function(y)desub(y)
> >> >> > g(log)
> >> >> log
> >> >>
> >> >> Cheers,
> >> >> Bert
> >> >> Bert Gunter
> >> >>
> >> >> "The trouble with having an open mind is that people keep coming
> >> >> along and sticking things into it."
> >> >> -- Opus (aka Berkeley Breathed in his "Bloom County" comic strip )
> >> >>
> >> >>
> >> >> On Mon, Dec 12, 2016 at 2:07 PM, Fox, John <jfox at mcmaster.ca> wrote:
> >> >> > Dear Frederick,
> >> >> >
> >> >> > I found this a challenging puzzle, and it took me awhile to come
> >> >> > up
> >> >> with an alternative, and I think slightly simpler, solution:
> >> >> >
> >> >> >> desub <- function(y) {
> >> >> > +     deparse(eval(substitute(substitute(y)),
> >> >> > +                  env=parent.frame())) }
> >> >> >
> >> >> >> f <- function(x){
> >> >> > +     message(desub(x))
> >> >> > + }
> >> >> >
> >> >> >> f(log)
> >> >> > log
> >> >> >
> >> >> > Best,
> >> >> >  John
> >> >> >
> >> >> > -----------------------------
> >> >> > John Fox, Professor
> >> >> > McMaster University
> >> >> > Hamilton, Ontario
> >> >> > Canada L8S 4M4
> >> >> > Web: socserv.mcmaster.ca/jfox
> >> >> >
> >> >> >
> >> >> >
> >> >> >
> >> >> >> -----Original Message-----
> >> >> >> From: R-help [mailto:r-help-bounces at r-project.org] On Behalf Of
> >> >> >> frederik at ofb.net
> >> >> >> Sent: December 11, 2016 8:35 PM
> >> >> >> To: r-help at r-project.org
> >> >> >> Subject: Re: [R] how do I define a function which is equivalent
> >> >> >> to `deparse(substitute(x))`?
> >> >> >>
> >> >> >> Dear R-Help,
> >> >> >>
> >> >> >> I was going to ask Jeff to read the entire works of William
> >> >> >> Shakespeare to learn why his reply was not helpful to me...
> >> >> >>
> >> >> >> Then I realized that the answer, as always, lies within...
> >> >> >>
> >> >> >>     desub <- function(y) {
> >> >> >>       e1=substitute(y, environment())
> >> >> >>       e2=do.call(substitute,list(e1), env=parent.frame())
> >> >> >>       deparse(e2)
> >> >> >>     }
> >> >> >>
> >> >> >> Sorry to trouble the list; other solutions still welcome.
> >> >> >>
> >> >> >> Cheers,
> >> >> >>
> >> >> >> Frederick
> >> >> >>
> >> >> >> On Sun, Dec 11, 2016 at 12:46:23AM -0800, Jeff Newmiller wrote:
> >> >> >> > No. Read Hadley Wickham's "Advanced R" to learn why not.
> >> >> >> > --
> >> >> >> > Sent from my phone. Please excuse my brevity.
> >> >> >> >
> >> >> >> > On December 10, 2016 10:24:49 PM PST, frederik at ofb.net wrote:
> >> >> >> > >Dear R-Help,
> >> >> >> > >
> >> >> >> > >I asked this question on StackOverflow,
> >> >> >> > >
> >> >> >> > >http://stackoverflow.com/questions/41083293/in-r-how-do-i-de
> >> >> >> > >fin e-a -fu nction-which-is-equivalent-to-deparsesubstitutex
> >> >> >> > >
> >> >> >> > >but thought perhaps R-help would be more appropriate.
> >> >> >> > >
> >> >> >> > >I want to write a function in R which grabs the name of a
> >> >> >> > >variable from the context of its caller's caller. I think
> >> >> >> > >the problem I have is best understood by asking how to
> >> >> >> > >compose `deparse` and
> >> >> `substitute`.
> >> >> >> > >You can see that a naive composition does not work:
> >> >> >> > >
> >> >> >> > >    # a compose operator
> >> >> >> > >    >  `%c%` = function(x,y)function(...)x(y(...))
> >> >> >> > >
> >> >> >> > >    # a naive attempt to combine deparse and substitute
> >> >> >> > >    > desub = deparse %c% substitute
> >> >> >> > >    > f=function(foo) { message(desub(foo)) }
> >> >> >> > >    > f(log)
> >> >> >> > >    foo
> >> >> >> > >
> >> >> >> > >    # this is how it is supposed to work
> >> >> >> > >    > g=function(foo) { message(deparse(substitute(foo))) }
> >> >> >> > >    > g(log)
> >> >> >> > >    log
> >> >> >> > >
> >> >> >> > >Is there a way I can define a function `desub` so that
> >> >> >> > >`desub(x)` has the same value as `deparse(substitute(x))` in
> >> >> >> > >every
> >> context?
> >> >> >> > >
> >> >> >> > >Thank you,
> >> >> >> > >
> >> >> >> > >Frederick Eaton
> >> >> >> > >
> >> >> >> > >______________________________________________
> >> >> >> > >R-help at r-project.org mailing list -- To UNSUBSCRIBE and
> >> >> >> > >more, see https://stat.ethz.ch/mailman/listinfo/r-help
> >> >> >> > >PLEASE do read the posting guide
> >> >> >> > >http://www.R-project.org/posting-guide.html
> >> >> >> > >and provide commented, minimal, self-contained, reproducible
> code.
> >> >> >> >
> >> >> >>
> >> >> >> ______________________________________________
> >> >> >> R-help at r-project.org mailing list -- To UNSUBSCRIBE and more,
> >> >> >> see https://stat.ethz.ch/mailman/listinfo/r-help
> >> >> >> PLEASE do read the posting guide
> >> >> >> http://www.R-project.org/posting-guide.html
> >> >> >> and provide commented, minimal, self-contained, reproducible code.
> >> >> >
> >> >> > ______________________________________________
> >> >> > R-help at r-project.org mailing list -- To UNSUBSCRIBE and more,
> >> >> > see https://stat.ethz.ch/mailman/listinfo/r-help
> >> >> > PLEASE do read the posting guide
> >> >> > http://www.R-project.org/posting-guide.html
> >> >> > and provide commented, minimal, self-contained, reproducible code.


More information about the R-help mailing list