I have written a function to calculate the BMI and have the code to create a corresponding graphical output. My goal is to include the graphical output into the function so that I get the plot by just using the function.
My current code:
BMI <- function(meter, kg){
BMI <- kg/(meter^2)
return(BMI)
}
BMI(1.8,70)
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
z <- outer(x, y, FUN = function(x, y) {BMI(x, y)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = 70, v=1.8, col="darkgrey")
points(1.8,70, col="red", cex=2, pch=16, bg="red")
By just modifying the meter & kg in the function I would like to get a diagram with the correct line and point positioning. I started with the code below - however it does not work, yet.
graphicalBMI <- function(meter, kg){
BMI <- kg/(meter^2)
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
z <- outer(x, y, FUN = function(x, y) {graphicalBMI(x, y)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = kg, v= meter, col="darkgrey")
points(meter, kg, col="red", cex=2, pch=16, bg="red")
return(graphicalBMI)
}
The problem of your second function is that it produces an infinite-recursion.
If you change it like this you'll get what you want:
graphicalBMI <- function(meter, kg, showPlot=TRUE){
BMI <- kg/(meter^2)
if(showPlot){
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
# here we call graphicalBMI by setting showPlot=F to avoid infinite recursion
z <- outer(x, y, FUN = function(x, y) {graphicalBMI(x, y, FALSE)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = kg, v= meter, col="darkgrey")
points(meter, kg, col="red", cex=2, pch=16, bg="red")
}
return(BMI)
}
# usage example:
graphicalBMI(1.8,70) # plot produced
graphicalBMI(1.8,70,FALSE) # no plot produced
Related
I am trying to plot a function which is dependent on two variables, x and y in a 3D surface plot in r. I get an error message which says that increasing 'x' and 'y' values expected. I am not sure how to arrange the two variables in increasing order which can help produce the plot.
my code:
x <- c(-1, 2, 15, 0, 1, 4, 7, 4, 5, 2)
y <- c(1.5, 3, 7, 2, 1.5, 15, 12, 8, 20, 21)
f <- sqrt(x^2+y^2)
df <- data.frame(x, y, f)
func <- function(x, y){
df$f + (x-x + y-y)}
z <- outer(x, y, func)
persp(x, y, z,
main="Perspective Plot of a function",
zlab = "Height",
theta = 30, phi = 15,
col = "springgreen", shade = 0.5,
ltheta = 120,
ticktype = "detailed")
If you are trying to plot a function of two variables as a surface plot, then you really don't need your two input vectors. You need a regularly spaced grid of input values in both the x and y direction that will cover the range of both inputs:
f <- function(x, y) sqrt(x^2 + y^2)
x <- y <- -1:20
persp(x, y, z = outer(x, y, f),
main="Perspective Plot of a function",
zlab = "Height",
theta = -45, phi = 15,
col = "springgreen", shade = 0.5,
ltheta = 120,
ticktype = "detailed")
Advancing on the answer given here where the same question was asked for a scatter plot, is it possible to plot a line where the colour is based on the y value?
Example data
x = 1:11
y = abs(6 - x)
plot(1:22,c(y,y), col = ifelse(c(y,y) < 2.5, 2, 3), pch = 16)
Will give
However, trying
plot(1:22,c(y,y), col = ifelse(c(y,y) < 2.5, 2, 3), type = "l")
Gives
or doing lines on y<2.5 which gives
instead of the solution I am after, which is
Is there any easy method to do this? This is only a simple case, and I can't manually add each section to my actual data.
Thanks!
Try this
x = 1:11
y = abs(6 - x)
y = c(y,y)
plot(1:22,y, col = ifelse(c(y,y) < 2.5, 2, 3), pch = 16)
for(i in 1:21){
if(y[i]>1.9&& y[i+1]>1.9){
linecolour="green"
} else {
linecolour="red"
}
lines(c((1:22)[i],(1:22)[i+1]),c(y[i],y[i+1]),col=linecolour)
}
Here is a vectorized solution. It is partly based on the answers to this question with the main difference that the function plotted there is a smooth function, unlike this one. This makes a difference when computing the points to plot and their colors.
fun <- function(x) abs(6 - x)
x <- 1:11
y <- fun(x)
X <- c(x, x + 11)
Y <- c(y, y)
n <- length(X)
color <- ifelse((Y[-n] < 2.5) & (Y[-1] < 2.5), 2, 3)
plot(X, Y, col = color, pch = 16)
segments(x0 = X[-n], y0 = Y[-n],
x1 = X[-1], y1 = Y[-1],
col = color, pch = 16)
To remove the points, start with
plot(X, Y, type = "n")
I'd like to plot multiple data sets on this graph but I can't figure out how.
I need to put t, u, v, w on the already functioning xyplot.
library(lattice)
x <- rnorm(250, 5, .5)
y <- rnorm(250, 5, .4)
t <- rnorm(200, 6, .7)
u <- rnorm(200, 6, .6)
v <- rnorm(150, 7, .9)
w <- rnorm(150, 7, .8)
xyplot(y ~ x, xlab="", ylab="",
par.settings = list(axis.line = list(col="transparent")),
panel = function(x, y,t,u,...) {
panel.xyplot(x, y, col=3, pch=16)
panel.rug(x, y, col=8, x.units = rep("snpc", 2), y.units = rep("snpc",
2), ...)})
If you're looking to make a scatter plot of points whose coordinates are defined by (x, y), (t, u), & (v, w), the following should work for you:
df <- data.frame(V1 = c(x, t, v),
V2 = c(y, u, w),
V3 = c(rep("xy", length(x)), rep("tu", length(t)), rep("vw", length(v))))
xyplot(V1 ~ V2, group = V3, data = df,
xlab="", ylab="",
par.settings = list(axis.line = list(col="transparent")),
panel = function(x, y, groups...) {
panel.xyplot(x, y,
col = c("red", "blue", "green"), # change this if you want other colours
pch=16)
panel.rug(x, y, col = 8, x.units = rep("snpc", 2), y.units = rep("snpc", 2))
})
If you're looking to plot them into the chart in some other way, please clarify in your question.
I am trying to visualize a curve for pollination distribution. I am very new to R so please don't be upset by my stupidity.
llim <- 0
ulim <- 6.29
f <- function(x,y) {(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))}
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), llim, ulim)$value
})
}, llim, ulim)
fv <- Vectorize(f)
curve(fv, from=0, to=1000)
And I get:
Error in y^2 : 'y' is missing
I'm not quite sure what you're asking to plot. But I know you want to visualise your scalar function of two arguments.
Here are some approaches. First we define your function.
llim <- 0
ulim <- 6.29
f <- function(x,y) {
(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))
}
From your title I thought of the following. The function defined below intf integrates your function over the square [0,ul] x [0,ul] and return the value. We then vectorise and plot the integral over the square as a function the length of the side of the square.
intf <- function(ul) {
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), 0, ul)$value
})
}, 0, ul)$value
}
fv <- Vectorize(intf)
curve(fv, from=0, to=1000)
If f is a distribution, I guess you can make your (somewhat) nice probability interpretation of this curve. (I.e. ~20 % probability of pollination(?) in the 200 by 200 meter square.)
However, you can also do a contour plot (of the log-transformed values) which illustrate the function we are integrating above:
logf <- function(x, y) log(f(x, y))
x <- y <- seq(llim, ulim, length.out = 100)
contour(x, y, outer(x, y, logf), lwd = 2, drawlabels = FALSE)
You can also plot some profiles of the surface:
plot(1, xlim = c(llim, ulim), ylim = c(0, 0.005), xlab = "x", ylab = "f")
y <- seq(llim, ulim, length.out = 6)
for (i in seq_along(y)) {
tmp <- function(x) f(x, y = y[i])
curve(tmp, llim, ulim, add = TRUE, col = i)
}
legend("topright", lty = 1, col = seq_along(y),
legend = as.expression(paste("y = ",y)))
They need to be modified a bit to make them publication worthy, but you get the idea. Lastly, you can do some 3d plots as others have suggested.
EDIT
As per your comments, you can also do something like this:
# Define the function times radius (this time with general a and b)
# The default of a and b is as before
g <- function(z, a = 5e-6, b = .156812) {
z * (b/(2*pi*a^2*gamma(2/b)))*exp(-(z/a)^b)
}
# A function that integrates g from 0 to Z and rotates
# As g is not dependent on the angle we just multiply by 2pi
intg <- function(Z, ...) {
2*pi*integrate(g, 0, Z, ...)$value
}
# Vectorize the Z argument of intg
gv <- Vectorize(intg, "Z")
# Plot
Z <- seq(0, 1000, length.out = 100)
plot(Z, gv(Z), type = "l", lwd = 2)
lines(Z, gv(Z, a = 5e-5), col = "blue", lwd = 2)
lines(Z, gv(Z, b = .150), col = "red", lwd = 2)
lines(Z, gv(Z, a = 1e-4, b = .2), col = "orange", lwd = 2)
You can then plot the curves for the a and b you want. If either is not specified, the default is used.
Disclaimer: my calculus is rusty and I just did off this top of my head. You should verify that I've done the rotation of the function around the axis properly.
The lattice package has several functions that can help you draw 3 dimensional plots, including wireframe() and persp(). If you prefer not to use a 3d-plot, you can create a contour plot using contour().
Note: I don't know if this is intentional, but your data produces a very large spike in one corner of the plot. This produces a plot that is for all intents flat, with a barely noticable spike in one corner. This is particularly problematic with the contour plot below.
library(lattice)
x <- seq(0, 1000, length.out = 50)
y <- seq(0, 1000, length.out = 50)
First the wire frame plot:
df <- expand.grid(x=x, y=y)
df$z <- with(df, f(x, y))
wireframe(z ~ x * y, data = df)
Next the perspective plot:
dm <- outer(x, y, FUN=f)
persp(x, y, dm)
The contour plot:
contour(x, y, dm)
I would like to do the following
set.seed(1)
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue")
But the grid is too thin so the border dominates (You can confirm it is indeed the border and not the lighting by using border = NA. It turns to blue):
One way to address this is of course to use not so fine of a grid (for example if you change length = 600 to length= 50 it looks very pleasant, and is actually the example in ?persp). But I want the same shape and smooth exactly as this fine grid. I just don't want to draw all of the borders, maybe only 1/5th of them for example (or half which I assume I can customize).
An issue with plotting the smooth shape and then plotting a grid over top of it is that you can see through the shape to the grid on the other side. To address this, you can start by plotting the course grid on top of a white object, meaning you can't see the back side of the grid, saving the result to a file.
x <- seq(-10, 10, length=50)
y <- x
z <- outer(x, y, f)
png("top.png")
print(persp(x, y, z, theta = 30, phi = 30, expand = 0.5, border="black", col="white"))
dev.off()
Then, you can plot smoothed image followed by the grid with all white colors fully transparent.
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
png("bottom.png")
print(persp(x, y, z, theta = 30, phi = 30, expand = 0.5, border="lightblue", col="lightblue"))
dev.off()
par(oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0))
library(png)
top.img <- readPNG("top.png")
top.img[,,4][top.img[,,1] + top.img[,,2] + top.img[,,3] > 2] <- 0
plot.new()
rasterImage(bottom.img, 0, 0, 1, 1)
rasterImage(top.img, 0, 0, 1, 1)
I have got two solutions, but I think both of them are not exactly what you are searching for. I make a line overlay, but it doesn't get overlapped by the surface.
set.seed(1)
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA, shade=0.75, ticktype = "detailed")
par(new=T)
set.seed(1)
x <- seq(-10, 10, length=20)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = NA, border="green")
set.seed(1)
x <- seq(-10, 10, length= 600)
y <- x
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
res <- persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA, shade=0.75, ticktype = "detailed")
library(grDevices)
xlines <- seq(1, length(x), length.out=20)
for(line in xlines){
lines (trans3d(x=x[line], y = y, z = z[line, ], pmat = res), col = 3, lwd=2)
}
ylines <- seq(1, length(y), length.out=20)
for(line in ylines){
lines (trans3d(x=x, y = y[line], z = z[,line], pmat = res), col = 3, lwd=2)
}
Here are two approaches, neither of which are not ideal. You can use NAs to force transparent "lines" onto the surface (Approach 1) or use NAs to get rid of all but the "grid lines" (Approach 2)
Approach 1:
z2 <- z
lin.seq<- seq(10, 600, 10)
z2[lin.seq,] <- NA
z2[,lin.seq] <- NA
persp(x, y, z2, theta = 30, phi = 30, expand = 0.5,
border=NA, col="lightblue", box=TRUE)
You can then overlay plot above on a solid black surface:
# using original example data
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "black", border=NA)
par(new=TRUE)
z2 <- z
lin.seq<- seq(10, 600, 10)
z2[lin.seq,] <- NA
z2[,lin.seq] <- NA
persp(x, y, z2, theta = 30, phi = 30, expand = 0.5,
border=NA, col="lightblue", box=FALSE)
Approach 2:
# using original example data
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA)
z3 <- matrix(ncol=600, nrow=600) # NA matrix
lin.seq <- seq(25, 600, 25) # spacing of "grid lines"
lin.seq <- c(lin.seq, lin.seq-1, lin.seq-2) # to make lines a bit thicker
# replace some NAs on "grid lines" with values from z.
z3[lin.seq,] <- z[lin.seq,]
z3[,lin.seq] <- z[,lin.seq]
par(new=TRUE)
persp(x, y, z3, theta = 30, phi = 30, expand = 0.5,
border=NA, col="black", box=FALSE)