R усиливает локальный охват

Ответ 1

Насколько я знаю, R не предоставляет режим "строгого использования". Таким образом, вы остаетесь с двумя вариантами:

1 - Убедитесь, что все ваши "строгие" функции не имеют globalenv в качестве среды. Вы можете определить для этого хорошую функцию обертки, но самым простым является вызов local:

# Use "local" directly to control the function environment
f <- local( function(myvar) { return(myVar); }, as.environment(2))
f(3) # Error in f(3) : object 'myVar' not found

# Create a wrapper function "strict" to do it for you...
strict <- function(f, pos=2) eval(substitute(f), as.environment(pos))
f <- strict( function(myvar) { return(myVar); } )
f(3) # Error in f(3) : object 'myVar' not found

2 - Сделайте анализ кода, который предупреждает вас о "плохом" использовании.

Здесь функция checkStrict, которая, надеюсь, сделает то, что вы хотите. Он использует отличный пакет codetools.

# Checks a function for use of global variables
# Returns TRUE if ok, FALSE if globals were found.
checkStrict <- function(f, silent=FALSE) {
    vars <- codetools::findGlobals(f)
    found <- !vapply(vars, exists, logical(1), envir=as.environment(2))
    if (!silent && any(found)) {
        warning("global variables used: ", paste(names(found)[found], collapse=', '))
        return(invisible(FALSE))
    }

    !any(found)
}

И попробуйте:

> myVar = 1
> f <- function(myvar) { return(myVar); }
> checkStrict(f)
Warning message:
In checkStrict(f) : global variables used: myVar

Ответ 2

checkUsage в пакете codetools полезен, но не доводит вас до конца. В чистом сеансе, где myVar не определен,

f <- function(myvar) { return(myVar); }
codetools::checkUsage(f)

дает

<anonymous>: no visible binding for global variable ‘myVar’

но как только вы определяете myVar, checkUsage счастлив.

См. ?codetools в пакете codetools: возможно, что-то там полезно:

> findGlobals(f)
[1] "{"      "myVar"  "return"
> findLocals(f)
character(0)

Ответ 3

Использование get(x, inherits=FALSE) приведет к локальной области.

 myVar = 1

 f2 <- function(myvar) get("myVar", inherits=FALSE)


f3 <- function(myvar){
 myVar <- myvar
 get("myVar", inherits=FALSE)
}

выход:

> f2(8)    
Error in get("myVar", inherits = FALSE) : object 'myVar' not found
> f3(8)
[1] 8

Ответ 4

Вам нужно исправить опечатку: myvar!= myvar. Тогда все будет работать...

Сфера охвата - это "изнутри", начиная с текущего, затем включается и т.д.

Изменить. Теперь, когда вы уточнили свой вопрос, посмотрите на пакетные таблицы (которые являются частью базового набора R):

R> library(codetools)
R> f <- function(myVAR) { return(myvar) }
R> checkUsage(f)
<anonymous>: no visible binding for global variable 'myvar'
R> 

Ответ 5

Вы, конечно, делаете это неправильно. Не ожидайте, что статические инструменты проверки кода найдут все ваши ошибки. Проверьте свой код с помощью тестов. И еще тесты. Любой достойный тест, написанный для работы в чистой среде, обнаружит такую ​​ошибку. Напишите тесты для своих функций и используйте их. Посмотрите на славу, которая представляет собой testthat пакет на CRAN.

Ответ 6

В CRAN есть новый пакет modules, который решает эту общую проблему (см. vignette здесь). С помощью modules функция вызывает ошибку вместо молчащего возврата неправильного результата.

# without modules
myVar <- 1
f <- function(myvar) { return(myVar) }
f(2)
[1] 1

# with modules
library(modules)
m <- module({
  f <- function(myvar) { return(myVar) }
})
m$f(2)
Error in m$f(2) : object 'myVar' not found

Это первый раз, когда я его использую. Это кажется простым, поэтому я мог бы включить его в свой обычный рабочий процесс, чтобы предотвратить многократные неудачи.

Ответ 7

вы можете динамически изменять дерево среды следующим образом:

a <- 1

f <- function(){
    b <- 1
    print(b)
    print(a)
}

environment(f) <- new.env(parent = baseenv())

f()

Внутри f, b можно найти, а a не может.

Но, вероятно, это принесет больше вреда, чем пользы.

Ответ 8

Вы можете проверить, определена ли переменная локально:

myVar = 1
f <- function(myvar) { 
if( exists('myVar', environment(), inherits = FALSE) ) return( myVar) else cat("myVar was not found locally\n")
}

> f(2)
myVar was not found locally

Но я нахожу это очень искусственным, если единственное, что вы пытаетесь сделать, это защитить себя от орфографических ошибок.

Функция exists выполняет поиск имени переменной в конкретной среде. inherits = FALSE говорит ему не смотреть в окружающие рамки.

Ответ 9

environment(fun) = parent.env(environment(fun))

удалит "рабочее пространство" из вашего пути поиска, оставьте все остальное. Это, вероятно, ближе всего к тому, что вы хотите.

Ответ 10

Что работает для меня, на основе ответа @c-urchin, заключается в определении script, который читает все мои функции, а затем исключает глобальную среду:

filenames <- Sys.glob('fun/*.R')
for (filename in filenames) {
    source(filename, local=T)
    funname <- sub('^fun/(.*).R$', "\\1", filename)
    eval(parse(text=paste('environment(',funname,') <- parent.env(globalenv())',sep='')))
}

Я предполагаю, что

