I will be highly grateful for your help. I am learning how to use geom_function in r. Following is my function:
x0 <- 0.5
x1 <- 1
x2 <- 2
x3 <- 3
x <- c(x0, x1, x2, x3)
myfn <- function(w, b, a, x){
w^(1-b)/(1-b)-a*w-(w>100 & w<=200)*x[3]*(w-100)-(w>200)*x[3]*100-x[4]*(w-200)
}
My objective is to plot above function using geom_function to see how this function behaves with different values of arguments a and b and following is my code:
y=seq(0,1000,5)
ggplot()+
xlim(c(0,1000))+
geom_function(fun=myfn(w=y, b=-4, a=0.5, x=x))
Problem: I feel my logic is correct but when I execute above code, I get nothing. I will be highly grateful for the help. Thank you very much for the help in advance. Any help or direction will be highly appreciated.
Your function myfn is a function of w where a, b and x are parameters. To plot this function over the range of c(0, 1000) pass your function to the fun argument and the parameters as a list via the args argument and set the range via xlim:
x0 <- 0.5
x1 <- 1
x2 <- 2
x3 <- 3
x <- c(x0, x1, x2, x3)
myfn <- function(w, b, a, x) {
w^(1 - b) / (1 - b) - a * w - (w > 100 & w <= 200) * x[3] * (w - 100) - (w > 200) * x[3] * 100 - x[4] * (w - 200)
}
library(ggplot2)
ggplot() +
xlim(c(0, 1000)) +
geom_function(fun = myfn, args = list(b = -4, a = 0.5, x = x))
A second option would be to make use of a lambda function like so:
ggplot() +
xlim(c(0, 1000)) +
geom_function(fun = ~ myfn(.x, b = -4, a = 0.5, x = x))
myfn <- function(x, a, b, c) {
x^(1 - b) / (1 - b) - a * x - (x > 100 & x <= 200) * c[3] * (x - 100) - (x > 200) * c[3] * 100 - c[4] * (x - 200) # outcome is y
}
ggplot() +
xlim(c(0, 1000)) +
geom_function(fun = ~ myfn(x = .x, a = 0.5, b = -4, c = c(0.5, 1, 2, 3)))
If you do not want to add the variables through the args list you can add the variables to your function like this. Note I changed some of the variable names to make it more clear what the actual x and y are in the plot. Also x by the OP is just a list with 4 constants, I provided them as a and b under the name c.
Related
I'm now learning about calculus and want to depict a graph of x^2 + 6x + y^4 = 7, which I can using online graphing tool desmos.
But when I'm not sure how this is achievable on R. The first thing I thought is convert it in a form of y = f(x), but return (x^2 + 6*x - 7)^(1/4) gave me a different result.
At the same time, it seems impossible to return a equation in a function (return (x^2 + 6*x + y^4 = 7)). So how can I depict it on R?
Here is a sample code I usually use to depict a continuous graph.
f <- function(x) {
return () # return an equation
}
ggplot(data.frame(x=seq(-10,10,length.out=10)), aes(x)) + stat_function(fun=f)
You can have separate functions for the positive and negative solutions for y
f1 <- function(x) (7 - x^2 - 6*x)^(1/4)
f2 <- function(x) -f1(x)
Now just create a vector each for positive and negative values along the domain of x:
x <- seq(-7, 1, length = 1000)
y1 <- f1(x)
y2 <- f2(x)
And plot:
ggplot() +
geom_line(aes(x, y1)) +
geom_line(aes(x, y2))
You can use contourLines:
f <- function(x,y) x^2 + 6*x + y^4
x <- seq(-10, 3, len = 200)
y <- seq(-3, 3, len = 200)
z <- outer(x, y, f)
cr <- contourLines(x, y, z, levels = 7)
plot(cr[[1]]$x, cr[[1]]$y, type = "l")
library(ggplot2)
dat <- data.frame(x = cr[[1]]$x, y = cr[[1]]$y)
ggplot(dat) + geom_path(aes(x, y))
I want create 10 b1's for each value of x1 and x2's in xp and yp lists by optimizing res formula below. However my values are somehow not added to b1.created. I get b1.created = 0 when I check after I run the code.How can I make the code work?
y <- matrix(c(1,2,3,4,2,6,7,8,9,10),ncol = 1)
x1 <- matrix(c(2,4,6,5,10,12,14,16,18,20),ncol =1)
x2 <- matrix(c(1,4,9,16,25,25,48,64,81,99),ncol = 1)
x <- cbind(x1,x2)
created.b1 = 0
normal <- function(b0,y,xp,yp,x1,x2){for (i in xp){
res <- sum((y- (b0 + x1[i]*xp[i] + x2[i]*yp[i]))^2)
optobj <- optimize(normal,c(-10,10),y =y ,xp = xp,yp =yp, x1 = x1,x2 = x2)
created.b1[i] = obtobj$minimum[i]
}
}
I think this does what you want, but please cross-check.
created.b1 <- numeric(length = 10)
for (i in 1:10)
{
opt_obj <- optimise(f = function(b0, y, xp, yp, x1, x2) sum((y - (b0 + (x1 * xp) + (x2 * yp))) ^ 2),
interval = c(-10, 10),
y = y,
xp = xp[i],
yp = yp[i],
x1 = x1,
x2 = x2)
created.b1[i] <- opt_obj$minimum
}
created.b1
I'm trying to build covariance matrix from a scratch (cov() function). My task is not to use any package. Hence I created my functions:
meanf <- function(x){
sum(x) / length(x)
}
sampleCov <- function(x,y){
stopifnot(identical(length(x), length(y)))
sum((x - meanf(x)) * (y - meanf(y))) / (length(x) - 1)
}
> sampleCov(winequality_red$quality, winequality_red$alcohol)
[1] 0.409789
Unfortunately, I'm stuck here. All loops I tried to apply are missing any point. Of course it's possible to just copy the sampleCov function and make it for every possible combination but that's not my point.
If I understand you correctly then I believe you want to recreate a covariate output like the one returned by cov function.
OPs given function:
meanf <- function(x){
sum(x) / length(x)
}
sampleCov <- function(x,y){
stopifnot(identical(length(x), length(y)))
sum((x - meanf(x)) * (y - meanf(y))) / (length(x) - 1)
}
You can try this way, I have taken mtcars data here:
Covariate Function:
vars <- names(mtcars)
egrid <- expand.grid(vars, vars)
egrid <- data.frame(sapply(egrid, as.character),stringsAsFactors = F)
egrid <- egrid[order(egrid$Var1, egrid$Var2),]
mat <- vector("list", nrow(egrid))
for(i in 1:nrow(egrid)){
mat[[i]] <- sampleCov(mtcars[,egrid[i,"Var1"]], mtcars[,egrid[i,"Var2"]])
}
finaldat <- cbind(egrid, cov = do.call('rbind', mat))
finaldat_list <- split(finaldat, finaldat$Var1)
mat_form <- do.call('cbind', finaldat_list)
cov_values <- mat_form[,grepl("\\.cov",names(mat_form))]
col_values <- mat_form[,paste0(egrid$Var1[1],".Var2")]
final_matrix_cov <- cbind(col_values, cov_values)
Sample Output:
> final_matrix_cov
col_values am.cov carb.cov cyl.cov disp.cov
9 mpg 1.80393145 -5.36310484 -9.1723790 -633.09721
20 cyl -0.46572581 1.52016129 3.1895161 199.66028
31 disp -36.56401210 79.06875000 199.6602823 15360.79983
42 hp -8.32056452 83.03629032 101.9314516 6721.15867
You need the matrix multiplication %*%.
sampleCov <- function(x,y){
stopifnot(identical(length(x), length(y)))
sum((x - mean(x)) %*% (y - mean(y))) / (length(x) - 1)
}
> sampleCov(rnorm(10000),rnorm(10000))
[1] 0.01808466
This is probably a little more than you need, but it should answer your question, and I think it is a nice illustration of the practical application of covariances, correlations, etc.
# load the data
link <- "https://raw.githubusercontent.com/DavZim/Efficient_Frontier/master/data/mult_assets.csv"
df <- data.table(read.csv(link))
# calculate the necessary values:
# I) expected returns for the two assets
er_x <- mean(df$x)
er_y <- mean(df$y)
# II) risk (standard deviation) as a risk measure
sd_x <- sd(df$x)
sd_y <- sd(df$y)
# III) covariance
cov_xy <- cov(df$x, df$y)
# create 1000 portfolio weights (omegas)
x_weights <- seq(from = 0, to = 1, length.out = 1000)
# create a data.table that contains the weights for the two assets
two_assets <- data.table(wx = x_weights,
wy = 1 - x_weights)
# calculate the expected returns and standard deviations for the 1000 possible portfolios
two_assets[, ':=' (er_p = wx * er_x + wy * er_y,
sd_p = sqrt(wx^2 * sd_x^2 +
wy^2 * sd_y^2 +
2 * wx * (1 - wx) * cov_xy))]
two_assets
# lastly plot the values
ggplot() +
geom_point(data = two_assets, aes(x = sd_p, y = er_p, color = wx)) +
geom_point(data = data.table(sd = c(sd_x, sd_y), mean = c(er_x, er_y)),
aes(x = sd, y = mean), color = "red", size = 3, shape = 18) +
# Miscellaneous Formatting
theme_bw() + ggtitle("Possible Portfolios with Two Risky Assets") +
xlab("Volatility") + ylab("Expected Returns") +
scale_y_continuous(label = percent, limits = c(0, max(two_assets$er_p) * 1.2)) +
scale_x_continuous(label = percent, limits = c(0, max(two_assets$sd_p) * 1.2)) +
scale_color_continuous(name = expression(omega[x]), labels = percent)
See the link below for all details.
https://datashenanigan.wordpress.com/2016/05/24/a-gentle-introduction-to-finance-using-r-efficient-frontier-and-capm-part-1/
I want to fit to a 1 - exp(x) function to a data set , but giving higher weight to the first values. However, the following code is not working in such way:
x <-sqrt((0.05)^2+(0.05)^2)*seq(from = 1, to = 20, by = 1)
y <- c(11,20,27,32,35,36,36.5,25,16,9,4,1,7.87e-16,2.07e-15,-9.36e-16,1.61e-15,-3.81e-16,3.92e-16,7.65e-16,-8.26e-16)
temp <- data.frame(cbind(x,y))
we <- 1/(log1p(seq_along(x)))
# fit non-linear model
mod <- nls(y ~ (1 - exp(a + b * x)), data = temp, start = list(a = 0, b = 0), weights = we)
#add fitted curve
lines(temp$x, predict(mod, list(x = temp$x)))
Here is the output:
Your specification of weights is correct. The bad fit you obtained is due to your faulty model assumption. You assumed:
y ~ 1 - exp(a + b * x)
Note that exp() gives strictly positive values, so y will be no larger than 1. However, y values in your data range up to 35.
My idea is not perfect, but it might give you a better starting point. Consider:
y ~ a * x * exp(b * x * x + c * x)
Using your data:
x <- c(0, sqrt((0.05)^2+(0.05)^2)*seq(from = 1, to = 20, by = 1))
y <- c(0, 11,20,27,32,35,36,36.5,25,16,9,4,1,7.87e-16,2.07e-15,-9.36e-16,1.61e-15,-3.81e-16,3.92e-16,7.65e-16,-8.26e-16)
fit <- nls(y ~ a * x * exp(b * x * x + c * x), start = list(a = 30, b= -1, c = -1))
plot(x, y)
lines(x, predict(fit, list(x)))
I want to write an R function that takes a mathematical function in x and returns a new function in x as an output. For example:
The input should be passed in as a mathematical function (or relation) in x:
g <- x^2 + 9*x + log(x)
And the resulting output should be:
function(x) (exp(g))
i.e. I want to return the symbolic exponential expression of the original function in x i.e. exp(x^2 + 9*x + log(x)) in this illustrative example
So ideally it would return the function object:
function(x) (exp(x^2 + 9*x + log(x)))
I tried as follows:
test <- function(g){
h <- function(x){exp(g)}
return(h)
}
m <- test(x^2 + 9*x + log(x))
m(10)
So m(10) should return:
exp(10^2 + 9*10 + log(10))
which is exp(192.3026) in this case.
Could anyone show how to do this please?
You could use package functional:
library(functional)
fun <- Compose(function(x) x^2 + 9*x + log(x), exp)
fun(1)
#[1] 22026.47
Here is one approach:
test <- function(e) {
ee <- substitute(e)
eee <- substitute(exp(X), list(X=ee))
f <- function(x) {}
body(f) <- eee
environment(f) <- parent.frame()
f
}
## Check that it works
m <- test(x^2 + 9*x + log(x))
m
# function (x)
# exp(x^2 + 9 * x + log(x))
m(1)
# [1] 22026.47
m(1) == exp(10)
# [1] TRUE
edit - for functionality in question
f <- function(...) {
l <- eval(substitute(alist(x = x, ...)))
l[[2]] <- substitute(exp(X), list(X = l[[2]]))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
g <- f(x^2 + 2*x + 5)
# function (x = x)
# exp(x^2 + 2 * x + 5)
g(1)
# [1] 2980.958
Here is another way for a general case:
f <- function(...) {
l <- eval(substitute(alist(...)))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
g <- f(x, x^2 + 9*x + log(x))
# function (x = x)
# x^2 + 9 * x + log(x)
g(10)
# [1] 192.3026
This version will also work for any number of variables, just define them followed by the function:
g <- f(x, y, z, x + 2 * y + z ** 3)
# function (x = x, y = y, z = z)
# x + 2 * y + z^3
g(1, 2, 0)
# [1] 5
There may be a better way to add ... to functions, but here is how you can do that
f <- function(..., use_dots = FALSE) {
l <- eval(substitute(alist(...)))
if (use_dots)
l <- c(head(l, -1), list('...' = as.symbol('...')), tail(l, 1))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
So now you don't have to name all the variables/arguments
g <- f(x, y, plot(x, y, ...), use_dots = TRUE)
g(1:5, 1:5, main = 'main title', pch = 16, col = 3, cex = 3, xpd = NA)