T <- function (p,q) {
for (x in 1:3) {
for (y in 1:3) {
sum(p*x + q*y)
print(sum(p*x + q*y))
}
}
}
sum(T(2,2))
I want the sum of 4, 6, 8, 6, 8, 10, 8, 10, 12 which is the output of the loop where p=2 and q=2 but the result is
sum(T(2,2))
[1] 4
[1] 6
[1] 8
[1] 6
[1] 8
[1] 10
[1] 8
[1] 10
[1] 12
Is there any way that I can get the sum or change the printed value to a vector rather than a list of each value? sum() function doesn't work on printed value.
Printing to the screen does exactly that; it doesn't return the value printed to the calling code. Your function needs to build a vector and return that. Here's a few different ways of doing it:
Code along the lines of what you were trying to do, but starting with an empty numeric vector and building it for each iteration:
T1 <- function(p, q) {
out <- numeric(0)
for (x in 1:3) {
for (y in 1:3) {
out <- c(out, p * x + q * y)
}
}
out
}
Preassigning the vector size and assigning to specific members of the vector
T2 <- function(p, q) {
out <- numeric(3 ^ 2)
for (x in 1:3) {
for (y in 1:3) {
out[(x - 1) * 3 + y] <- p * x + q * y
}
}
out
}
Using one of the map functions in purrr (overkill here but can be extended to functions which don't easily vectorise)
library(purrr)
T3 <- function(p, q) {
map2_dbl(rep(1:3, each = 3), rep(1:3, 3), function(x, y) p * x + q * y)
}
Using vector arithmetic to return the result in one command
T4 <- function(p, q) {
rep(1:3, each = 3) * p + rep(1:3, 3) * q
}
Using outer to achieve the same as T4 (as per #alistaire's comment):
T5 <- function(p, q) {
c(outer(1:3 * p, 1:3 * q, `+`))
}
It should be noted that the efficiency of these method will vary as the size of the loops increases, but that in general method 4 will be the most efficient closely followed by method 5. For small loops, interestingly method 1 seems to be better than 2, but 1 becomes inefficient as the loop size increases because R has to move memory around to keep increasing the size of the vector.
Related
I am trying to write a function that takes X and n, and returns element Xn. X is a vector of the first 3 elements of the sequence and n is a positive integer.
Xn = Xn-1 + Xn-2 - Xn-3
I am not sure how to outline a function like this in R. Can someone outline the creation of a recursive function for the above numerical sequence?
I have been working with something like this:
myfunc <- function(x,n){
if (n<0){
print("please enter positive integer")
} else {
return(myfunc(n-1 + n-2 + n-3))
}
}
myfunc (x = c(1, 2, 3), n = 3) #should return 3 (third number in sequence)
myfunc (x = c(1, 2, 3), n = 4) #should return 6
This isn't a recursive function, but it will give you what you want:
myfunc <- function(x, n) sum(x[n - 1:n])
myfunc(1:3, 3) # 3
myfunc(1:3, 4) # 6
I have a function called in the example fn_example_1 that needs to change with a parameter that comes from another function (n).
It needs to have a fixed part that never changes, and a variable part that gets longer with n, as an example:
# this is the function that needs to change
fn_example_1 <- function(x, mod) {
# -- this part is fixed
mod$a <- x^2 # fixed
# -- this part can change with n
mod$b[5,5, k] <- x + 1 # variable
mod$b[6, 6, k] <- x + 1 # variable
# mod$b[7,7, k] <- x + 1 # if n = 3 ecc..
# k is an arg from a third function, more on that later..
mod
}
This is what I have in mind, basically a wrapper function that gives back a different version of fn_example_1 that depens on n.
fn_wrap_example <- function(fn, n) {
# something
# something
# I've thought about a long if else, of course with a max value for n.
return(fn)
}
fn_wrap_example(fn_example_1, n = 2) # call to the wrapper
It is crucial that fn_wrap_example returns a function, this will be an argument to a third function. As a semplification n can have a max value, ie: 20.
The key is that fn_example_1 is a function that changes with n.
Here is how you can modify a function in your wrapper:
fn_factory <- function(n) {
fn <- function(x, mod) {
# -- this part is fixed
mod$a <- x^2 # fixed
x #place holder
# k is an arg from a third function, more on that later..
mod
}
ins <- switch(n,
"1" = quote(mod$b[5,5, k] <- x + 1),
"2" = quote(mod$b[6, 6, k] <- x + 1)
)
body(fn)[[3]] <- ins
return(fn)
}
fn_factory(2)
#function (x, mod)
#{
# mod$a <- x^2
# mod$b[6, 6, k] <- x + 1
# mod
#}
#<environment: 0x0000000008334eb8>
I seriously doubt you need this, but it can of course be done.
What you are looking for is called a closure.
https://www.r-bloggers.com/closures-in-r-a-useful-abstraction/
http://adv-r.had.co.nz/Functional-programming.html
Simple example:
power <- function(exponent) {
function(x) {
x ^ exponent
}
}
square <- power(2)
square(2)
I am trying to set up a function in R that computes a polynomial
P(x) = c1 + c2*x + c3*x^2 + ... + cn-1*x^n-2 + cn*x^n-1
for various values of x and set coefficients c.
Horner's method is to
Set cn = bn
For i = n-1, n-1, ..., 2, 1, set bi = bi+1*x + ci
Return the output
What I have so far:
hornerpoly1 <- function(x, coef, output = tail(coef,n=1), exp = seq_along(coef)-1) {
for(i in 1:tail(exp,n=1)) {
(output*x)+head(tail(coef,n=i),n=1)
}
}
hornerpoly <- function(x, coef) {
exp<-seq_along(coef)-1
output<-tail(coef,n=1)
if(length(coef)<2) {
stop("Must be more than one coefficient")
}
sapply(x, hornerpoly1, coef, output,exp)
}
I also need to error check on the length of coef, that's what the if statement is for but I am not struggling with that part. When I try to compute this function for x = 1:3 and coef = c(4,16,-1), I get three NULL statements, and I can't figure out why. Any help on how to better construct this function or remedy the null output is appreciated. Let me know if I can make anything more clear.
How about the following:
Define a function that takes x as the argument at which to evaluate the polynomial, and coef as the vector of coefficients in decreasing order of degree. So the vector coef = c(-1, 16, 4) corresponds to P(x) = -x^2 + 16 * x + 4.
The Horner algorithm is implemented in the following function:
f.horner <- function(x, coef) {
n <- length(coef);
b <- rep(0, n);
b[n] <- coef[n];
while (n > 0) {
n <- n - 1;
b[n] <- coef[n] + b[n + 1] * x;
}
return(b[1]);
}
We evaluate the polynomial at x = 1:3 for coef = c(-1, 16, 4):
sapply(1:3, f.horner, c(-1, 16, 4))
#[1] 19 47 83
Some final comments:
Note that the check on the length of coef is realised in the statement while (n > 0) {...}, i.e. we go through the coefficients starting from the last and stop when we reach the first coefficient.
You don't need to save the intermediate b values as a vector in the function. This is purely for (my) educational/trouble-shooting purposes. It's easy to rewrite the code to store bs last value, and then update b every iteration. You could then also vectorise f.horner to take a vector of x values instead of only a scalar.
Having the following matrix and vector:
a<-matrix(c(1,4,7,
2,5,8,
3,6,9), nrow = 3)
b <- c(1,1,1)
How do I sum recursiverly over each line of the matrix inside a funciton till obtain a desired result using last result to calculate next operation as shown:
b<-b+a[1,]
b<-b+a[2,]
b<-b+a[3,]
b<-b+a[1,]
b<-b+a[2,]
sum(b)>100 # Sum recursiverly till obtain this result sum(b)>100
This operation looks similar to this answer Multiply recursiverly in r. However it uses results from previews operations to calculate next ones.
Here's a recursive function to do what you're after,
# Sample Data
a<-matrix(c(1,4,7,
2,5,8,
3,6,9), nrow = 3)
b <- c(1,1,1)
We create a function that references itself with a value that increments modulo the number of rows
recAdd <- function(b, a, start = 1, size = NROW(a)) {
if(sum(b) > 100) return(b)
return(recAdd(b + a[start,], a, start = start %% size + 1, size))
}
> recAdd(b,a)
[1] 30 38 46
EDIT: Alternatively, here's a way with no recursion at all, which is much faster on large ratios of target number to sum of the matrix (but is slower on data of this size). Basically we get to take advantage of Euclid
nonrecAdd <- function(b, a, target = 100) {
Remaining <- target - sum(b)
perloop <- sum(a)
nloops <- Remaining %/% perloop
Remaining <- Remaining %% perloop
if(Remaining > 0) {
cumulativeRowsums <- cumsum(rowSums(a))
finalindex <- which((Remaining %/% cumulativeRowsums) == 0)[1]
b + colSums(a) * nloops + colSums(a[1:finalindex,,drop = FALSE])
} else {
b + colSums(a) * nloops
}
}
The problem with my R script is that it takes too much time and the main solution that I consider is to parallelize it. I don't know where to start.
My code look like this:
n<- nrow (aa)
output <- matrix (0, n, n)
akl<- function (dii){
ddi<- as.matrix (dii)
m<- rowMeans(ddi)
M<- mean(ddi)
r<- sweep (ddi, 1, m)
b<- sweep (r, 2, m)
return (b + M)
}
for (i in 1:n)
{
A<- akl(dist(aa[i,]))
dVarX <- sqrt(mean (A * A))
for (j in i:n)
{
B<- akl(dist(aa[j,]))
V <- sqrt (dVarX * (sqrt(mean(B * B))))
output[i,j] <- (sqrt(mean(A * B))) / V
}
}
I would like to parallelize on different cpus. How can I do that?
I saw the SNOW package, is it suitable for my purpose?
Thank you for suggestions,
Gab
There are two ways in which your code could be made to run faster that I could think of:
First: As #Dwin was saying (with a small twist), you could precompute akl (yes, not necesarily dist, but the whole of akl).
# a random square matrix
aa <- matrix(runif(100), ncol=10)
n <- nrow(aa)
output <- matrix (0, n, n)
akl <- function(dii) {
ddi <- as.matrix(dii)
m <- rowMeans(ddi)
M <- mean(m) # mean(ddi) == mean(m)
r <- sweep(ddi, 1, m)
b <- sweep(r, 2, m)
return(b + M)
}
# precompute akl here
require(plyr)
akl.list <- llply(1:nrow(aa), function(i) {
akl(dist(aa[i, ]))
})
# Now, apply your function, but index the list instead of computing everytime
for (i in 1:n) {
A <- akl.list[[i]]
dVarX <- sqrt(mean(A * A))
for (j in i:n) {
B <- akl.list[[j]]
V <- sqrt (dVarX * (sqrt(mean(B * B))))
output[i,j] <- (sqrt(mean(A * B))) / V
}
}
This should already get your code to run faster than before (as you compute akl everytime in the inner loop) on larger matrices.
Second: In addition to that, you can get it faster by parallelising as follows:
# now, the parallelisation you require can be achieved as follows
# with the help of `plyr` and `doMC`.
# First step of parallelisation is to compute akl in parallel
require(plyr)
require(doMC)
registerDoMC(10) # 10 Cores/CPUs
akl.list <- llply(1:nrow(aa), function(i) {
akl(dist(aa[i, ]))
}, .parallel = TRUE)
# then, you could write your for-loop using plyr again as follows
output <- laply(1:n, function(i) {
A <- akl.list[[i]]
dVarX <- sqrt(mean(A * A))
t <- laply(i:n, function(j) {
B <- akl.list[[j]]
V <- sqrt(dVarX * (sqrt(mean(B*B))))
sqrt(mean(A * B))/V
})
c(rep(0, n-length(t)), t)
}, .parallel = TRUE)
Note that I have added .parallel = TRUE only on the outer loop. This is because, you assign 10 processors to the outer loop. Now, if you add it to both outer and inner loops, then the total number of processers will be 10 * 10 = 100. Please take care of this.