I have a character string:
FUN.n = "exp( 3 * x^2 + 2 * x + 1)";
I want to cast it as a function:
myFunction = castAsFunction ( FUN.n );
So that I can access it like:
myFunction(x)
and it will evaluate appropriately.
FUN.n = "exp( 3 * x^2 + 2 * x + 1)";
myFunction = castAsFunction ( FUN.n );
# [...]
myFunction = function(x)
{
exp( 3 * x^2 + 2 * x + 1);
}
x = -3:3;
myFunction(x);
# [1] 3.6e+09 8.1e+03 7.4e+00 2.7e+00 4.0e+02 2.4e+07 5.8e+14
I have tried as.function and eval(parse(text and none of them behave as I would expect.
I am looking for a variadic solution.
We could actually create a function called castAsFunction. We would need to give it not only a string as function body, but also the formal arguments. It feels like the function could be simplified, but it works with the example above.
FUN.n = "exp( 3 * x^2 + 2 * x + 1)"
x = -3:3
castAsFunction <- function(body, ...) {
dots <- match.call(expand.dots = FALSE)$...
form_ls <- rep(list(bquote()), length(dots))
names(form_ls) <- as.character(dots)
f <- function(){}
formals(f) <- form_ls
body(f) <- str2lang(body)
environment(f) <- parent.frame()
f
}
myfun <- castAsFunction(FUN.n, x)
myfun
#> function (x)
#> exp(3 * x^2 + 2 * x + 1)
myfun(x)
#> [1] 3.584913e+09 8.103084e+03 7.389056e+00 2.718282e+00 4.034288e+02
#> [6] 2.415495e+07 5.834617e+14
Created on 2021-02-18 by the reprex package (v0.3.0)
Not sure why I am getting a non-numeric argument binary operator error. Do I have some type mismatch going on?
for (j in 1:length(theta)) {
val = exp(y * sum(theta * random_data_vector) * y * random_data_vector[i])
val = val / (1 + exp(y * sum(theta * random_data_vector)))
theta[j] = theta[j] - (alpha * val)
}
Error:
Error in theta * random_data_vector :
non-numeric argument to binary operator
Values:
> head(theta)
[1] 0.02435863 -0.74310189 -0.63525839 0.56554085 -0.20599967 0.43164130
> head(random_data_vector)
[1] 0 0 0 0 0 0
> y
V9437
785 1
After FIRST iteration of for loop, theta looks like this:
> head(theta)
[[1]]
[1] NA
[[2]]
[1] -0.2368957
[[3]]
[1] 0.697332
[[4]]
[1] 0.6104201
[[5]]
[1] 0.8182983
[[6]]
[1] 0.7093492
For more information, the above is a snippet from my entire function I am trying to create around stochastic gradient descent.
data is a set of rows grabbed from a CSV
labels is 1 row grabbed from a CSV
alpha is a float
mnist = read.csv('mnist_train.csv', header=FALSE)
data = mnist[,mnist[nrow(mnist),]==0 | mnist[nrow(mnist),]==1, drop=FALSE]
labels = data[785,]
data = data[1:784,]
train = function(data, labels, alpha) {
theta = runif(nrow(data),-1,1)
decay_rate = .01
random_column_indexes = sample(ncol(data))
idx = 1
limit = length(random_column_indexes)
threshold = 1e-5
delta = 1000000
for (n in 1:ncol(data)) {
if (delta <= threshold) {
break
}
i = random_column_indexes[n]
random_data_vector = data[, i]
y = labels[i]
previous_theta = theta
for (j in 1:length(theta)) {
val = exp(y * sum(theta * random_data_vector) * y * random_data_vector[i])
val = val / (1 + exp(y * sum(theta * random_data_vector)))
theta[j] = theta[j] - (alpha * val)
}
alpha = alpha - decay_rate
delta = abs(previous_theta - theta)
}
return(theta)
}
I consider that the problem has to do with the subsetting of your objects. From the link you provided in the comments I see that your data is a data.frame object and you subset it using [. If you check the type of any data.frame e.g. typeof(iris) you can see that it is a "list".
When you use y = labels[i], your object will be a list, that's because:
when [ is applied to a list it always returns a list: it never gives you the contents of the list. To get the contents, you need [[ Advanced R by Hadley Wickham
Declare y as y <- labels[[i]] or subset labels from your data.frame as a vector doing as.numeric(data[785,])
I am trying to implement a variation of the Brent-Salamin algorithm in R. It works well for the first 25 iterations, but then, it behaves unexpectedly, returning negative results.
The algorithm I want to implement is:
initial values:
x_0 = 1; y_0 = 1/sqrt(2); z_0 = 1/2
x_n = (x_n-1 + y_n-1)/2
y_n = sqrt(x_n-1 * y_n-1)
z_n = z_n-1 - 2^n * (x_n^2-y_n^2)
p_n = (2 * x_n^2) / z_n
where n is the current iteration.
A more beautifully formatted formula is here.
The code I figured out is:
mypi <- function(n){
x = 1
y = 1/sqrt(2)
z = 1/2
iteration = 0
while(iteration < n){
iteration = iteration + 1
newx = (x + y) / 2
y = sqrt(x * y)
x = newx
z = z-(2^iteration * (x^2 - y^2))
p = (2 * x^2) / z
}
return(p)
}
Output:
> mypi(10)
[1] 3.141593
> mypi(20)
[1] 3.141593
> mypi(50)
[1] -33.34323
So as I am new to R, is there a bug in my code or is it the algorithm?
Your code simply messes up because it does not agree with the algorithm as written in the wiki page. A correct version looks like this:
mypi <- function(n){
x = 1
y = 1/sqrt(2)
z = 1/4
p <- 1
iteration = 0
while(iteration < n){
iteration = iteration + 1
newx = (x + y) / 2
y = sqrt(x * y)
# x = newx
# z = z-(2^iteration * (x^2 - y^2))
z = z- p* (x-newx)^2
p = 2*p
x = newx
}
(newx + y)^2/(4*z)
}
Gives
> mypi(10)
[1] 3.141593
> mypi(20)
[1] 3.141593
> mypi(50)
[1] 3.141593
When providing a default argument to an R function, this argument is evaluated when first used in the function. How is it possible to evaluate default argument earlier in an elegant way? Example:
f <- function(x, y = 2 * x)
{
if(x < 0) x = 10
y
}
f(1) ## Returns 2
f(-1) ## Returns 20 but I would like it to return -2
Thanks
The answer wasn't to hard to find. The function 'force' does the trick:
f <- function(x, y = 2 * x)
{
force(y)
if(x < 0) x = 10
y
}
f(1) ## Returns 2
f(-1) ## -2
Is it possible to write a flexible function expression?
I want to use input arguments to control the expression of function.
For example
input arg -> function
c(1,1) -> func1 = function(x) x+1
c(1,3,2) -> func2 = function(x) x^2+3*x+2
c(6,8,-1) -> func3 = function(x) 6*x^2+8*x-1
makepoly <- function(b)
{
p <- rev(seq_along(b) - 1)
function(x)
{
xp <- outer(x, p, '^')
rowSums(xp * rep(b, each=length(x)))
}
}
# x^2 + 2x + 3
f <- makepoly(1:3)
f(0:4)
[1] 3 6 11 18 27
Here is my take on this task
create_poly <- function(coef)
paste(rev(coef),
paste("x", seq_along(coef) - 1, sep = "^"),
sep = "*", collapse = " + ")
make_polyfun <- function(input) {
myfun <- paste("function(x)", create_poly(input))
eval(parse(text = myfun))
}
With the example the OP gave we have :
make_polyfun(c(1, 1))
## function(x) 1*x^0 + 1*x^1
## <environment: 0x243a540>
make_polyfun(c(1, 3, 2))
## function(x) 2*x^0 + 3*x^1 + 1*x^2
## <environment: 0x1bd46e0>
make_polyfun(c(6, 8, 1))
## function(x) 1*x^0 + 8*x^1 + 6*x^2
## <environment: 0x22a59c0>
You can use polynom
library(polynom)
as.polynomial(c(2,3,1))
2 + 3*x + x^2
as.polynomial(c(6,8,1)
1 + 8*x + 6*x^2
EDIT you can of course coerce the result to a function using the genericas.function.polynomial. better here you can use ,as.polylist` to create many polynomials given a list of coefficients lists. For example:
lapply(as.polylist(list(c(2,3,1),c(6,8,1),c(6,8,-1))),
as.function)
[[1]]
function (x)
{
w <- 0
w <- 1 + x * w
w <- 3 + x * w
w <- 2 + x * w
w
}
<environment: 0x00000000113bd778>
[[2]]
function (x)
{
w <- 0
w <- 1 + x * w
w <- 8 + x * w
w <- 6 + x * w
w
}
<environment: 0x0000000011524168>
[[3]]
function (x)
{
w <- 0
w <- -1 + x * w
w <- 8 + x * w
w <- 6 + x * w
w
}
<environment: 0x0000000011527f28>
It's not clear how general you want to be from OP. For the particular case of polynomials, you can do:
f = function(x, coeffs) {
sum(outer(x, seq_along(coeffs) - 1, `^`) * coeffs)
}
f(2, c(1,2,3)) # 1 + 2*x + 3*x^2, with x = 2
#[1] 17
I read this as the desire to make functions and I think the agstudy/eddi responses would probably do this, but I thought trying it from scratch might be instructive:
poly.maker <- function(coefs) { func <- function(x){} #empty func in x
body(func) <- parse(text= paste( seq_along(coefs),"*x^",
(length(coefs)-1):0,collapse="+" ) )
return(func) }
func2 <- poly.maker(c(1,2,3)) # return a function
func2(3) # now test it out
#[1] 18
Note I needed to swap the order to agree with the OP request, which I only noticed after getting different results than #dickoa. This seems less clunky:
poly.make2 <- function(coefs) { func <- function(x){}
body(func) <- bquote(sum(.(coefs)*x^.( (length(coefs)-1):0 ) ) )
return(func) }
func <- poly.make2(c(1,2,5))
func
#function (x)
#sum(c(1, 2, 5) * x^c(2L, 1L, 0L))
#<environment: 0x29023d508>
func(3)
#[1] 20
One liner:
polymaker2 <- function(coefs)
{
eval(parse(text=paste0( "function(x) sum(x^(",length(coefs)-1,":0) * ",capture.output(dput(coefs)),")" )))
}
Vectorized form:
polymaker3 <- function(coefs)
{
eval(parse(text=paste0( "function(x) colSums(t(outer(x, ",length(coefs)-1,":0, `^`))*",capture.output(dput(coefs)),")" )))
}