How to have an active binding know if it's called as a function?

One trick that comes to my mind is to create two nested environments, one being a parent of another and each having a different definition of f. Then you can evaluate f + f() in the "child" and it will work:

e1 <- new.env()
e2 <- new.env(parent = e1)
assign("f", sqrt, envir = e1)
assign("f", 1, envir = e2)
eval(expression(f + f(4)), envir=e2)
#> [1] 3

Here is a method using the walkast package. It essentially replaces function objects named f with f_fun.

f_fun <- sqrt
f <- 1

evaluate <- function(expr) {
  expr <- substitute(expr)
  
  eval(
    walkast::walk_ast(
      expr,
      walkast::make_visitor(
        hd = function(fun) {
          if (all.names(fun) == "f") {
            f_fun
          } else {
            fun
          }
        }
      )
    )
  )
}

Expressions need to be wrapped in evaluate.

evaluate(f + f(4))
#> 3

evaluate(f + f)
#> 2

evaluate(f(f + f(9)) + f(4))
#> 4

Although this doesn't follow the exact approach you suggested (somehow finding out how the function was called), this trick using attributes and a custom S3 class can be used to produce the intended behaviour:

# Define a function and give it a special class
f <- function(x) sqrt(x)
class(f) <- "fancy"

# Add a 'value' attribute
attr(f, "value") <- 1

# Now define addition for our class to use the 'value' attribute
`+.fancy` <- function(x, y) {
  
  x_val <- if ("fancy" %in% class(x)) attr(x, "value") else x
  y_val <- if ("fancy" %in% class(y)) attr(y, "value") else y
  
  x_val + y_val
  
}

# Seems to work as intended
f + f
#> [1] 2

f(4) + 1
#> [1] 3

TL; DR If this is not too much of an assumption, then I would decide it through humility f = f () And with using a parameter with a default value. It seems to me that this is the simplest solution of the proposed ones.

I know for sure that this is easily achieved in JS, since there is such a method on an object as valueOf.

function f(n){
  return Math.sqrt(n)
}

f.valueOf = f.toString = function valueOf(){return 1}


console.log('f(4) =', f(4))
console.log('f + f(4) =', f + f(4))
console.log('f =', f)
console.log('f + f =', f + f)

But unfortunately in R, as far as I know, there is no such method.

default_value <- function(){ 
  1 # I use the function instead value
}

# just for an example of change f = 1 to f = 1 + size
increment <- function(size = 1){
  temp <- default_value() + size
  default_value <<- function(){
    temp # use closure instead infinite recursion
  }  
  0 # without effect in calulations (if it's necessary)
}

f2 <- sqrt

f1 <- function(value = default_value()){
  if (value != default_value()){
    result <- f2(value) # sqrt
  } else {
    result <- value     # 1
  }
}

#--------------------------------------------------------------

assign("f", f1) # just as alias if it's necessary

eval(f() + f(4))
#> 3

eval(f() + f())
#> 2

eval(f(f() + f(9)) + f(4))
#> 4

eval(increment(1) + f(f() + f(9)) + f(4)) # sqrt(5) == 2.236068
#> 4.236068

eval(f())
#> 2

eval(increment(-1) + f(f() + f(9)) + f(4)) # use decrement
#> 4

As you mentioned that solution of type f2(f + f(1)) might work, I decided to contribute this not very elegant but "seems to be working" solution.

TL;DR: convert code to string, parse, get more data with getParseData(), replace target variable depending on if it is a simple symbol or called as function, evaluate new code string in proper environment.

Notes:

• This is currently designed to replace only one target variable at a time. If multiple replacements are needed, consecutive calls to replace_in_code() should do the trick.
• If you want to only replace target when it is called as function, tweaks in is_target and replacement definition should be fairly straightforward.
• I decided to evaluate new code string in a most simple way, but maybe more complicated environment creation might be needed in your case.

replace_and_eval <- function(code_block, target_var, value, fun) {
  # Replace variable `target_var` with `value` variable if it is a simple
  # symbol and with `fun` if it is called as function
  code <- replace_in_code(
    code_string = substitute(code_block),
    target_var = target_var,
    value_var = "value",
    fun_var = "fun"
  )

  # Evaluate in current environment
  eval(parse(text = code))
}

