I am new to R environment and would like the understand the code posted in another thread.
Integrating over a PCHIP Function
1 > library(pracma)
2 > xs <- linspace(0, pi, 10)
3 > ys <- sin(xs)
4 > pchipfun <- function(xi, yi) function(x) pchip(xi, yi, x)
5 > f <- pchipfun(xs, ys)
6 > integrate(f, 0, pi)
My questions are as follows:
Line 5 is calling function in line 4, but this is not passing x value. So how does line 4 take x value?
In the above setup, I would like to modify such that if x is in between pi/6 & pi/4, the function should return 0 otherwise return calculated value.
Thanks in advance.
For question 1, you can read about Currying:
https://en.wikipedia.org/wiki/Currying
For question 2, perhaps you can paste what you have tried first.
Related
I am looking for an efficient way to nest the same function in R until a condition is met. I hope the following example illustrates my problem clearly.
Consider the function
f(x) = x^2 + 1, with x > 1.
Denote
f^{(k)}(x) = f(f(f(...f(x)))),
where the function f is evaluated k times within itself. Let M > 0, with M given.
Is there any efficient routine in R to determine the minimum value of k such that f^{(k)}(2) > M?
Thank you.
Nothing special for that. Just use a loop:
function(x, M) {
k <- 0
repeat {
x <- x^2 + 1
k <- k + 1
if (x > M)
break
}
k
}
Not particularly efficient, but often the overhead of evaluating f will be greater than the overhead of the loop. If that's not the case (and it might not be for this particular f), I'd suggest doing the equivalent thing in C or C++ (perhaps using Rcpp).
This would be the recursive approach:
# 2^2 + 1 == 5
# 5^2 + 1 == 26
# 26^2 + 1 == 677
f <- function(x,M,k=0){
if(x <= M) k <- f(x^2 + 1,M=M,k+1)
return(k)
}
f(2,3) # 1
f(2,10) # 2
f(2,50) # 3
f(2,700) # 4
Let's say i have a function defined as the following in R:
> f <- function(x) 0.5*sin(x)*(x>=0)*(x<=pi)
i can do this to integrate it between 0 and pi:
> Integrate <- function(f,a,b) integrate(Vectorize(f),a,b)$value
> F <- Integrate(f,0,pi)
But if i want to evaluate and return some values of F i get this error:
> F(c(-100,0,1,2,pi,100))
Error in F(c(-100, 0, 1, 2, pi, 100)) :
function "F" is not found
i can understand that this is due to the fact, that my integrate <- function(f,a,b) returns a constant value C which is the result of the integration of f between a and b, but how can i return F as a function to be able to evaluate it's values as a vector and plot it ?
like in this case F should give 0 for any value less than 0 and 1 for any value bigger than pi and be variable between them.
Thanks.
Edit: just to sum it up more clearly: how can i define a function f(x) in [a,b] that will give me f(x) if x is in [a,b], 0 if xb ?
Try wrapping your function call in an sapply and have Integrate return a function.
Integrate <- function(f, a, b) function(x) if (x < a) 0 else if (x > b) 1 else integrate(Vectorize(f), a, x)$value
F <- Integrate(f, 0, pi)
sapply(c(-100,0,1,2,pi,100), F)
gives
[1] 0.0000000 0.0000000 0.2298488 0.7080734 1.0000000 1.0000000
I am trying to create a function that calculates recursive form which will applied to a data frame. I have a data frame object which has 6 columns and each one has a 10 rows.
Data <- data.frame()
for(i in 1:(10)) {Data <- rbind(Data ,c(A=i+2,B=sqrt(i),C=1/i,D=i/120,E=i/250,F=i+3)); names(Data ) <- letters[1:6]}
I want to use the following recursive function :
f<-function(x,para,c,d,e){
# Constant
h=0.25
#para_para<-c() set up the parameters of the model
y1=para[1]
y2=para[2]
y3=para[3]
# Terminal condition for the A and B at time T
A=0
B=0
# Recursion back to time t
steps<-round(d*250,0)
for (i in 1:steps){
A= A+ e*x +y1*B
B= y2*B+y3
}
f = exp(log(c)*x -A + B*h )
return(f)
}
Under some specific values the function works :
> para<-c(1,-0.001,0.5)
> W<-f(x=0.5,para,c=0.1,d=0.2,e=0.3)
> W
[1] 4.647528e-15
I want to apply this funtion to my data frame with respect the rows of my data frame with : c=Data$c,d=Data$d,e=Data$e. I tried this code with some warning:
f(x=0.5,para,c=Data$c,d=Data$d,e=Data$e)
[1] 0.6844600 0.4820543 0.3920244 0.3381478 0.3012412 0.2738966 0.2525667
[8] 0.2353113 0.2209680 0.2087918
Warning message:
In 1:steps : numerical expression has 10 elements: only the first used
In fact thisis not correct, because the function is applied only for the first competent of d which is 2=d*250. The problem is the steps because it changes and takes values from the rows of the data frame. One of the correct way to do it is :
> mapply(function(c,d,e) f(x=0.5,para,c,d,e),c=Data$c,d=Data$d,e=Data$e)
[1] 6.844600e-01 1.761008e-01 5.190021e-02 1.609455e-02 5.113622e-03
[6] 1.645010e-03 3.185962e-04 1.031473e-04 3.339030e-05 1.078962e-05
What I want to find is a simple way and direct way just using the f without using mapply.
Thanks in advance.
I think you know where the problem lies. Modifying your function slightly to see to that it can take the vector arguments:
f1<-function(x,para,c,d,e){
# Constant
h=0.25
#para_para<-c() set up the parameters of the model
y1=para[1]
y2=para[2]
y3=para[3]
# Recursion back to time t
f <- rep(NA, length(c))
for (i in 1:length(c)){
A=0
B=0
steps<-round(d[i]*250,0)
for (j in 1:steps){
A= A+ e[i]*x +y1*B
B= y2*B+y3
}
f[i] = exp(log(c[i])*x -A + B*h )
}
return(f)
}
Now it can take both scalar and vector arguments.
f1(x=0.5,para,c=0.1,d=0.2,e=0.3)
#[1] 4.647528e-15
f1(x=0.5, para, c=Data$c, d=Data$d, e=Data$e)
#[1] 6.844600e-01 1.761008e-01 5.190021e-02 1.609455e-02 5.113622e-03 1.645010e-03 3.185962e-04 1.031473e-04 3.339030e-05
#[10] 1.078962e-05
Does this give you what you want?
Using a lambda function inside apply:
> apply(Data, 1, function (p) f(x=0.5, para, p['c'], p['d'], p['e']))
1 2 3 4 5 6 7 8
6.844600e-01 1.761008e-01 5.190021e-02 1.609455e-02 5.113622e-03 1.645010e-03 3.185962e-04 1.031473e-04
9 10
3.339030e-05 1.078962e-05
You could also rewrite your function so it works more compactly with apply:
f2<-function(cde, x, para){
c <- cde[1]
d <- cde[2]
e <- cde[3]
# Constant
h=0.25
#para_para<-c() set up the parameters of the model
y1=para[1]
y2=para[2]
y3=para[3]
# Terminal condition for the A and B at time T
A=0
B=0
# Recursion back to time t
steps<-round(d*250,0)
for (i in 1:steps){
A= A+ e*x +y1*B
B= y2*B+y3
}
f = exp(log(c)*x -A + B*h )
return(f)
}
> apply(Data[,c('c','d','e')], 1, f2, x=0.5, para)
1 2 3 4 5 6 7 8
6.844600e-01 1.761008e-01 5.190021e-02 1.609455e-02 5.113622e-03 1.645010e-03 3.185962e-04 1.031473e-04
9 10
3.339030e-05 1.078962e-05
> all.equal(apply(Data[,c('c','d','e')], 1, f2, x=0.5, para),
apply(Data, 1, function (p) f(x=0.5, para, p['c'], p['d'], p['e'])))
[1] TRUE
a) Create a vector X of length 20, with the kth element in X = 2k, for k=1…20. Print out the values of X.
b) Create a vector Y of length 20, with all elements in Y equal to 0. Print out the values of Y.
c) Using a for loop, reassigns the value of the k-th element in Y, for k = 1…20. When k < 12, the kth element of Y is reassigned as the cosine of k. When the k ≥ 12, the kth element of Y is reassigned as the value of integral sqrt(t)dt from 0 to K.
for the first two questions, it is simple.
> x1 <- seq(1,20,by=2)
> x <- 2 * x1
> x
[1] 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40
> y <- rep(0,20)
> y
[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
i got stuck on the last one,
t <- function(i) sqrt(i)
for (i in 1:20) {
if (i < 12) {
y[i] <- cos(i)
}
else if (i >= 12) {
y[i] <- integral(t, lower= 0, Upper = 20)
}
}
y // print new y
Any suggestions? thanks.
What may help is that the command to calculate a one-dimensional integral is integrate not integral.
You have successfully completed the first two, so I'll demonstrate a different way of getting those vectors:
x <- 2 * seq_len(20)
y <- double(length = 20)
As for your function, you have the right idea, but you need to clean up your syntax a bit. For example, you may need to double-check your braces (using a set style like Hadley Wickham's will help you prevent syntax errors and make the code more readable), you don't need the "if" in the else, you need to read up on integrate and see what its inputs, and importantly its outputs are (and which of them you need and how to extract it), and lastly, you need to return a value from your function. Hopefully, that's enough to help you work it out on your own. Good Luck!
Update
Slightly different function to demonstrate coding style and some best practices with loops
Given a working answer has been posted, this is what I did when looking at your question. I think it is worth posting, as as I think that it is a good habit to 1) pre-allocate answers 2) prevent confusion about scope by not re-using the input variable name as an output and 3) use the seq_len and seq_along constructions for for loops, per R Inferno(pdf) which is required reading, in my opinion:
tf <- function(y){
z <- double(length = length(y))
for (k in seq_along(y)) {
if (k < 12) {
z[k] <- cos(k)
} else {
z[k] <- integrate(f = sqrt, lower = 0, upper = k)$value
}
}
return(z)
}
Which returns:
> tf(y)
[1] 0.540302306 -0.416146837 -0.989992497 -0.653643621 0.283662185 0.960170287 0.753902254
[8] -0.145500034 -0.911130262 -0.839071529 0.004425698 27.712816032 31.248114562 34.922139530
[15] 38.729837810 42.666671456 46.728535669 50.911693960 55.212726149 59.628486093
To be honest you almost have it ready and it is good that you have showed some code here:
y <- rep(0,20) #y vector from question 2
for ( k in 1:20) { #start the loop
if (k < 12) { #if k less than 12
y[k] <- cos(k) #calculate cosine
} else if( k >= 12) { #else if k greater or equal to 12
y[k] <- integrate( sqrt, lower=0, upper=k)$value #see below for explanation
}
}
print(y) #prints y
> print(y)
[1] 0.540302306 -0.416146837 -0.989992497 -0.653643621 0.283662185 0.960170287 0.753902254 -0.145500034 -0.911130262 -0.839071529 0.004425698
[12] 27.712816032 31.248114562 34.922139530 38.729837810 42.666671456 46.728535669 50.911693960 55.212726149 59.628486093
First of all stats::integrate is the function you need to calculate the integral
integrate( sqrt, lower=0, upper=2)$value
The first argument is a function which in your case is sqrt. sqrt is defined already in R so there is no need to define it yourself explicitly as t <- function(i) sqrt(i)
The other two arguments as you correctly set in your code are lower and upper.
The function integrate( sqrt, lower=0, upper=2) will return:
1.885618 with absolute error < 0.00022
and that is why you need integrate( sqrt, lower=0, upper=2)$value to only extract the value.
Type ?integrate in your console to see the documentation which will help you a lot I think.
I am trying to create a loop in R that allows me to change the value of an object within the loop.
Below is an easy example to point out what exactly I mean by this. Print(x) stands for a rather extensive bulk of code, in which the value of x is needed for certain computations. However, while solution #1 works on paper, it is not usable in this context (because of sub loops). Is there any way to design a loop in R that resembles solution #2? Thanks a lot in advance!
1> x <- 1
2> while (x == 1)
3> {
4> print(x)
5> x <- 2
6> print(x)
7> x <- 3
8> print(x)
9> x <- 4
10> print(x)
11> if (x == 4)
12> break
13> }
Output
1
2
3
4
1> x <- 1
2> while (x == 1 || x == 2 || x == 3 || x == 4)
3> {
4> print (x)
5> x <- 2
#jump to line 2, ignore line 5, proceed with line 6
6> x <- 3
#jump to line 2, ignore line 6, proceed with line 7
7> x <- 4
#jump to line 2, ignore line 7, proceed with line 8
8> if (x == 4)
9> break
10> }
Output
1
2
3
4
It is somewhat hard to tell what exactly you want to do, but I'll give a shot, too. So you first might want to write a function that takes the value of x and does computations depending on the value of x (as far as I got it from your example, the computations/loops are not the same for all x).
x <- 1:4
fct <- function(x) {
if (x==1){
y <- x^2
}
if (x==2) {
y <- x + 2
}
if (x>2 & x < 5) {
y <- x*3 + 4
}
return(y)
}
Now loop over x:
sapply(x, fct)
Is that what you want?
I'm not sure it's gonna work because it's not clear exactly what you want to do, but could you try to put in a vector all the values you want to run print on? Like this:
my_values <- c(1,2,3,4)
for(x in my_values) {
print(x)
}
EDIT:
What I am gonna may be totally useless, but are you getting your next key from RODBC as well? If that's the case, suppose that you can get your next key with a function get_next_key and your data with get_data. I also assume that get_next_key returns NA if there is no more key (i.e you had the last key before). Would that work:
x = 1
while(!is.na(get_next_key(x))) {
data = get_data(x)
print(data)
x = get_next_key(x)
}
This first obviously works only for integer increments of x:
x <- 1
while (x <= 4){
print(x)
x <- x+1
}
For arbitrary values of x:
x1 <- c(1, 2, 3, 4)
### index x1 and move along this;
### at each step assign the value to y1 then
### do something with (print) it
for (i in seq_along(x1)) print(y1 <- x1[i])
Nothing really wrong with a for loop here and sometimes easier to read than apply