Как определить, назначен ли выход функции объекту в R

Внутри функции R возможно ли определить, назначил ли пользователь вывод объекту?

Например, я хотел бы напечатать на консоли некоторую информацию только в том случае, если вывод не назначен объекту, я ищу что-то подобное

fun <- function(a){
           b <- a^2
           if(!<OUTPUT ASSIGNED>) cat('a squared is ', b)
           return(invisible(b))
}

Так что результат на консоли будет отличаться независимо от того, назначен ли выход функции или нет, например:

> fun(5)
> a squared is 25
>
> out <- fun(5)
>
>

Ответ 1

Не уверен, что я полностью продумал это, но это похоже на пример, который вы привели. (Обратите внимание, что важно использовать = или assign или .Primitive("<-") внутри fun вы хотите подвергнуть этой обработке.)

fun <- function(a){
  b = a^2   # can't use <- here
  if (!identical(Sys.getenv("R_IS_ASSIGNING"), "true")) cat('a squared is ', b)
  return(invisible(b))
}

'<-' <- function(a, b) {
  Sys.setenv("R_IS_ASSIGNING" = "true")
  eval.parent(substitute(.Primitive("<-")(a, b)))
  Sys.unsetenv("R_IS_ASSIGNING")
}

fun(5)
#> a squared is  25
out <- fun(6)
out
#> [1] 36

^{Создано 2019-02-17 пакетом представлением (v0.2.1)}

Ответ 2

Если я правильно понимаю, что вам нужно, лучше использовать нестандартный метод печати:

print.squared_value = function(x, ...){
    cat('a squared is', x, "\n")
    x
}

fun = function(a){
    b = a^2
    class(b) = union("squared_value", class(b))
    b
}

fun(2)
# a squared is 4

ОБНОВИТЬ:

fun = function(a){
    b = a^2
    invisible(b)
}


h = taskCallbackManager()
# add a callback
h$add(function(expr, value, ok, visible) {
    # if it was a call 'fun' without assinment
    if(is.call(expr) && identical(expr[[1]], quote(fun))){
        cat('a squared is', value, "\n")    
    }

    return(TRUE)
}, name = "simpleHandler")

fun(2)
# a squared is 4
b = fun(2)
b
# [1] 4

# remove handler
removeTaskCallback("R-taskCallbackManager")

Ответ 3

Если бы я хорошо понял, это могло бы сработать:

fun <- function(a){
           b <- a^2
           if(sum(unlist(lapply(lapply(ls(envir = .GlobalEnv), get), function(x){ identical(x,a^2)})))==0) cat('a squared is ', b)
           return(invisible(b))
}

Так:

ls(envir=.GlobalEnv) вернет все объекты в вашей глобальной среде

lapply(ls(envir =.GlobalEnv), get): вернет список с содержимым всех объектов в вашей глобальной среде

lapply(lapply(ls(envir =.GlobalEnv), get), function(x){ identical(x,a^2)}): вернет логический список, проверяющий, является ли содержимое любого из всех объектов в вашей глобальной среде идентичен выводу вашей функции

sum(unlist(lapply(lapply(ls(envir =.GlobalEnv), get), function(x){ identical(x,a^2)})))==0 если ни одно из содержимого любого из всех объектов не является идентичен результату вашей функции, тогда... кошка!

Я надеюсь, это поможет вам! Лучший!

Ответ 4

Вот попытка: недостаток в том, что предполагается, что переменная всегда называется b. В настоящее время я не могу придумать, как сопоставить значения с именами переменных в глобальной среде.

b<-49
fun <- function(a){
  b <- a^2
  ifelse(identical(b,get("b",.GlobalEnv)),print("Already Available"),
         print(paste0("The square is ",b)))
  #return(invisible(b)) #Commented out for testing
}



 fun(7)
[1] "Already Available"