• все функции и ничего не содержатся в относительном каталоге ./fun и
• каждый .R файл содержит ровно одну функцию с таким же именем, как и файл.

Ловушка заключается в том, что если одна из моих функций вызывает другую одну из моих функций, тогда внешняя функция также должна сначала вызвать этот script, и это необходимо сделать с помощью local=T:

source('readfun.R', local=T)

предполагая, конечно, что файл script называется readfun.R.

Ответ 11

@Tommy дал очень хороший ответ, и я использовал его для создания 3 функций, которые, на мой взгляд, более удобны на практике.

строги

Чтобы сделать функцию строгой, вам просто нужно позвонить

strict(f,x,y)

вместо

f(x,y)

Пример:

my_fun1 <- function(a,b,c){a+b+c}
my_fun2 <- function(a,b,c){a+B+c}
B <- 1
my_fun1(1,2,3)        # 6
strict(my_fun1,1,2,3) # 6
my_fun2(1,2,3)        # 5
strict(my_fun2,1,2,3) # Error in (function (a, b, c)  : object 'B' not found

checkStrict1

Чтобы получить диагноз, выполните checkStrict1 (f) с дополнительными логическими параметрами, чтобы показать больше руды меньше.

checkStrict1("my_fun1") # nothing
checkStrict1("my_fun2") # my_fun2  : B

Более сложный случай:

A <- 1 # unambiguous variable defined OUTSIDE AND INSIDE my_fun3
# B unambiguous variable defined only INSIDE my_fun3
C <- 1 # defined OUTSIDE AND INSIDE with ambiguous name (C is also a base function)
D <- 1 # defined only OUTSIDE my_fun3 (D is also a base function)
E <- 1 # unambiguous variable defined only OUTSIDE my_fun3
# G unambiguous variable defined only INSIDE my_fun3
# H is undeclared and doesn't exist at all
# I is undeclared (though I is also base function)
# v defined only INSIDE (v is also a base function)
my_fun3 <- function(a,b,c){
  A<-1;B<-1;C<-1;G<-1
  a+b+A+B+C+D+E+G+H+I+v+ my_fun1(1,2,3)
}
checkStrict1("my_fun3",show_global_functions = TRUE ,show_ambiguous = TRUE , show_inexistent = TRUE)

# my_fun3  : E 
# my_fun3  Ambiguous : D 
# my_fun3  Inexistent : H 
# my_fun3  Global functions : my_fun1

Я решил показать только несуществующий по умолчанию из 3 дополнительных дополнений. Вы можете легко изменить его в определении функции.

checkStrictAll

Получить диагностику всех ваших потенциально проблемных функций с теми же параметрами.

checkStrictAll()
my_fun2         : B 
my_fun3         : E 
my_fun3         Inexistent : H

Источники

strict <- function(f1,...){
  function_text <- deparse(f1)
  function_text <- paste(function_text[1],function_text[2],paste(function_text[c(-1,-2,-length(function_text))],collapse=";"),"}",collapse="") 
  strict0 <- function(f1, pos=2) eval(substitute(f1), as.environment(pos))
  f1 <- eval(parse(text=paste0("strict0(",function_text,")")))
  do.call(f1,list(...))
}

checkStrict1 <- function(f_str,exceptions = NULL,n_char = nchar(f_str),show_global_functions = FALSE,show_ambiguous = FALSE, show_inexistent = TRUE){
  functions <-  c(lsf.str(envir=globalenv()))
  f <- try(eval(parse(text=f_str)),silent=TRUE)
  if(inherits(f, "try-error")) {return(NULL)}
  vars <- codetools::findGlobals(f)
  vars <- vars[!vars %in% exceptions]
  global_functions <- vars %in% functions

  in_global_env <- vapply(vars, exists, logical(1), envir=globalenv())
  in_local_env  <- vapply(vars, exists, logical(1), envir=as.environment(2))
  in_global_env_but_not_function <- rep(FALSE,length(vars))
  for (my_mode in c("logical", "integer", "double", "complex", "character", "raw","list", "NULL")){
    in_global_env_but_not_function <- in_global_env_but_not_function | vapply(vars, exists, logical(1), envir=globalenv(),mode = my_mode)
  }
  found     <- in_global_env_but_not_function & !in_local_env
  ambiguous <- in_global_env_but_not_function & in_local_env
  inexistent <- (!in_local_env) & (!in_global_env)
  if(typeof(f)=="closure"){
    if(any(found))           {cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),":",                  paste(names(found)[found], collapse=', '),"\n"))}
    if(show_ambiguous        & any(ambiguous))       {cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),"Ambiguous :",        paste(names(found)[ambiguous], collapse=', '),"\n"))}
    if(show_inexistent       & any(inexistent))      {cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),"Inexistent :",       paste(names(found)[inexistent], collapse=', '),"\n"))}
    if(show_global_functions & any(global_functions)){cat(paste(f_str,paste(rep(" ",n_char-nchar(f_str)),collapse=""),"Global functions :", paste(names(found)[global_functions], collapse=', '),"\n"))}
    return(invisible(FALSE)) 
  } else {return(invisible(TRUE))}
}

checkStrictAll <-  function(exceptions = NULL,show_global_functions = FALSE,show_ambiguous = FALSE, show_inexistent = TRUE){
  functions <-  c(lsf.str(envir=globalenv()))
  n_char <- max(nchar(functions))  
  invisible(sapply(functions,checkStrict1,exceptions,n_char = n_char,show_global_functions,show_ambiguous, show_inexistent))
}