Say I have a binomial.coeff function defined as:
combn <- function(n,r) {
factorial(n)/(factorial(r)*factorial(n-r))
}
binomial.coeff <- function(n,x,p) {
combn(n,x)*p^x*(1-p)^(n-x)
}
I would like to call the function binomial.coeff for different values of x and sum the calls to produce the result. I'm not sure if R takes many positional arguments like this:
binomial.coeff <- function(n,...,p) {
combn(n,...)*p^...*(1-p)^(n-...)
}
My final goal is say x takes values [3,2] then I would like to have the function being summed on 3 and 2
binomial.coeff <- function(n,x,p) {
combn(n,3)*p^3*(1-p)^(n-3)+combn(n,2)*p^2*(1-p)^(n-2)
}
Since you are using functions that are themselves vectorized, you can pass in a vector for x with
binomial.coeff(3,2:3,.25)
# [1] 0.140625 0.015625
and sum that with
sum(binomial.coeff(3,2:3,.25))
# [1] 0.15625
More generally, if you want to call it multiple times with different parameter values, in R you'd use something like sapply. For example
sapply(2:3, function(x) binomial.coeff(3, x, .25))
# [1] 0.140625 0.015625
sum(sapply(2:3, function(x) binomial.coeff(3, x, .25)))
# [1] 0.15625
But the code you've written seems to be the pmf for the binomial distribution. There is a built in function for that dbinom You could do the same thing with
dbinom(2:3, 3, .25)
# [1] 0.140625 0.015625
sum(dbinom(2:3, 3, .25))
# [1] 0.15625
in one call because dbinom is vectorized over the x argument. Also this version would be more efficient.
My professor has assigned a question for programming in R and I am stuck. He wants us to make a function that will take the exponential (e^(x[i]) of all the numbers in a vector and then sum them. the equation is:
the summation of e^x(i), n, and i=1.
I have made a function that will give me the exponential of the first value in my vector. But I want to get the exponential of all the values and sum them. Here is my code
#Vector for summing
x=c(2,1,3,0.4)
#Code for function
mysum = 0
myfun=function(x){
for (i in 1:length(x)){
mysum = mysum + exp(x[i])
return(mysum)
}
}
myfun(x)
#returns 7.389056
I have also tried using i = 1:1 because the equation specifies i=1, even though I knew that would only go through 1 number, and it gave me the same answer.... obviously.
myfun=function(x){
for (i in 1:1)
Does anyone have any suggestions to get it to sum?
You need to set the initial value of mysum to the accumulation afterwards, and also move the line return(mysum) outsides your for loop to return the result, i.e.,
myfun=function(x){
mysum <- 0
for (i in 1:length(x)){
mysum = mysum + exp(x[i])
}
return(mysum)
}
or just
myfun=function(x){
mysum <- 0
for (i in x){
mysum = mysum + exp(x)
}
return(mysum)
}
Since exp operation is vectoroized, you can also define your function myfun like below
myfun <- function(x) sum(exp(x))
You could also use the fact that most base functions are already vectorized :
1) create a dummy vector
1:10
#> [1] 1 2 3 4 5 6 7 8 9 10
2) apply your function on that vector, you get vectorized result
exp(1:10)
#> [1] 2.718282 7.389056 20.085537 54.598150 148.413159
#> [6] 403.428793 1096.633158 2980.957987 8103.083928 22026.465795
3) Sum that vector
sum(exp(1:10))
#> [1] 34843.77
4) Write your function to gain (a little) time
my_fun <- function(x){sum(exp(x))}
my_fun(1:10)
#> [1] 34843.77
I am trying to use a HoltWinters prediction iteratively along a vector, without the use of a loop, but don't want the HoltWinters function used on the first two. I have created a list of vectors using accumulate:
library(purrr)
v <- c(73,77,71,73,86,87,90)
cumv <- accumulate(v,c)
Using map across cumv:
# Omit first two
hw1 <- map(cumv[-c(1:2)], function(x) HoltWinters(ts(x),gamma=F,alpha=0.35,beta=0.2))
> hw1[[5]]
#Holt-Winters exponential smoothing with trend and without seasonal component.
#Call:
#HoltWinters(x = ts(x), alpha = 0.35, beta = 0.2, gamma = F)
#Smoothing parameters:
# alpha: 0.35
# beta : 0.2
# gamma: FALSE
#Coefficients:
# [,1]
#a 89.605082
#b 3.246215
This
gives my desired result but doesn't include the first two iterations. I assumed using ifelse would work fine:
# Include first two, use ifelse
hw2 <- map(cumv, function(x) ifelse(length(x)>2,HoltWinters(ts(x),gamma=F,alpha=0.35,beta=0.2),
ifelse(length(x)>1,max(x),NA)))
Now, hw2[[7]] should have (I thought) returned an identical object to hw1[[5]] but it doesn't.
> hw2[[7]]
#[[1]]
#Time Series:
#Start = 3
#End = 7
#Frequency = 1
# xhat level trend
#3 81.00000 77.00000 4.000000
#4 80.80000 77.50000 3.300000
#5 80.82400 78.07000 2.754000
#6 85.75192 82.63560 3.116320
#7 89.39243 86.18875 3.203686
Why is it getting messed up?
As Dason mentioned in their comment, the ifelse() function is not the same as using if else statements. The former returns a single value for each element of x, assuming x is a vector containing booleans, e.g.
x <- c(TRUE, TRUE, FALSE, FALSE)
ifelse (x, "A", "B")
returns [1] "A" "A" "B" "B"
For your purpose, you want to use a normal if else construct:
hw2 <- map(cumv, function(x) {
if (length(x) > 2) {
return (HoltWinters(ts(x),gamma=F,alpha=0.35,beta=0.2))
} else if (length(x) > 1) {
return (max(x))
} else {
return (NA)
}
})
Say I have a two objects, a and b, and a function f1 in R
a<- 5
b<- 10
f1<-function(){
out<- a+b
return(out)
I want to write a for loop that evaluates the sensitivity of this function to the values of a and b by changing them each and running the function again. I imagine creating a vector of the objects and then running some code like this:
params<- c(a,b)
for(i in params){
store<- i #save the initial value of the object so I can restore it later.
base<-f1() #save function output with original object value
i<- i*1.1 #increase object value by 10%
base.10<- f1() #recalculate and save function output with new object value
calc<- base.10/base #generate a response metric
i<- store #reset the object value to its original value
return(calc)
}
It sounds like you have a function f1 that relies on objects a and b (which are not defined in that function), and you want to test the sensitivity of its output to values of a and b. One way to approach this would be looping through the values you want for the sensitivity analysis and manipulating the parent environment of f1 so it uses these values:
f1 <- function() a + b
sensitivity <- function(params) {
old.f1.env <- environment(f1)
grid <- expand.grid(lapply(params, function(x) x * c(1, 1.1)))
grid$outcome <- apply(grid, 1, function(x) {
for (n in names(x)) {
assign(n, x[n])
}
environment(f1) <- environment()
ret <- f1()
environment(f1) <- old.f1.env
ret
})
grid
}
sensitivity(list(a=5, b=10))
# a b outcome
# 1 5.0 10 15.0
# 2 5.5 10 15.5
# 3 5.0 11 16.0
# 4 5.5 11 16.5
Here, we've performed computed the function value for a grid of a and b values, both at the original a and b value and at a 10% increased value.
Note that a lot of our work came from specifying the variables in the parent environment of f1. I would encourage you to restructure your code so your function f1 takes the relevant parameters as input. Then you could use:
f1 <- function(a, b) a + b
sensitivity <- function(params) {
grid <- expand.grid(lapply(params, function(x) x * c(1, 1.1)))
grid$outcome <- apply(grid, 1, function(x) do.call(f1, as.list(x)))
grid
}
sensitivity(list(a=5, b=10))
# a b outcome
# 1 5.0 10 15.0
# 2 5.5 10 15.5
# 3 5.0 11 16.0
# 4 5.5 11 16.5
This sounds like a perfect use case for closures.
get_f1 <- function(a, b) {
f1<-function(){
out<- a+b
return(out)
}
return(f1)
}
Then:
my_f1 <- get_f1(a=5, b=10)
my_f1() #uses a=5 and b=10 because they are defined in the envir associated with my_f1
So in your loop you could simply do:
base <- (get_f1(a, b))()
base.10 <- (get_f1(a*1.1, b*1.1))()
Obviously you could define get_f1 with arguments i=c(a, b).
Use a closure (function attached to an environment) rather than tinkering with environments!
tl;dr: closures are awesome
Reading some of your comments, I think this is actually what you want: sensitivity takes a function and a list of arguments and returns the sensitivity of the function to its arguments. (BTW what you call sensitivity, already means something else)
sensitivity <- function(fun, args) {
out <- lapply(names(args), function(cur) {
base10 <- do.call(fun, `[[<-`(args, cur, `[[`(args,cur)*1.1))
base10 / do.call(fun, args)
})
names(out) <- names(args)
return(out)
}
Example:
f1 <- function(a,b) a+b
a1 <- list(a=5, b=2)
sensitivity(f1, a1)
This gives
$a
[1] 1.03
$b
[1] 1.07
Example 2:
f2 <- function(x, y, z) x^2 +3*y*z
sensitivity(f2, list(x=1, y=2, z=3))
$x
[1] 1.011053
$y
[1] 1.094737
$z
[1] 1.094737
It works "plug-and-play" with any function, BUT it requires you to define f differently (one would say, correctly). I could write something that would work with your function f as it is written but it would be much work and bad taste. If you want code modularity, you just cannot use side effects...
PS: if you would prefer to have a vector returned instead of a list, simply change lapply to sapply in the definition of sensitivity.
This would give for the last example:
> sensitivity(f2, list(x=1, y=2, z=3))
x y z
1.011053 1.094737 1.094737
PPS: any reason why you are not computing the gradient of f rather than doing what you are doing?
Still trying to get into the R logic... what is the "best" way to unpack (on LHS) the results from a function returning multiple values?
I can't do this apparently:
R> functionReturningTwoValues <- function() { return(c(1, 2)) }
R> functionReturningTwoValues()
[1] 1 2
R> a, b <- functionReturningTwoValues()
Error: unexpected ',' in "a,"
R> c(a, b) <- functionReturningTwoValues()
Error in c(a, b) <- functionReturningTwoValues() : object 'a' not found
must I really do the following?
R> r <- functionReturningTwoValues()
R> a <- r[1]; b <- r[2]
or would the R programmer write something more like this:
R> functionReturningTwoValues <- function() {return(list(first=1, second=2))}
R> r <- functionReturningTwoValues()
R> r$first
[1] 1
R> r$second
[1] 2
--- edited to answer Shane's questions ---
I don't really need giving names to the result value parts. I am applying one aggregate function to the first component and an other to the second component (min and max. if it was the same function for both components I would not need splitting them).
(1) list[...]<- I had posted this over a decade ago on r-help. Since then it has been added to the gsubfn package. It does not require a special operator but does require that the left hand side be written using list[...] like this:
library(gsubfn) # need 0.7-0 or later
list[a, b] <- functionReturningTwoValues()
If you only need the first or second component these all work too:
list[a] <- functionReturningTwoValues()
list[a, ] <- functionReturningTwoValues()
list[, b] <- functionReturningTwoValues()
(Of course, if you only needed one value then functionReturningTwoValues()[[1]] or functionReturningTwoValues()[[2]] would be sufficient.)
See the cited r-help thread for more examples.
(2) with If the intent is merely to combine the multiple values subsequently and the return values are named then a simple alternative is to use with :
myfun <- function() list(a = 1, b = 2)
list[a, b] <- myfun()
a + b
# same
with(myfun(), a + b)
(3) attach Another alternative is attach:
attach(myfun())
a + b
ADDED: with and attach
I somehow stumbled on this clever hack on the internet ... I'm not sure if it's nasty or beautiful, but it lets you create a "magical" operator that allows you to unpack multiple return values into their own variable. The := function is defined here, and included below for posterity:
':=' <- function(lhs, rhs) {
frame <- parent.frame()
lhs <- as.list(substitute(lhs))
if (length(lhs) > 1)
lhs <- lhs[-1]
if (length(lhs) == 1) {
do.call(`=`, list(lhs[[1]], rhs), envir=frame)
return(invisible(NULL))
}
if (is.function(rhs) || is(rhs, 'formula'))
rhs <- list(rhs)
if (length(lhs) > length(rhs))
rhs <- c(rhs, rep(list(NULL), length(lhs) - length(rhs)))
for (i in 1:length(lhs))
do.call(`=`, list(lhs[[i]], rhs[[i]]), envir=frame)
return(invisible(NULL))
}
With that in hand, you can do what you're after:
functionReturningTwoValues <- function() {
return(list(1, matrix(0, 2, 2)))
}
c(a, b) := functionReturningTwoValues()
a
#[1] 1
b
# [,1] [,2]
# [1,] 0 0
# [2,] 0 0
I don't know how I feel about that. Perhaps you might find it helpful in your interactive workspace. Using it to build (re-)usable libraries (for mass consumption) might not be the best idea, but I guess that's up to you.
... you know what they say about responsibility and power ...
Usually I wrap the output into a list, which is very flexible (you can have any combination of numbers, strings, vectors, matrices, arrays, lists, objects int he output)
so like:
func2<-function(input) {
a<-input+1
b<-input+2
output<-list(a,b)
return(output)
}
output<-func2(5)
for (i in output) {
print(i)
}
[1] 6
[1] 7
I put together an R package zeallot to tackle this problem. zeallot includes a multiple assignment or unpacking assignment operator, %<-%. The LHS of the operator is any number of variables to assign, built using calls to c(). The RHS of the operator is a vector, list, data frame, date object, or any custom object with an implemented destructure method (see ?zeallot::destructure).
Here are a handful of examples based on the original post,
library(zeallot)
functionReturningTwoValues <- function() {
return(c(1, 2))
}
c(a, b) %<-% functionReturningTwoValues()
a # 1
b # 2
functionReturningListOfValues <- function() {
return(list(1, 2, 3))
}
c(d, e, f) %<-% functionReturningListOfValues()
d # 1
e # 2
f # 3
functionReturningNestedList <- function() {
return(list(1, list(2, 3)))
}
c(f, c(g, h)) %<-% functionReturningNestedList()
f # 1
g # 2
h # 3
functionReturningTooManyValues <- function() {
return(as.list(1:20))
}
c(i, j, ...rest) %<-% functionReturningTooManyValues()
i # 1
j # 2
rest # list(3, 4, 5, ..)
Check out the package vignette for more information and examples.
functionReturningTwoValues <- function() {
results <- list()
results$first <- 1
results$second <-2
return(results)
}
a <- functionReturningTwoValues()
I think this works.
There's no right answer to this question. I really depends on what you're doing with the data. In the simple example above, I would strongly suggest:
Keep things as simple as possible.
Wherever possible, it's a best practice to keep your functions vectorized. That provides the greatest amount of flexibility and speed in the long run.
Is it important that the values 1 and 2 above have names? In other words, why is it important in this example that 1 and 2 be named a and b, rather than just r[1] and r[2]? One important thing to understand in this context is that a and b are also both vectors of length 1. So you're not really changing anything in the process of making that assignment, other than having 2 new vectors that don't need subscripts to be referenced:
> r <- c(1,2)
> a <- r[1]
> b <- r[2]
> class(r)
[1] "numeric"
> class(a)
[1] "numeric"
> a
[1] 1
> a[1]
[1] 1
You can also assign the names to the original vector if you would rather reference the letter than the index:
> names(r) <- c("a","b")
> names(r)
[1] "a" "b"
> r["a"]
a
1
[Edit] Given that you will be applying min and max to each vector separately, I would suggest either using a matrix (if a and b will be the same length and the same data type) or data frame (if a and b will be the same length but can be different data types) or else use a list like in your last example (if they can be of differing lengths and data types).
> r <- data.frame(a=1:4, b=5:8)
> r
a b
1 1 5
2 2 6
3 3 7
4 4 8
> min(r$a)
[1] 1
> max(r$b)
[1] 8
If you want to return the output of your function to the Global Environment, you can use list2env, like in this example:
myfun <- function(x) { a <- 1:x
b <- 5:x
df <- data.frame(a=a, b=b)
newList <- list("my_obj1" = a, "my_obj2" = b, "myDF"=df)
list2env(newList ,.GlobalEnv)
}
myfun(3)
This function will create three objects in your Global Environment:
> my_obj1
[1] 1 2 3
> my_obj2
[1] 5 4 3
> myDF
a b
1 1 5
2 2 4
3 3 3
Lists seem perfect for this purpose. For example within the function you would have
x = desired_return_value_1 # (vector, matrix, etc)
y = desired_return_value_2 # (vector, matrix, etc)
returnlist = list(x,y...)
} # end of function
main program
x = returnlist[[1]]
y = returnlist[[2]]
Yes to your second and third questions -- that's what you need to do as you cannot have multiple 'lvalues' on the left of an assignment.
How about using assign?
functionReturningTwoValues <- function(a, b) {
assign(a, 1, pos=1)
assign(b, 2, pos=1)
}
You can pass the names of the variable you want to be passed by reference.
> functionReturningTwoValues('a', 'b')
> a
[1] 1
> b
[1] 2
If you need to access the existing values, the converse of assign is get.
[A]
If each of foo and bar is a single number, then there's nothing wrong with c(foo,bar); and you can also name the components: c(Foo=foo,Bar=bar). So you could access the components of the result 'res' as res[1], res[2]; or, in the named case, as res["Foo"], res["BAR"].
[B]
If foo and bar are vectors of the same type and length, then again there's nothing wrong with returning cbind(foo,bar) or rbind(foo,bar); likewise nameable. In the 'cbind' case, you would access foo and bar as res[,1], res[,2] or as res[,"Foo"], res[,"Bar"]. You might also prefer to return a dataframe rather than a matrix:
data.frame(Foo=foo,Bar=bar)
and access them as res$Foo, res$Bar. This would also work well if foo and bar were of the same length but not of the same type (e.g. foo is a vector of numbers, bar a vector of character strings).
[C]
If foo and bar are sufficiently different not to combine conveniently as above, then you shuld definitely return a list.
For example, your function might fit a linear model and
also calculate predicted values, so you could have
LM<-lm(....) ; foo<-summary(LM); bar<-LM$fit
and then you would return list(Foo=foo,Bar=bar) and then access the summary as res$Foo, the predicted values as res$Bar
source: http://r.789695.n4.nabble.com/How-to-return-multiple-values-in-a-function-td858528.html
Year 2021 and this is something I frequently use.
tidyverse package has a function called lst that assigns name to the list elements when creating the list.
Post which I use list2env() to assign variable or use the list directly
library(tidyverse)
fun <- function(){
a<-1
b<-2
lst(a,b)
}
list2env(fun(), envir=.GlobalEnv)#unpacks list key-values to variable-values into the current environment
This is only for the sake of completeness and not because I personally prefer it. You can pipe %>% the result, evaluate it with curly braces {} and write variables to the parent environment using double-arrow <<-.
library(tidyverse)
functionReturningTwoValues() %>% {a <<- .[1]; b <<- .[2]}
UPDATE:
Your can also use the multiple assignment operator from the zeallot package:: %<-%
c(a, b) %<-% list(0, 1)
I will post a function that returns multiple objects by way of vectors:
Median <- function(X){
X_Sort <- sort(X)
if (length(X)%%2==0){
Median <- (X_Sort[(length(X)/2)]+X_Sort[(length(X)/2)+1])/2
} else{
Median <- X_Sort[(length(X)+1)/2]
}
return(Median)
}
That was a function I created to calculate the median. I know that there's an inbuilt function in R called median() but nonetheless I programmed it to build other function to calculate the quartiles of a numeric data-set by using the Median() function I just programmed. The Median() function works like this:
If a numeric vector X has an even number of elements (i.e., length(X)%%2==0), the median is calculated by averaging the elements sort(X)[length(X)/2] and sort(X)[(length(X)/2+1)].
If Xdoesn't have an even number of elements, the median is sort(X)[(length(X)+1)/2].
On to the QuartilesFunction():
QuartilesFunction <- function(X){
X_Sort <- sort(X) # Data is sorted in ascending order
if (length(X)%%2==0){
# Data number is even
HalfDN <- X_Sort[1:(length(X)/2)]
HalfUP <- X_Sort[((length(X)/2)+1):length(X)]
QL <- Median(HalfDN)
QU <- Median(HalfUP)
QL1 <- QL
QL2 <- QL
QU1 <- QU
QU2 <- QU
QL3 <- QL
QU3 <- QU
Quartiles <- c(QL1,QU1,QL2,QU2,QL3,QU3)
names(Quartiles) = c("QL (1)", "QU (1)", "QL (2)", "QU (2)","QL (3)", "QU (3)")
} else{ # Data number is odd
# Including the median
Half1DN <- X_Sort[1:((length(X)+1)/2)]
Half1UP <- X_Sort[(((length(X)+1)/2)):length(X)]
QL1 <- Median(Half1DN)
QU1 <- Median(Half1UP)
# Not including the median
Half2DN <- X_Sort[1:(((length(X)+1)/2)-1)]
Half2UP <- X_Sort[(((length(X)+1)/2)+1):length(X)]
QL2 <- Median(Half2DN)
QU2 <- Median(Half2UP)
# Methods (1) and (2) averaged
QL3 <- (QL1+QL2)/2
QU3 <- (QU1+QU2)/2
Quartiles <- c(QL1,QU1,QL2,QU2,QL3,QU3)
names(Quartiles) = c("QL (1)", "QU (1)", "QL (2)", "QU (2)","QL (3)", "QU (3)")
}
return(Quartiles)
}
This function returns the quartiles of a numeric vector by using three methods:
Discarding the median for the calculation of the quartiles when the number of elements of the numeric vector Xis odd.
Keeping the median for the calculation of the quartiles when the number of elements of the numeric vector Xis odd.
Averaging the results obtained by using methods 1 and 2.
When the number of elements in the numeric vector X is even, the three methods coincide.
The result of the QuartilesFunction() is a vector that depicts the first and third quartiles calculated by using the three methods outlined.
With R 3.6.1, I can do the following
fr2v <- function() { c(5,3) }
a_b <- fr2v()
(a_b[[1]]) # prints "5"
(a_b[[2]]) # prints "3"
To obtain multiple outputs from a function and keep them in the desired format you can save the outputs to your hard disk (in the working directory) from within the function and then load them from outside the function:
myfun <- function(x) {
df1 <- ...
df2 <- ...
save(df1, file = "myfile1")
save(df2, file = "myfile2")
}
load("myfile1")
load("myfile2")