replace_in_code <- function(code_string, target_var, value_var, fun_var) {
  # Parse code string
  parsed <- parse(text = code_string, keep.source = TRUE)
  ast <- utils::getParseData(parsed)

  # Find any relevant tokens
  is_target <- (ast[["text"]] == target_var) &
    (ast[["token"]] %in% c("SYMBOL", "SYMBOL_FUNCTION_CALL"))

  if (!any(is_target)) {
    return(code_string)
  }

  # Prepare data for replacements
  target_ast <- ast[is_target, ]
  replacement <- ifelse(target_ast[["token"]] == "SYMBOL", value_var, fun_var)
  line1 <- target_ast[["line1"]]
  col1 <- target_ast[["col1"]]
  col2 <- target_ast[["col2"]]

  # Get actual lines of code which should be updated ("srcfile" is a source of
  # a parsed code)
  lines <- getSrcLines(attr(parsed, "srcfile"), 1, max(ast[["line2"]]))

  # Make replacements from the end to respect updating `lines` in place
  for (i in order(line1, col1, decreasing = TRUE)) {
    l_num <- line1[i]
    l <- lines[l_num]
    lines[l_num] <- paste0(
      substr(l, 0, col1[i] - 1),
      replacement[i],
      substr(l, col2[i] + 1, nchar(l))
    )
  }

  paste0(lines, collapse = "\n")
}

# Tests
replace_and_eval(quote(f + f(4)), "f", value = 10, fun = sqrt)
#> [1] 12
replace_and_eval(quote(list(f, f(4), f)), "f", value = stats::dnorm, fun = sqrt)
#> [[1]]
#> function (x, mean = 0, sd = 1, log = FALSE) 
#> .Call(C_dnorm, x, mean, sd, log)
#> <bytecode: 0x56161ac8c098>
#> <environment: namespace:stats>
#> 
#> [[2]]
#> [1] 2
#> 
#> [[3]]
#> function (x, mean = 0, sd = 1, log = FALSE) 
#> .Call(C_dnorm, x, mean, sd, log)
#> <bytecode: 0x56161ac8c098>
#> <environment: namespace:stats>

## Bizarre target variable
replace_and_eval(quote(data.frame + data.frame(4)), "data.frame", 10, sqrt)
#> [1] 12

## Multiline code block with "tricky" code
replace_and_eval(
  code_block = quote({
    # Should print 1
    print(nchar("f"))
    # There is also f in comment, but it won't be quoted
    print(f)
    print(f(4))
  }),
  target_var = "f",
  value = "Hello",
  fun = sqrt
)
#> [1] 1
#> [1] "Hello"
#> [1] 2

## Evaluation is in proper environment
fun <- function(value = 1000, fun = -1000) {
  replace_and_eval(
    code_block = quote(list(f, f(4))),
    target_var = "f",
    value = stats::dnorm,
    fun = sqrt
  )
}
fun()
#> [[1]]
#> function (x, mean = 0, sd = 1, log = FALSE) 
#> .Call(C_dnorm, x, mean, sd, log)
#> <bytecode: 0x56161ac8c098>
#> <environment: namespace:stats>
#> 
#> [[2]]
#> [1] 2

^{Created on 2021-06-27 by the reprex package (v2.0.0)}

I would suggest using R6 package for this problem. An example:

SQRT <- R6::R6Class(
  classname = "SQRT",
  public = list(
    f = function(x = NULL) {
      if(is.null(x)){
        return(1)
      } else {
        return(sqrt(x))
      }
    }
  )
);

# create a new instence
env <- SQRT$new();

# call public methods 
env$f() + env$f(4);
#> [1] 3

env$f() + env$f(16) + env$f(4)
#> [1] 7

For more details on R6.

In the interest of the idea of f2(f + f(4)), here is an attempt:

f = function() {
  print("this is a weird function")
}

main = function(x) {
  xsub = substitute(x)

  ## short circuit if user entered main(f)
  if (is.name(xsub) && as.character(xsub) == 'f') 
    return (f)
  else
    xsub = parser(xsub)

  eval(xsub, list(f = 1))
}

parser = function(e) {
  ## largely taken from data.table:::replace_dot_alias
  if (is.call(e)) {
    if (e[[1L]] == 'f') e[[1L]] = quote(sqrt)
    ## recursively parse deeper into expression for more replacement
    for (i in seq_along(e)[-1L]) if (!is.null(e[[i]])) e[[i]] = parser(e[[i]])
  } 
  return(e)
}

main(f)
#> function() {
#>   print("this is a weird function")
#> }
main(f(4) + f)
#> [1] 3
main(f + f)
#> [1] 2