Is there a function that will recall the last line executed within an R script? For example, if such a function existed and was called "echoLast", I am interested in using this in the following manner:
y <-3,
whi <- 4,
x <- 5
wlo <- 6
sum <- y * whi + x * wlo
last.command <- echoLast()
print(paste(last.command,sum,y,whi,x,wlo))
which would result in output of:
"sum <- y * whi + x * wlo 32 2 1 5 6"
Thank you
You can try something like:
f <- function() {
lv <- .Last.value
fname <- tempfile()
savehistory(fname)
lastcmd <- head(tail(readLines(fname), 2), 1)
parts <- strsplit(gsub("[^[:alnum:] ]", "", lastcmd), " +")[[1]]
vars <- as.list.environment(.GlobalEnv)
c(list(Last.command=lastcmd, Last.value=lv), vars[names(vars) %in% parts])
}
y <- 3
whi <- 4
x <- 5
wlo <- 6
sum <- y * whi + x * wlo
f()
output:
$`Last.command`
[1] "sum <- y * whi + x * wlo"
$Last.value
[1] 42
$x
[1] 5
$y
[1] 3
$sum
[1] 42
$whi
[1] 4
$wlo
[1] 6
Caveat: does not when it is run from source
Related
I am using a for-loop to do step-by-step calculations where several equations depend on each other. Because of this dependence, I cannot find a solution where I do the calculations inside a dataframe. My main motivation is to speed up the calculations when the Time vector is very large in the reprex below.
Could you please suggest alternatives to the following for-loop based calculations, preferably inside a dataframe in R? The only thing I can think of is using for-loop in Rcpp.
Reproducible Example
last_time <- 10
STEP = 1
Time <- seq(from = 0, to = last_time, by = STEP)
## empty vectors
eq1 <- vector(mode = "double", length = length(Time))
eq2 <- vector(mode = "double", length = length(Time))
eq <- vector(mode = "double", length = length(Time))
eq3 <- vector(mode = "double", length = length(Time))
eq4 <- vector(mode = "double", length = length(Time))
## adding the first values
eq1[1] <- 25
eq2[1] <- 25
eq[1] <- 25
eq3[1] <- 100
eq4[1] <- 2
for (t in 2:length(Time)) {
## eq1
eq1[t] <- eq[t-1] + (2.5 * STEP * (1 - (eq[t-1])/25))
## eq2
eq2[t] <- (-2 * STEP) + ((-2^2) * (STEP^2)) - (2 * eq3[t-1]) - (eq[t-1] * STEP)
## min.
eq[t] <- min(eq1[t], eq2[t] )
## eq3
eq3[t] <- (eq[t] - eq[t-1])/(STEP)
## eq4
eq4[t] <- eq4[t-1] + (eq[t-1] * STEP) + (0.5 * eq3[t-1] * (STEP)^2)
}
Output:
my_data <- data.frame(Time, eq1, eq2, eq, eq3, eq4)
my_data
#> Time eq1 eq2 eq eq3 eq4
#> 1 0 25.00000 25.00000 25.00000 -256.00000 2.0000
#> 2 1 25.00000 -231.00000 -231.00000 25.60000 -101.0000
#> 3 2 -205.40000 225.00000 -205.40000 23.04000 -319.2000
#> 4 3 -182.36000 199.40000 -182.36000 20.73600 -513.0800
#> 5 4 -161.62400 176.36000 -161.62400 18.66240 -685.0720
#> 6 5 -142.96160 155.62400 -142.96160 16.79616 -837.3648
#> 7 6 -126.16544 136.96160 -126.16544 15.11654 -971.9283
#> 8 7 -111.04890 120.16544 -111.04890 13.60489 -1090.5355
#> 9 8 -97.44401 105.04890 -97.44401 12.24440 -1194.7819
#> 10 9 -85.19961 91.44401 -85.19961 11.01996 -1286.1037
#> 11 10 -74.17965 79.19961 -74.17965 0.00000 -1365.7934
Created on 2021-02-28 by the reprex package (v1.0.0)
You could define a recursive function. A loop is faster than recursion though.
g <- function(m, STEP, time, x=2) {
if (time == 0) m
else {
## eq1
m[x, 2] <- m[x - 1, 1] + 2.5*STEP*(1 - (m[x - 1, 1])/25)
## eq2
m[x, 3] <- -2*STEP + -2^2*STEP^2 - 2*m[x - 1, 4] - m[x - 1, 1]*STEP
## min.
m[x, 1] <- min(m[x, 2], m[x, 3])
## eq3
m[x - 1, 4] <- (m[x, 1] - m[x - 1, 1])/STEP
## eq4
m[x, 5] <- m[x - 1, 5] + m[x - 1, 1]*STEP + 0.5*m[x - 1, 4]*STEP^2
g(m, STEP, time - 1, x + 1)
}
}
Usage
last_time <- 10; STEP <- 1
First <- c(eq0=25, eq1=25, eq2=25, eq3=100, eq4=2)
m <- matrix(0, last_time + 1, length(First), dimnames=list(NULL, names(First)))
m[1, ] <- First
g(m, STEP, last_time)
# eq0 eq1 eq2 eq3 eq4
# [1,] 25.00000 25.00000 25.00000 -256.00000 2.0000
# [2,] -231.00000 25.00000 -231.00000 25.60000 -101.0000
# [3,] -205.40000 -205.40000 225.00000 23.04000 -319.2000
# [4,] -182.36000 -182.36000 199.40000 20.73600 -513.0800
# [5,] -161.62400 -161.62400 176.36000 18.66240 -685.0720
# [6,] -142.96160 -142.96160 155.62400 16.79616 -837.3648
# [7,] -126.16544 -126.16544 136.96160 15.11654 -971.9283
# [8,] -111.04890 -111.04890 120.16544 13.60489 -1090.5355
# [9,] -97.44401 -97.44401 105.04890 12.24440 -1194.7819
# [10,] -85.19961 -85.19961 91.44401 11.01996 -1286.1037
# [11,] -74.17965 -74.17965 79.19961 0.00000 -1365.7934
as you asked how it works:
The recursive filter function of stats::filter can be used with mapply as follows:
dataframe <-
mapply(stats::filter,
dataframe,
filter = vector,
method = "recursive")
where vector is e.g. c(25), which could be your first eq1[1] <- 25
The recursive filter works like a recursive loop but is a bit more elegant:
Then the mapply recursive filter would do:
dataframe / vector
row or timepoint 1 20
row or timepoint 2 30 + (20 * c(25))
row or timepoint 3 40 + ((20*25)+30) * c(25))
It calculates the value in the first row and uses it in the next, where it multiplies the next vector. Perhaps if you play around with stats filter and the recursive method you also get the same result. It is a row based calculation over time similar to Rcpp but more flexible.
I have the following code in R:
a <- 2
evaluate <- function(x){
b <- 2*x
c <- 3*x
d <- 4*x
out <- list("b" = b, "c" = c, "d" = d)
return(out)
}
evaluate(a)
I obtain something like
$b
[1] 4
$c
[1] 6
$d
[1] 8
How can I compute something like b + c + d ?
so many options
# with
with(evaluate(a), b + c + d)
[1] 18
# unlist the unnamed output object
sum(unlist(evaluate(a)))
[1] 18
# subset a named output object
result <- evaluate(a)
result$b + result$c + result$d
[1] 18
# subset an unnamed output object
evaluate(a)$b + evaluate(a)$c + evaluate(a)$d
[1] 18
# custom function with fancy arguments
f <- function(...) {
args <- unlist(...)
sum(args)
}
f(evaluate(a))
[1] 18
Also, +1 from: #Gregor (double-bracket list subsetting)
result[["b"]] + result[["c"]] + result[["d"]]
[1] 18
In R you can access list members using $ operator, followed by member name so, in your code, for example:
result = evaluate(a)
result$b + result$c + result$d
Your function returns a list. You could return a vector and then use the sum() function to compute the sum of the elements in the vector. If you must use a list, the 'Reduce()` function can work.
l <- list(2, 3, 4)
v <- c(2,3,4)
sum(v) # returns 9
Reduce("+", l) # returns 9
I would like to hide printed output when saving output of my own function.
f2 <- function(x) {
cat("x + 5 = ", x + 5)
invisible(x + 5)
}
f2(1) # prints
a <- f2(1) # also prints
In other words I would like to make my function print
x + 5 = 6
when calling f2(1) but in case of calling a <- f2(1) I dont want to show any printed output. Is there any easy way how to do that?
You can use a class system for this. Here's a simple S3 example:
f2 <- function(x) {
names(x) <- paste(x, "+ 5")
class(x) <- c(class(x), 'foo')
x + 5
}
print.foo <- function(x) { cat(names(x), "=", x)}
In practice:
> x <- 3
> f2(x)
3 + 5 = 8
> y <- f2(x)
>
Note that the print.foo function does not handle vectors of length > 1 gracefully. That could be fixed, if desired.
I have 3 vectors of equal length y, h and hp defined as follows:
y <- c(2, 5, 6)
h <- c(4, 25, 35)
hp <- c(3, 10, 12)
The values are simply illustrative.
I want to create an output list final_list of functions in x as follows
function(x) y + (h - hp) * x
(only ideal illustrative output shown):
[[1]]
[1] function(x) 2 + (1) * x
[[2]]
[1] function(x) 5 + (15) * x
[[3]]
[1] function(x) 6 + (23) * x
I am aware that this can be done with eval/parse, but this does not produce transparent output for the functions.
I would like to create the functions from these 3 vectors and output without using eval/parse. If this is possible I would be really happy to learn and be impressed!
You can use Map() with substitute(). The middle expressions are not yet evaluated, but I don't think that's such a big deal. They will be evaluated when the functions are called. Basically we just assemble the function in parts.
funs <- Map(
function(a, b, c) {
f <- function(x) x
body(f) <- substitute(y + (h - hp) * x, list(y = a, h = b, hp = c))
f
},
a = y, b = h, c = hp
)
funs
# [[1]]
# function (x)
# 2 + (4 - 3) * x
# <environment: 0x4543fd0>
#
# [[2]]
# function (x)
# 5 + (25 - 10) * x
# <environment: 0x4549e20>
#
# [[3]]
# function (x)
# 6 + (35 - 12) * x
# <environment: 0x454e5d8>
Now let's call the functions -
sapply(funs, function(a) a(1))
# [1] 3 20 29
Note: If you really need those middle expressions evaluated in the function bodies, you can use the following instead.
make <- function(a, b, c) {
d <- b - c
f <- function(x) x
body(f) <- substitute(y + (e) * x, list(y = a, e = d))
f
}
funs <- Map(make, y, h, hp)
y <- c(2,5,6)
h <- c(4, 25, 35)
hp <- c(3, 10, 12)
fun_create <- function(y, h, hp){
fun <- function(x){y + (h - hp)*x}
return(fun)
}
out <- mapply(y, h, hp, FUN = fun_create)
The output doesn't give what you might expect but it works correctly:
> out
[[1]]
function (x)
{
y + (h - hp) * x
}
<environment: 0x282ee40>
[[2]]
function (x)
{
y + (h - hp) * x
}
<environment: 0x282e610>
[[3]]
function (x)
{
y + (h - hp) * x
}
<environment: 0x282dde0>
> out[[1]](1)
[1] 3
Just using the function-function will succeed if it is executed in the correct environment.
> mapply( function(y,h,hp) function(x){ y+(h-hp)*x }, y,h,hp)
[[1]]
function (x)
{
y + (h - hp) * x
}
<environment: 0x7fb570828710>
[[2]]
function (x)
{
y + (h - hp) * x
}
<environment: 0x7fb570823718>
[[3]]
function (x)
{
y + (h - hp) * x
}
<environment: 0x7fb57081b5c8>
> myfuns[[1]](x=1:10)
[1] 3 4 5 6 7 8 9 10 11 12
> 2+(h[1]-hp[1])*1:10
[1] 3 4 5 6 7 8 9 10 11 12
> myfuns[[2]](x=1:10)
[1] 20 35 50 65 80 95 110 125 140 155
Each of those function definitions (actually closures) carries along the first matching values that existed at the time of its creation when the interpreted traveled along the search path.
> environment(myfuns[[1]])[["y"]]
[1] 2
> environment(myfuns[[1]])[["h"]]
[1] 4
> environment(myfuns[[1]])[["hp"]]
[1] 3
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)),")" )))
}