I am trying to plot the following function:
This is what I have currently tried:
curve(7*x*y/( e^(x^2+y^2)))
But I get the following error:
One way to plot is using the contour() function. Also, as #Sang won kim noted, exp() is the function for e^(...)
x <- seq(from = 0.01, to = 2.1, by = 0.01)
y <- x
multi_var_fx <- function (x, y) {
7 * x * y / (exp(x^2 + y^2))
}
z <- outer(x, y, multi_var_fx)
contour(x, y, z, xlab = 'x', ylab = 'y')
Created on 2019-10-27 by the reprex package (v0.3.0)
Your e means exponential function. In the r, exponential function code is exp(). So you can revise this code.
curve(7*x*y/(exp(x^2+y^2)))
You can create a contour plot like this:
library(tidyverse)
tibble(x = seq(0, 10, 0.1), # define the drawing grid
y = seq(0, 10, 0.1)
) %>%
cross_df() %>% # create all possible combinations of x and y
mutate(z = 7*x*y/(exp(x^2+y^2)) ) %>% # add your function
ggplot(aes(x = x, y = y, z = z)) + # create the plot
geom_contour()
Related
We often want individual regression equations in ggplot facets. The best way to do this is build the labels in a dataframe and then add them manually. But what if the labels contain plotmath, e.g., superscripts?
Here is a way to do it. The plotmath is converted to a string and then parsed by ggplot. The test_eqn function is taken from another Stackoverflow post, I'll link it when I find it again. Sorry about that.
library(ggplot2)
library(dplyr)
test_eqn <- function(y, x){
m <- lm(log(y) ~ log(x)) # fit y = a * x ^ b in log space
p <- exp(predict(m)) # model prediction of y
eq <- substitute(expression(Y==a~X^~b),
list(
a = format(unname(exp(coef(m)[1])), digits = 3),
b = format(unname(coef(m)[2]), digits = 3)
))
list(eq = as.character(eq)[2], pred = p)
}
set.seed(123)
x <- runif(20)
y <- runif(20)
test_eqn(x,y)$eq
#> [1] "Y == \"0.57\" ~ X^~\"0.413\""
data <- data.frame(x = x,
y = y,
f = sample(c("A","B"), 20, replace = TRUE)) %>%
group_by(f) %>%
mutate(
label = test_eqn(y,x)$eq, # add label
labelx = mean(x),
labely = mean(y),
pred = test_eqn(y,x)$pred # add prediction
)
# plot fits (use slice(1) to avoid multiple copies of labels)
ggplot(data) +
geom_point(aes(x = x, y = y)) +
geom_line(aes(x = x, y = pred), colour = "red") +
geom_text(data = slice(data, 1), aes(x = labelx, y = labely, label = label), parse = TRUE) +
facet_wrap("f")
Created on 2021-10-20 by the reprex package (v2.0.1)
I am attempting to create three contour plots, each illustrating the following function applied to two input vectors and a fixed alpha:
alphas <- c(1, 5, 25)
x_vals <- seq(0, 25, length.out = 100)
y_vals <- seq(0, 50, length.out = 100)
my_function <- function(x, y, alpha) {
z <- (1 / (x + alpha)) * (1 / (y + alpha))
}
for each alpha in the vector alphas, I am creating a contour plot of z values—relative to the minimal z value—over x and y axes.
I do so with the following code (probably not best practices; I'm still learning the basics with R):
plots <- list()
for(i in seq_along(alphas)) {
z_table <- sapply(x_vals, my_function, y = y_vals, alpha = alphas[i])
x <- rep(x_vals, each = 100)
y <- rep(y_vals, 100)
z <- unlist(flatten(list(z_table)))
z_rel <- z / min(z)
d <- data.frame(cbind(x, y, z_rel))
plots[[i]] <- ggplot(data = d, aes(x = x, y = y, z = z_rel)) +
geom_contour_filled()
}
When alpha = 1:
When alpha = 25:
I want to display these plots in one grouping using ggarrange(), with one logarithmic color scale (as relative z varies so much from plot to plot). Is there a way to do this?
You can build a data frame with all the data for all alphas combined, with a column indicating the alpha, so you can facet your graph:
I basically removed the plot[[i]] part, and stacked up the d's created in the former loop:
d = numeric()
for(i in seq_along(alphas)) {
z_table <- sapply(x_vals, my_function, y = y_vals, alpha = alphas[i])
x <- rep(x_vals, each = 100)
y <- rep(y_vals, 100)
z <- unlist(flatten(list(z_table)))
z_rel <- z / min(z)
d <- rbind(d, cbind(x, y, z_rel))}
d = as.data.frame(d)
Then we create the alphas column:
d$alpha = factor(paste("alpha =", alphas[rep(1:3, each=nrow(d)/length(alphas))]),
levels = paste("alpha =", alphas[1:3]))
Then build the log scale inside the contour:
ggplot(data = d, aes(x = x, y = y, z = z_rel)) +
geom_contour_filled(breaks=round(exp(seq(log(1), log(1400), length = 14)),1)) +
facet_wrap(~alpha)
Output:
I'm looking to plot 3D functions using R. For example, take the elliptic paraboloid given by f(x,y) = (𝑥−2𝑦−1)^2 + (3𝑥+𝑦−2)^2. Here's what I've tried:
require(lattice)
x <- seq(-10, 10, by=0.5)
y <- seq(-10, 10, by=0.5)
g <- expand.grid(x = x, y = y)
g$z <- (x-2*y-1)^2 + (3*x-y-2)^2
wireframe(z ~ x * y, g, drape = TRUE,
aspect = c(1,1), colorkey = TRUE)`
And here's the output
However, here's the "true" graph of f:
I've tried changing the definitions of x and y, to no avail. I've also tried the curve3d() function from the emdbook package. It looks even worse.
You multiplied by the wrong x and y. You need to use the ones inside g:
g$z <- with(g, (x-2*y-1)^2 + (3*x-y-2)^2)
wireframe(z ~ x * y, g, drape = TRUE,
aspect = c(1,1), colorkey = TRUE)
I am drawing a surface plot and would like to "manually" draw a contour line using plotly. In the code below I:
simulate the data for drawing the surface plot
calculate the coordinates of the contour line at a specific z level using the contoureR package
draw the surface plot and contour line
# Load packages
library(plotly) # for interactive visualizations
library(contoureR) # for calculating contour coordinates
# Simulate the data for plotting
x <- y <- seq(from = 0, to = 100, by = 1)
z1 <- outer(X = x, Y = y, FUN = function(x, y) x^0.2 * y^0.3) # data for surface plot
# Obtain coordinates of contour for z = 5
z_level <- 5
r <- contourLines(x = x, y = y, z = z1, levels = z_level)
plot_ly(
type = "surface",
x = x,
y = y,
z = z1,
) %>%
add_trace(
type = "scatter3d",
x = r[[1]]$x,
y = r[[1]]$y,
z = z_level
)
I am aware that these are all approximations, so I also tried to pass the x and y coordinates produced by contourLines() to the formula used to create z1above and use the corresponding values to plot my contour line (instead of using z_level = 5, but I still do not obtain the desired result:
plot_ly(
x = x,
y = y,
z = z1,
type = "surface"
) %>%
add_trace(
type = "scatter3d",
x = r[[1]]$x,
y = r[[1]]$y,
z = r[[1]]$x^0.2*r[[1]]$y^0.3
)
I alo know that plotly enables me to draw specific contour lines (see my question and answer here: Add a permanent contour line to a surface plot in R plotly). However, I would like to draw my contour line myself (after getting their coordinates) so it can "pull" by cursor and show me the tooltip info whenever I hover over it. Ideally, if there was a way to obtain the contour lines coordinates as computed by plotly itself, that would be great.
Thank you for your help.
I was able to find two solutions to this problem.
Solution 1: transpose the z1 matrix
The first solution was given me by #nirgrahamuk and it consists in transposing the z1 matrix:
library(plotly) # for interactive visualizations
# Simulate the data for plotting
x <- y <- seq(from = 0, to = 100, by = 1)
z1 <- outer(X = x, Y = y, FUN = function(x, y) x^0.2 * y^0.3) # data for surface plot
# Obtain coordinates of contour for z = 5
z_level <- 6
r <- contourLines(x = x,
y = y,
z = z1,
levels = z_level)
plot_ly(
type = "surface",
z = t(z1), # *** WE TRANSPOSE THE MATRIX HERE! ***
) %>%
add_trace(
type = "scatter3d",
x = r[[1]]$x,
y = r[[1]]$y,
z = z_level
)
Solution 2: use the isoband package
The second solution is to compute the contour lines coordinates with the isoband::isolines() function:
library(plotly) # for interactive visualizations
library(isoband) # for find contour lines coordinates
# Simulate the data for plotting
x <- y <- seq(from = 0, to = 100, by = 1)
z1 <- outer(X = x, Y = y, FUN = function(x, y) x^0.2 * y^0.3) # data for surface plot
# Obtain coordinates of contour for z = 5
z_level <- 6
r <- isolines(x = x, # *** WE USE THE isolines() FUNCTION HERE ***
y = y,
z = z1,
levels = z_level)
plot_ly(
type = "surface",
z = z1,
) %>%
add_trace(
type = "scatter3d",
x = r[[1]]$x,
y = r[[1]]$y,
z = z_level
)
I am building a plot with ggplot. I have data where y is mostly independent of X, but I randomly have a few extreme values of Y at low values of X. Like this:
set.seed(1)
X <- rnorm(500, mean=5)
y <- rnorm(500)
y[X < 3] <- sample(c(0, 1000), size=length(y[X < 3]),prob=c(0.9, 0.1),
replace=TRUE)
I want to make the point that the MEDIAN y-value is still constant over X values. I can see that this is basically true here:
mean(y[X < 3])
median(y[X < 3])
If I make a geom_smooth() plot, it does mean, and is very affected by outliers:
ggplot(data=NULL, aes(x=X, y=y)) + geom_smooth()
I have a few potential fixes. For example, I could first use group_by/summarize to make a dataset of binned medians and then plot that. I would rather NOT do this because in my real data I have a lot of facetting and grouping variables, and it would be a lot to keep track of (non-ideal). A lot plot definitely looks better, but log does not have nice interpretation in my application (median does have nice interpretation)
ggplot(data=NULL, aes(x=X, y=y)) + geom_smooth() +
scale_y_log10()
Finally, I know about geom_quantile but I think I'm using it wrong. Is there a way to add an error bar? Also- this geom_quantile plot looks way too smooth, and I don't understand why it is sloping down. Am I using it wrong?
ggplot(data=NULL, aes(x=X, y=y)) +
geom_quantile(quantiles=c(0.5))
I realize that this problem probably has a LOT of workarounds, but if possible I would love to use geom_smooth and just provide an argument that tells it to use a median. I want geom_smooth for a side-by-side comparison with consistency. I want to put the mean and median geom_smooths side-by-side to show "hey look, super strong pattern between Y and X is driven by a few large outliers, if we look only at median the pattern disappears".
Thanks!!
You can create your own method to use in geom_smooth. As long as you have a function that produces an object on which the predict generic works to take a data frame with a column called x and translate into appropriate values of y.
As an example, let's create a simple model that interpolates along a running median. We wrap it in its own class and give it its own predict method:
rolling_median <- function(formula, data, n_roll = 11, ...) {
x <- data$x[order(data$x)]
y <- data$y[order(data$x)]
y <- zoo::rollmedian(y, n_roll, na.pad = TRUE)
structure(list(x = x, y = y, f = approxfun(x, y)), class = "rollmed")
}
predict.rollmed <- function(mod, newdata, ...) {
setNames(mod$f(newdata$x), newdata$x)
}
Now we can use our method in geom_smooth:
ggplot(data = NULL, aes(x = X, y = y)) +
geom_smooth(formula = y ~ x, method = "rolling_median", se = FALSE)
Now of course, this doesn't look very "flat", but it is way flatter than the line calculated by the loess method of the standard geom_smooth() :
ggplot(data = NULL, aes(x = X, y = y)) +
geom_smooth(formula = y ~ x, color = "red", se = FALSE) +
geom_smooth(formula = y ~ x, method = "rolling_median", se = FALSE)
Now, I understand that this is not the same thing as "regressing on the median", so you may wish to explore different methods, but if you want to get geom_smooth to plot them, this is how you can go about it. Note that if you want standard errors, you will need to have your predict function return a list with members called fit and se.fit
Here's a modification of #Allan's answer that uses a fixed x window rather than a fixed number of points. This is useful for irregular time series and series with multiple observations at the same time (x value). It uses a loop so it's not very efficient and will be slow for larger data sets.
# running median with time window
library(dplyr)
library(ggplot2)
library(zoo)
# some irregular and skewed data
set.seed(1)
x <- seq(2000, 2020, length.out = 400) # normal time series, gives same result for both methods
x <- sort(rep(runif(40, min = 2000, max = 2020), 10)) # irregular and repeated time series
y <- exp(runif(length(x), min = -1, max = 3))
data <- data.frame(x = x, y = y)
# ggplot(data) + geom_point(aes(x = x, y = y))
# 2 year window
xwindow <- 2
nwindow <- xwindow * length(x) / 20 - 1
# rolling median
rolling_median <- function(formula, data, n_roll = 11, ...) {
x <- data$x[order(data$x)]
y <- data$y[order(data$x)]
y <- zoo::rollmedian(y, n_roll, na.pad = TRUE)
structure(list(x = x, y = y, f = approxfun(x, y)), class = "rollmed")
}
predict.rollmed <- function(mod, newdata, ...) {
setNames(mod$f(newdata$x), newdata$x)
}
# rolling time window median
rolling_median2 <- function(formula, data, xwindow = 2, ...) {
x <- data$x[order(data$x)]
y <- data$y[order(data$x)]
ys <- rep(NA, length(x)) # for the smoothed y values
xs <- setdiff(unique(x), NA) # the unique x values
i <- 1 # for testing
for (i in seq_along(xs)){
j <- xs[i] - xwindow/2 < x & x < xs[i] + xwindow/2 # x points in this window
ys[x == xs[i]] <- median(y[j], na.rm = TRUE) # y median over this window
}
y <- ys
structure(list(x = x, y = y, f = approxfun(x, y)), class = "rollmed2")
}
predict.rollmed2 <- function(mod, newdata, ...) {
setNames(mod$f(newdata$x), newdata$x)
}
# plot smooth
ggplot(data) +
geom_point(aes(x = x, y = y)) +
geom_smooth(aes(x = x, y = y, colour = "nwindow"), formula = y ~ x, method = "rolling_median", se = FALSE, method.args = list(n_roll = nwindow)) +
geom_smooth(aes(x = x, y = y, colour = "xwindow"), formula = y ~ x, method = "rolling_median2", se = FALSE, method.args = list(xwindow = xwindow))
Created on 2022-01-05 by the reprex package (v2.0.1)