I use R code below to build bubble chart.
pdf(file='myfigure.pdf',height=10,width=13)
y<-c(123,92,104,23,17,89,13)
x<-c(11,45,24,50,18,7,2)
size<-c(1236,1067,1176,610,539,864,1026)
radius<-sqrt(size/pi)
col<-c(2,2,3,4,5,5,6)
name<-c("Acura", "Alfa Romeo","AM General","Aston Martin Lagonda","Audi","BMW","Bugatti")
symbols(x,y, circles=radius,fg="white",bg=col,ylim=c(-20,140))
text(x, y, name, cex=1.5,font=4)
dev.off()
But I want the bubbles with 3d surface, say gradient fills and shadow. like the chart below.
Anyone knows how to use R to release it? Thanks!
Thanks for all the suggestions.While finally I tried a silly way by drawing multiple circles from dark to light to make it gradient filled. Any suggestions to make it better? Thanks!
makeTransparent<-function(someColor, alpha)
{
newColor<-col2rgb(someColor)
apply(newColor, 2, function(curcoldata){rgb(red=curcoldata[1], green=curcoldata[2], blue=curcoldata[3],alpha=alpha,maxColorValue=255)})
}
pdf(file='myfigure.pdf',height=10,width=13)
y<-c(123,92,104,23,17,89,13)
x<-c(11,45,24,50,18,7,2)
size<-c(1236,1067,1176,610,539,864,1026)
radius<-sqrt(size/pi)
col<-c(2,2,3,4,5,5,6)
name<-c("Acura", "Alfa Romeo","AM General","Aston Martin Lagonda","Audi","BMW","Bugatti")
x2<-c()
y2<-c()
circles<-c()
bg<-c()
fg<-c()
num<-30
radius_min<-0.3
alpha_min<-40
alpha_max<-180
for (i in 1:num){
x2<-c(x2,x)
y2<-c(y2,y)
circles<-c(circles,radius*(radius_min+(i-1)*(1-radius_min)/num))
bg<-c(bg,makeTransparent(col,alpha=alpha_max-(i-1)*(alpha_max-alpha_min)/num))
if(i!=num){fg<-c(fg,makeTransparent(col,alpha=alpha_max-(i-1)*(alpha_max-alpha_min)/num))}else{fg<-c(fg,rep('white',length(x)))}
}
symbols(x2,y2,circles=circles,fg=fg,bg=bg)
text(x, y, name, cex=1.5,font=4)
dev.off()
Here is a solution (inspired by #Edward's solution for this question):
#First your data:
y<-c(123,92,104,23,17,89,13)
x<-c(11,45,24,50,18,7,2)
size<-c(1236,1067,1176,610,539,864,1026)
radius<-sqrt(size/pi)
col<-c(2,2,3,4,5,5,6)
name<-c("Acura", "Alfa Romeo","AM General","Aston Martin Lagonda","Audi","BMW","Bugatti")
#Then a simple function to draw a circle based on its center and its radius:
circle <- function (r, x0, y0, col){
t <- seq(0, 2 * pi, by = 0.01)
x <- r * cos(t) + x0
y <- r * sin(t) + y0
lines(x, y, col=col)
}
#This is a smoothing factor:
sm <- 500
#The asp parameter is important here since we are actually drawing the circles and not plotting some circle symbols: if asp is not equal to 1 they will appear as ellipse.
plot(x,y,type="n",asp=1)
#This can probably be vectorized but I'm not a good vectorizer so if anyone wants to give it a try:
for(j in 1:length(x)){
radius[j]*sm:1/sm -> radiuses
colorRampPalette(c(palette()[col[j]], "white"))->col_grad
col_grad(length(radiuses))->colx
for(i in 1:length(radiuses)){circle(radiuses[i], x[j], y[j], col=colx[i])}
}
text(x, y, name, cex=1.5,font=4)
See ?colorRampPalette for more information on how this function works.
Edit: with shadows
offset<-c(2,-2) #Offset of the shadow circles
library(scales) #For function alpha
plot(x,y,type="n",asp=1)
for(j in 1:length(x)){
radius[j]*sm:1/sm -> radiuses
colorRampPalette(c(palette()[col[j]], "white"))->col_grad
col_grad(length(radiuses))->colx
for(i in 1:length(radiuses)){circle(radiuses[i], x[j]+offset[1], y[j]+offset[2], col=alpha("grey90",0.1))} #the alpha, the nuance of grey can be tweaked with obviously for the desired effect
for(i in 1:length(radiuses)){circle(radiuses[i], x[j], y[j], col=colx[i])}
}
text(x, y, name, cex=1.5,font=4)
Related
I want to plot a univariate normal density function of the normal distribution onto a (x,y,z) coordinate system.
The code I am using is:
library(rgl)
open3d()
x <- seq(0, 10, length=100)
y <- seq(0, 10, length=100)
z = outer(x,y, function(x,y) dnorm(x,2.5,1)*dnorm(y,2.5,1))
persp3d(x, y, z,col = rainbow(100))
The problem I an encountering is that I want the normal distribution not to be around its mean only but also to be on a straight line or a circle. In latter case, I would expect the output to be similar to a volcano. I guess I must first create some probabilities within a loop. How can I do this? Or should I also use some surface command to plot the output? I am pretty sure this has nothing to do with a bivariate normal though.
Best
Fuji
The first part is easy: just don't let your z depend on y for instance:
z = outer(x,y, function(x,y) dnorm(x,2.5,1))
persp3d(x, y, z,col = rainbow(100))
For the second part, you can imagine that the means of the normal distribution lie on the x^2+y^2=1 circle. You will have infinite normal distributions with radial directions. Try this:
#define the volcano function
volcano<-function(x,y,sigma=1/2) {
alpha<-atan(y/x)+pi*(x<0)
d<-sqrt((cos(alpha)-x)^2 + (sin(alpha)-y)^2)
dnorm(d,0,sigma)
}
x<-seq(-2,2,length.out=100)
y<-seq(-2,2,length.out=100)
z<-outer(x,y,volcano)
persp3d(x, y, z,col = rainbow(100))
I want to create 50 concentric circles. I did it with python but now I want to do this in R. I have tried the symbols function but with no result. I want my circles to start from x,y coordinates and the radius of each circle to be 3times bigger than the previous.
step=1
for(i in seq(1,50,1)){
symbols (x, y, circles=50, col="grey")
step=step+3
}
From this I get one circle as a result.
I am new in programming so it is probably very simple. Should I use a specific package?
The beauty of R is that many things can be vectorized, including the imput to the 'symbols' function. Here's an example for you:
#vector of radii
#written in a way that's easily changable
n_circles <- 50
my_circles <- seq(1,by=1,length.out = n_circles)
#generate x and y
x <- rep(1,n_circles)
y <- rep(1, n_circles)
#plot
symbols(x,y,1:n_circles)
I'm trying to make a 3D scatterplot with boudaries or zones based on combinations of 3 variables that return certain values. The variables each range between 0:1, and combine to make an index that ranges from -1:1 as follows:
f(x,y,z) = (x*y)-z
I'd like to create a visual representation that will highlight all combinations of variables that return a certain index value. As an example, I can easily show those variables where index > 0 using scatterplot3d (rgl would also work):
# Create imaginary dataset of 50 observations for each variable
x<-runif(50,0,1)
y<-runif(50,0,1)
z<-runif(50,0,1)
# Create subset where f(x,y,z) > 0
x1<-y1<-z1<-1
for (i in 1:length(x)){ if ((x[i]*y[i])-z[i] > 0) {
x1<-rbind(x1, x[i])
y1<-rbind(y1, y[i])
z1<-rbind(z1, z[i])}
}
s3d<-scatterplot3d(x,y,z) # Plot entire dataset
s3d$points3d(x1,y1,z1,pch=19, col="red") # Highlight subset where f(x,y,z) > 0
This gives me the following graph:
It seems fairly intuitive that there should be an easy way to plot either the surface (extending from top/right/back to bottom/left/front) separating the subset from the rest of the data, or else a volume/3D area within which these plots lie. E.g. my first instinct was to use something like surface3d, persp3d or planes3d. However, all attempts so far have only yielded error messages. Most solutions seem to use some form of z<-lm(y~x) but I obviously need something like q<-func((x*y)-z) for all values of x, y and z that yield q > 0.
I know I could calculate extreme points and use them as vertices for a 3D polygon, but that seems too "manual". It feels like I'm overlooking something fairly simple and obvious. I've looked at many similar questions on Stack but can't seem to find one that fits my particular problem. If I've missed any and this question has been answered already, please do point me in the right direction!
Here is a suggestion for an interactive 3D plot that is based on an example from the "R Graphics Cookbook" by Winston Chang.
set.seed(4321)
library(rgl)
interleave <- function(v1,v2) as.vector(rbind(v1,v2))
x <- runif(50)
y <- runif(50)
z <- runif(50)
plot3d(x, y, z, type="s", size=0.6, col=(2+(x*y<z)))
x0 <- y0 <- seq(0, 1, 0.1)
surface3d(x0, y0, outer(x0, y0), alpha=0.4) #plot the surface f(x,y)=x*y
x1 <- x[x * y > z] #select subset that is below the separating surface
y1 <- y[x * y > z]
z1 <- z[x * y > z]
segments3d(interleave(x1, x1), #highlight the distance of the points below the surface
interleave(y1, y1),
interleave(x1 * y1, z1), col="red", alpha=0.4)
If you don't like the red lines and only want the surface and the colored points, this will be sufficient:
plot3d(x,y,z,type="s",size=0.6,col=(2+(x*y<z)))
x0 <- y0 <- seq(0,1,0.1)
surface3d(x0,y0,outer(x0,y0),alpha=0.4)
Does this representation provide the information that you wanted to highlight?
The first thought was to see if the existing functions within scatterplot3d could handle the problem but I think not:
my.lm <- lm(z ~ I(x) * I(y)+0)
s3d$plane3d(my.lm, lty.box = "solid", col="red")
pkg:scatterplot3d doesn't really have a surface3d function so you will need to choose a package that provides that capability; say 'rgl', 'lattice', or 'plot3d'. Any of them should provide the needed facilities.
Recently I stumbled over the rgl-Package in R, which can be used to create interactive 3d plots. Now I want to visualize a set of boxes in one 3d plot. A Box B has cartesian coordinates B_coord=[x,y,z], which correspond to the lower left back corner and dimensions B_dim=[x1,y1,z1].
Apparently it is easy to draw, scale and position some cubes with the following exemplary code:
open3d()
printBox <- function(x,y,z,x1,y1,z1) {
mycube <- scale3d(cube3d(),x1,y1,z1)
wire3d(translate3d(mycube,x,y,z))
}
printBox(0,0,0,1,1,1)
With this code the boxes are moved to x,y,z and scaled to x1,y1,z1. My question is how to write a similar function with the same input which positions the boxes by the coordinates of their lower left back corner and draws a box with the dimensions x1, y1, z1. I am not tied to the rgl package and R, but I like its interactive 3d view.
Thank you for your ideas!
I think your code already does that. So as to make it more clear, and explain what those rgl functions do, I unrolled your function and commented it and put it in a more illustrative example.
library(rgl)
open3d()
# create and plot a box at (x,y,z) of size (x1,y1,z1)
printBox <- function(x, y, z, x1, y1, z1) {
mycube <- cube3d() # create a cube as mesh object
mycube <- scale3d(mycube, x1, y1, z1) # now scale that object by x1,y1,z1
mycube <- translate3d(mycube, x, y, z) # now move it to x,y,z
wire3d(mycube) # now plot it to rgl as a wireframe
}
# Display 5 boxes along a diagonal line
n <- 5
for (i in 1:n) {
x <- i/n
y <- i/n
z <- i/n
sz <- 1/(2*n)
printBox(x, y, z, sz,sz,sz )
}
axes3d() # add some axes
I am trying to shade under curve (contrast to y direction in this post). Just the following is hypothesis of filling direction.
curve(dnorm(x,0,1),xlim=c(-3,3),main='Standard Normal')
I am trying to write a function, where I can fill very small polygons with different colors ( I do not know if this is right approach), then it will look like gradient.
The idea is to extend the following filling of single polygon to n polygons.
codx <- c(-3,seq(-3,-2,0.01),-2)
cody <- c(0,dnorm(seq(-3,-2,0.01)),0)
curve(dnorm(x,0,1),xlim=c(-3,3),main='Standard Normal')
polygon(codx,cody,col='red')
I tried to extend it to a function:
x1 <- NULL
y1 <- NULL
polys <- function ( lwt, up, itn) {
x1 <- c(lwt,seq(lwt,up, itn),up)
y1 <- c(0,dnorm(seq(lwt,up,tn)),0)
out <- list (x1, y1)
return (out)
}
out <- polys(lwt = 0, up = 1, itn = 0.1)
library(RColorBrewer)
plotclr <- brewer.pal(10,"YlOrRd")
Neither I could workout the function nor I could brew more colors than 9 this way. Help appreciated.
You can use segments to achieve "roughly" what you want
x <- seq(from=-3, to=3,by=0.01)
curve(dnorm(x,0,1), xlim=c(-3,3))
segments(x, rep(0,length(x)),x,dnorm(x,0,1) , col=heat.colors(length(x)), lwd=2)