I am using the filled.contour3 function in the mannner described here. My code is like this
plot.new()
par(mfrow = c(3,3))
pop_x <- 3.0
pop_y <- 6.0
for (i in 1:9){
b_x <- calc_b_x(i)
b_y <- calc_b_y(i)
x <- calc_x(i)
y <- calc_y(i)
z <- calc_z(i)
filled.contour3(x, y, z)
text(x = pop_x, y = pop_y , 'x', cex = 1.5, font = 2)
text(x = b_x, y = b_y , 'a', cex = 1.5, font = 2)
}
This successfully plots 9 graphs in 3 rows. It also puts one 'x' on each graph in the correct position. However the second text call ends up putting 9 'a's on each plot, each in right position. But I only on want one 'a' on each graph, in the correct position for that graph. How do I fix this?
It turns out it was not a problem with filled.contour3. The b_x and b_y were mistakenly vectors rather than scalars, so a single call to
text(x = b_x, y = b_y , 'a', cex = 1.5, font = 2)
produced many points.
Related
So I have this code that produces the exact surface
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
plot3d(f, col = colorRampPalette(c("blue", "white")),
xlab = "X", ylab = "Y", zlab = "Z",
xlim = c(-3, 3), ylim = c(-3, 3),
aspect = c(1, 1, 0.5))
Giving the following plot:
Now I have some code that does a random walk metropolis algorithm to reproduce the above image. I think it works as if I do another plot of these calculated values I get the next image with 500 points. Here is the code
open3d()
plot3d(x0, y0, f(x0, y0), type = "p")
Which gives the following plot:
I know it's hard looking at this still image but being able to rotate the sampling is working.
Now here is my question: How can I use plot3d() so that I can have a surface that connects all these points and gives a more jagged representation of the exact plot? Or how can I have each point in the z axis as a bar from the xy plane? I just want something more 3 dimensional than points and I can't find how to do this.
Thanks for your help
You can do this by triangulating the surface. You don't give us your actual data, but I can create some similar data using
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
x <- runif(500, -3, 3)
y <- runif(500, -3, 3)
z <- f(x, y)
Then the plotting is done using the method in ?persp3d.deldir:
library(deldir)
library(rgl)
col <- colorRampPalette(c("blue", "white"))(20)[1 + round(19*(z - min(z))/diff(range(z)))]
dxyz <- deldir::deldir(x, y, z = z, suppressMsge = TRUE)
persp3d(dxyz, col = col, front = "lines", back = "lines")
This might need some cosmetic fixes, e.g.
aspect3d(2, 2, 1)
After some rotation, this gives me the following plot:
I'm not sure to understand what you want. If my understanding is correct, here is a solution. Define a parametric representation of your surface:
fx <- function(u,v) u
fy <- function(u,v) v
fz <- function(u,v){
((u^2)+(3*v^2))*exp(-(u^2)-(v^2))
}
Let's say you have these points:
x0 <- seq(-3, 3, length.out = 20)
y0 <- seq(-3, 3, length.out = 20)
Then you can use the function parametric3d of the misc3d package, with the option fill=FALSE to get a wireframe:
library(misc3d)
parametric3d(fx, fy, fz, u=x0, v=y0,
color="blue", fill = FALSE)
Is it what you want?
To get some vertical bars, use the function segments3d of rgl:
i <- 8
bar <- rbind(c(x0[i],y0[i],0),c(x0[i],y0[i],f(x0[i],y0[i])))
segments3d(bar, color="red")
Here is a plot with only 50 points using my original code.
When I then apply what was said by Stéphane Laurent I then get this plot which feels too accurate when given the actual points I have
Perhaps you need to explain to me what is actually happening in the function parametric3d
So I came across this answer here, and my question is, if I have three variables and I want to use the x and y to create bins, like using cut and table in the other answer, how can I then graph the z as the average of all the variable Z data that falls into those bins?
This what I have:
library(plot3D)
x <- data$OPEXMKUP_PT_1d
y <- data$prod_opex
z <- data$ab90_ROIC_wogw3
x_c <- cut(x, 20)
y_c <- cut(y, 20)
cutup <- table(x_c, y_c)
mat <- data.frame(cutup)
hist3D(z = cutup, border="black", bty ="g",
main = "Data", xlab = "Markup",
ylab ="Omega", zlab = "Star")
But it show the z as the frequency, and when I try,
hist3D(x, y, z, phi = 0, bty = "g", type = "h", main = 'NEWer',
ticktype = "detailed", pch = 19, cex = 0.5,
xlim=c(0,3),
ylim=c(-10,20),
zlim=c(0,1))
It thinks for a long time and throws an error,
Error: protect(): protection stack overflow
Graphics error: Plot rendering error
It will do the 3d scatter fine but the data doesn't make sense since the Z variable is a ratio that falls mostly between 0 and 1, so you get a bunch of tall lines and and a bunch of short lines. I would like them averaged by bin to show a visual of how the average ratio changes as x and y change. Please let me know if there is a way to do this.
Not sure exactly what your data looks like, so I made some up. You should be able to adjust to your needs. It's a bit hacky/brute force-ish, but could work just fine if your data isn't too large to slow down the loop.
library(plot3D)
# Fake it til you make it
n = 5000
x = runif(n)
y = runif(n)
z = x + 2*y + sin(x*2*pi)
# Divide into bins
x_c = cut(x, 20)
y_c = cut(y, 20)
x_l = levels(x_c)
y_l = levels(y_c)
# Compute the mean of z within each x,y bin
z_p = matrix(0, 20, 20)
for (i in 1:length(x_l)){
for (j in 1:length(y_l)){
z_p[i,j] = mean(z[x_c %in% x_l[i] & y_c %in% y_l[j]])
}
}
# Get the middle of each bin
x_p = sapply(strsplit(gsub('\\(|]', '', x_l), ','), function(x) mean(as.numeric(x)))
y_p = sapply(strsplit(gsub('\\(|]', '', y_l), ','), function(x) mean(as.numeric(x)))
# Plot
hist3D(x_p, y_p, z_p, bty = "g", type = "h", main = 'NEWer',
ticktype = "detailed", pch = 19, cex = 0.5)
Basically, we're just manually computing the average bin height z by looping over the bins. There may be a better way to do the computation.
I have data-frame DOTS with following columns: DOT, X, Y. There are 10 dots.
I want to display all possible connections: (a) between dots 1,2,3,4,5; (b) 5,6,7; and (c) between 7,8,9,10?
# what I tried so far
plot(DOTS$X, DOTS$Y, main= "DOTS", xlab= "X", ylab= "Y",
col= "blue", pch = 19, cex = 1, lty = "solid", lwd = 2)
text(DOTS$X, DOTS$Y, labels=DOTS$Dot, cex= 0.7, pos = 3)
lines(DOTS$X,DOTS$Y)
# the last line displays connection from 1 to 2 to 3 etc only
Thank you in advance for your suggestions.
I make a dataset first :
x <- runif(10, 0, 10)
y <- runif(10, 0, 10)
df <- data.frame(dot = LETTERS[1:10], x = x, y = y)
I think it's flexible to create a custom function and use combn() to generate all possible combinations of two dots. And then connect them with segments() respectively. In the custom function below, you can put any dots set and arguments e.g. col, lwd... etc.
plot(df$x, df$y)
text(df$x, df$y, labels = df$dot, pos = 3)
line.fun <- function(index, ...){
comb <- combn(index, 2)
start <- comb[1, ] # starting points
end <- comb[2, ] # end points
segments(df$x[start], df$y[start], df$x[end], df$y[end], ...)
}
line.fun(1:5, col = 2)
line.fun(5:7, col = 3)
line.fun(7:10, col = 4)
Background
I have a function called TPN. When you run this function, it produces two plots (see picture below). The bottom-row plot samples from the top-row plot.
Question
I'm wondering how I could fix the ylim of the bottom-row plot to be always (i.e., regardless of the input values) the same as ylim of the top-row plot?
R code is provided below the picture (Run the entire block of code).
############## Input Values #################
TPN = function( each.sub.pop.n = 150,
sub.pop.means = 20:10,
predict.range = 10:0,
sub.pop.sd = .75,
n.sample = 2 ) {
#############################################
par( mar = c(2, 4.1, 2.1, 2.1) )
m = matrix( c(1, 2), nrow = 2, ncol = 1 ); layout(m)
set.seed(2460986)
Vec.rnorm <- Vectorize(function(n, mean, sd) rnorm(n, mean, sd), 'mean')
y <- c( Vec.rnorm(each.sub.pop.n, sub.pop.means, sub.pop.sd) )
set.seed(NULL)
x <- rep(predict.range, each = each.sub.pop.n)
plot(x, y) ## Plot #1
sample <- lapply(split(y, x), function(z) sample(z, n.sample, replace = TRUE))
sample <- data.frame(y = unlist(sample),
x = as.numeric(rep(names(sample), each = n.sample)))
plot(sample$x, sample$y) ## Plot # 2
}
## TEST HERE:
TPN()
You can get the ylim using par("yaxp")[1:2]. So, you can change the second plot code to have its ylim as the first plot's:
plot(sample$x, sample$y, ylim = par("yaxp")[1:2]) ## Plot # 2
or as mentioned in the comments, you can simply set the ylim for both plots to be range of both data-sets and add that to both plots:
ylim = range(c(y, sample$y))
Another option: Produce the same plot again but with type = "n" and then filling the points with points(). For example, change your plot 2 to
plot(x, y, type = "n")
points(sample$x, sample$y)
A benefit of this approach is that everything in the plot will be exactly the same, not just the y-axis (which may or may not matter for your function).
I am producing a color density scatterplot in R using the smoothScatter() function.
Example:
## A largish data set
n <- 10000
x1 <- matrix(rnorm(n), ncol = 2)
x2 <- matrix(rnorm(n, mean = 3, sd = 1.5), ncol = 2)
x <- rbind(x1, x2)
oldpar <- par(mfrow = c(2, 2))
smoothScatter(x, nrpoints = 0)
Output:
The issue I am having is that I am unsure how to add a legend/color scale that describes the relative difference in numeric terms between different shades. For example, there is no way to tell whether the darkest blue in the figure above is 2 times, 10 times or 100 times as dense as the lightest blue without some sort of legend or color scale. Is there any way in R to retrieve the requisite information to make such a scale, or anything built in that can produce a color scale of this nature automatically?
Here is an answer that relies on fields::imageplot and some fiddling with par(mar) to get the margins correct
fudgeit <- function(){
xm <- get('xm', envir = parent.frame(1))
ym <- get('ym', envir = parent.frame(1))
z <- get('dens', envir = parent.frame(1))
colramp <- get('colramp', parent.frame(1))
fields::image.plot(xm,ym,z, col = colramp(256), legend.only = T, add =F)
}
par(mar = c(5,4,4,5) + .1)
smoothScatter(x, nrpoints = 0, postPlotHook = fudgeit)
You can fiddle around with image.plot to get what you want and look at ?bkde2D and the transformation argument to smoothScatter to get an idea of what the colours represent.