I have a question regarding the following R code segment
n <- 20
theta <- 5
x <- runif(n)
y <- x * theta + rnorm(n)
empirical.risk <- function(b) {
mean((y-b*x)^2)
}
true.risk <- function(b) {
1 + (theta - b)^2 * (0.5^2 + 1 / 12)
}
curve(Vectorize(empirical.risk)(x), from = 0, to = 2 * theta,
xlab = "regression slope", ylab = "MSE risk")
curve(true.risk, add = TRUE, col = "grey")
This code segment makes use of the Vectorize but I do not quite understand how it works. Especially, in curve(true.risk, add = TRUE, col = "grey") even no parameters are passed to true.risk
So first, the curve(...) function works by forming a vector of length n (default n=101) of values between from and to (0 and 10 in your example). Then it passes that vector to the function defined in the first argument and plots the returned vector. So the first argument to curve(...) has to be "vectorized"; in other words it has to take a vector as an argument and return a vector of the same length.
Your function, empirical.risk(...) is not vectorized: if you pass it a scalar, you get what you would expect, but if you pass it a vector (e.g., multiple values of b), you get back a scalar. The reason is actually quite subtle and has to do with the use of (y-b*x). If you pass a vector, R tries to form the product of the vector b and the vector x to create a new vector, which it then subtracts from the vector y. Then it takes the mean of that vector and returns a single value. What you want is a vector that is the result of running empirical.risk(...) on all the values of b in succession. This is what Vectorize does.
Another way to think about it is that Vectorize(...) is equivalent to wrapping your function with sapply(...)
f <- Vectorize(empirical.risk)
f(1:5)
# [1] 5.663989 3.660942 2.279632 1.520057 1.382219
sapply(1:5,empirical.risk)
# [1] 5.663989 3.660942 2.279632 1.520057 1.382219
Regarding the second part of your question, why the last line of code works: when add=T, curve(...) gets it's defaults from the existing plot. So, since you defined the vector x in that plot (using from and to and the default n), the second call to curve(...) uses that.
Related
I made this derivative script and I wanted to plot the graph of the result of the derivative along with the function.
But I am not able to make the graph in the multivariate case f(x,y), the result of the derivative is taken as a value and not as a function.
See the example below:
DD7<-function(x,r,contador=1){
dy<- substitute(x)
if(contador<1) {
stop("Grau de derivada menor que 1")
}
if(contador==1) {
der<-D(dy,c(r))
print(der)
x<- y <- seq(-3,3,length=50)
z<- outer(x,y,der)
persp(x,y,z)
}
else {
der2<- DD(D(dy,r),r,contador-1)
print(der2)
x2<- y2 <- seq(-3,3,length=50)
z2<- outer(x,y,der2)
persp(x,y,z2)
}
}
DD7(x*y^2,"y",1)
Error in get(as.character(FUN), mode = "function", envir = envir) :
object 'der' of mode 'function' was not found
As I said in my comments, outer's third argument needs to be a function. If you use eval(der), you may infer (correctly) that it is evaluating the expression (y^2 in this example) based on the objects found in the calling environment (the function's environment, to be specific). Since x and y are both found, then eval(der) uses those variables, and returns a vector of the appropriate length.
The purpose of outer is to do an outer-join of the values, expanding into length(x)*length(y) combinations. If you look at the function as it is called by outer, its first argument is length(x)*length(y) elements long, all from the original x; the second argument is also that length, from the original y. The order of the values are such that all values from x are paired with all values of y.
Given this what we need to do is have eval(der) operate in that environment.
DD7 <- function(x, r, contador=1) {
# ...
z2 <- outer(x, y, function(x, y) eval(der))
persp(x, y, z2)
# ...
}
DD7(x*y^2, "y", 1)
# x * (2 * y)
In that example, it might be confusing which x and y are referenced when; it's straight-forward: inside the anon-function passed to outer, we also name them the same names so that the evaluated der will find the relevant expanded values.
Let me make my question clear because I don't know how to ask it properly (therefore I don't know if it was answered already or not), I will go through my whole problem:
There is a given function (which is the right side of an explicit first order differential equation if it matters):
f = function(t,y){
-2*y+3*t
}
Then there's a given interval from 'a' to 'b', this is the range the function is calculated in with 'n' steps, so the step size in the interval (dt) is:
dt=abs(a-b)/n
In this case 'a' is always 0 and 'b' is always positive, so 'b' is always greater than 'a' but I tried to be generic.
The initial condition:
yt0=y0
The calculation that determines the vector:
yt=vector("numeric",n)
for (i in 1:(n-1))
{
yt[1]=f(0,yt0)*dt+yt0
yt[i+1]=(f(dt*i,yt[i]))*dt+yt[i]
}
The created vector is 'n' long, but this is an approximate solution to the differential equation between the interval ranging from 'a' to 'b'. And here comes my problem:
When I try plotting it alongside the exact solution (using deSolve), it is not accurate. The values of the vector are accurate, but it does not know that these values belong to an approximate function that's between the interval range 'a' to 'b' .
That's why the graphs of the exact and approximate solution are not matching at all. I feel pretty burnt out, so I might not describe my issue properly, but is there a solution to this? To make it realise that its values are between 'a' and 'b' on the 'x' axis and not between '1' and 'n'?
I thank you all for the answers in advance!
The deSolve lines I used (regarding 'b' is greater than 'a'):
df = function(t, y, params) list(-2*y+3*t)
t = seq(a, b, length.out = n)
ddf = as.data.frame(ode(yt0, t, df, parms=NULL))
I tried to reconstruct the comparison between an "approximate" solution using a loop (that is in fact the Euler method), and a solution with package deSolve. It uses the lsoda solver by default that is more precise than Euler'S method, but it is of course also an approximation (default relative and absolute tolerance set to 1e-6).
As the question missed some concrete values and the plot functions, it was not clear where the original problem was, but the following example may help to re-formulate the question. I assume that the problem may be confusion between t (absolute time) and dt between the two approaches. Compare the lines marked as "original code" with the "suggestion":
library(deSolve)
f = function(t, y){
-2 * y + 3 * t
}
## some values
y0 <- 0.1
a <- 3
b <- 5
n <- 100
## Euler method using a loop
dt <- abs(a-b)/n
yt <- vector("numeric", n)
yt[1] <- f(0, y0) * dt + y0 # written before the loop
for (i in 1:(n-1)) {
#yt[i+1] = (f( dt * i, yt[i])) * dt + yt[i] # original code
yt[i+1] <- (f(a + dt * i, yt[i])) * dt + yt[i] # suggestion
}
## Lsoda integration wit package deSolve
df <- function(t, y, params) list(-2*y + 3*t)
t <- seq(a, b, length.out = n)
ddf = as.data.frame(ode(y0, t, df, parms=NULL))
## Plot of both solutions
plot(ddf, type="l", lwd=5, col="orange", ylab="y", las=1)
lines(t, yt, lwd=2, lty="dashed", col="blue")
legend("topleft", c("deSolve", "for loop"),
lty=c("solid", "dashed"), lwd=c(5, 2), col=c("orange", "blue"))
I'm trying to create a loop that will evaluate this equation.
10
y = ∑X^j
j=0
When x = 5. I am trying to use this code
y=0 # initialize y to 0
x = 5
for(i in 1:5){y[i] = (exp(x[0:10]))}
print(y)
but I can't seem to even get the exponents right, let alone the summation. Anyone know how to use a for loop to evaluate this sum?
The code is mixing a for loop with a sequence which is likely not going to produce the results you want. Also, the error that "number of items to replace is not a multiple of replacement length" shows there is a problem with the sequence and trying to index a single value.
x <- 5
y <- 0
for (i in 0:10) {
y <- y + x ^ i
}
Comparing the results to the most succint way listed above shows the results are the same.
> setequal(y, sum(x^(0:10)))
[1] TRUE
how would I write a function which chooses between two functions depending on whether the argument is larger or smaller zero and writes the generated values into a y vector so that one can plot(x,y). Can you please tell me whether this is the right ansatz or not:
x <- runif(20,-20,20)
y <- numeric()
f <- function(x){
if(x>0){y <- c(y,x^2)}
if(x<0){y <- c(y,x^3)}
}
for(i in x){f(x)}
plot(x,y)
As I can see, there are few problems with your code:
Your function f does not return any meaningful values. The assignment to y
is not global and remains in the scope of the function.
Many operations in R are vectorized (i.e. they are performed on the whole vectors instead of individual elements), and this is an important feature of a good R code, but your code does not take advantage of that. To give a gist, when you do x > 0, and x is a vector, it will return a boolean vector where condition is checked for every element of x. When you do x^2, it returns a numeric vector where every element is a square of the corresponding element in x. ifelse is also a vectorized operator, so it also checks the condition for every element in the vector. By knowing that, you can get rid of your function and loop and do y <- ifelse(x<0,x^3,x^2).
You don't need the loop, and in this case it is not even necessary to define f(x) and to store the output in a vector y.
Something like
x <- runif(20,-20,20)
plot(x,ifelse(x<0,x^3,x^2))
should do. The second argument can take several versions, as discussed in the comments.
If you want to store the function and the data for later use, try
x <- runif(20,-20,20)
f <- function(x) ifelse (x < 0, x^3, x^2)
y <- f(x)
plot (x,y)
Here is another option...
x <- runif(20,-20,20)
y <- x^2*(x>0)+x^3*(x<=0)
plot(x,y)
R will interpret (x > 0) as a boolean (T or F) and then automatically transform it to 1 and 0.
I am trying to find more efficient way(s) to fill an output matrix by applying a function to elements in a data.frame. I experimented with the apply() family functions and the outer() function but couldn't make them work.
Maybe someone here might be able to help? Here's a simplified version of my script. Thanks!
set.seed(192)
n = 1000
distMatrix <- matrix(nrow=n,ncol=n)
# Co-ordinates
coord <- data.frame(x = runif(n,min=0,max=n),
y = runif(n,min=0,max=n))
# Distance Function
distance <- function(A,B) { sqrt( (A['x']-B['x'])^2 + (A['y']-B['y'])^2 ) }
# Fill distMatrix -- this part could use better programming. Note that I am only
# filling the upper triangular part of distMatrix.
for (r in 1:(n-1)) {
for (c in (r+1):n) {
distMatrix[[r,c]] <- distance(coord[r,],coord[c,])
}
}
You can use:
distFun <- function(A,B)
sqrt(
(coord[A, "x"] - coord[B, "x"]) ^ 2 +
(coord[A, "y"] - coord[B, "y"]) ^ 2
)
distMatrix <- outer(1:nrow(coord), 1:nrow(coord), distFun)
Notice that we need to pass outer two vectors. Here we use the indeces of the rows of the data frame. outer then produces two new vectors that together represent every possible combination of our original vectors, and passes those to our function. Our function then pulls the relevant coordinates for our calculations (here coord is assumed to be defined ahead of the function).
One key thing to understand when using outer is that our function is called only once. outer just computes the vector inputs assuming our function is vectorized, and then applies the corresponding dimensions to the result.
Also, look at ?dist:
dist(coord)
Try it with a smaller matrix (maybe 10 by 10) to see the result.