I am using R to visualize some data. I am found RGL to be a great library for plotting points.
points3d(x,y,z)
where x = c(x1,x2, ...), y = c(y1,y2,...), z = c(z1,z2, ...) and x,y,z have the same length, is a great function for plotting large sets of data.
Now, I would like to plot ellipses, mixed in with the data. I have a characterization of ellipses by a center point C, a vector describing the major axis U, and a vector describing the minor axis V. I obtain points P on the boundary of the ellipse by
P = U*cos(t) + V*sin(t) (t ranges between 0 and 2*pi)
obtaining vectors, xt, yt, and zt. Then I can plot the ellipse with
polygon3d(xt,yt,zt)
It works fine, but I'm guessing everyone reading is cringing, and will tell me that this is a bad way to do this. Indeed it takes a couple seconds to render each ellipse this way.
I don't think the ellipse3d function from the RGL package works here; at the very least, I am not working a matrix of covariances, nor do I understand how to get the ellipse I want from this function. Also, it returns an ellipsoid, not an ellipse.
****** EDIT ************
For a concrete example that takes awhile:
library(rgl)
open3d()
td <- c(0:359)
t <- td*pi/180
plotEllipseFromVector <- function(c,u,v){
xt <- c[1] + u[1]*cos(t) + v[1]*sin(t)
yt <- c[2] + u[2]*cos(t) + v[2]*sin(t)
zt <- c[3] + u[3]*cos(t) + v[3]*sin(t)
polygon3d(xt,yt,zt)
}
Input center point, major, and minor axis you want. It takes just over 2 seconds for me.
On the other hand, if I change t to be 0,20,40,... 340, then it works quite fast.
Related
lets say I have 3 binary points (5,0),(0,5),(-5,0) and I want to find a point equidistant from those 3 point (in short find center of the circle passing through those 3 points). I know from geometry that if my answer is (a,b) then I can find distance between the (a,b) and 3 points and equate them and then solve 3 simultaneous equations. How can I quickly do this in R? I know equations will be linear and all square terms will cancel out.
_____________________________update1
I tried searching google for how to solve linear equations in R. But didnt get good results as all the links expect me to provide LHS coefficients and RHS value for all 3 equations. But I dont have RHS. I have to take 2 equations at a time and move terms to find RHS. Is there any R package that will do this for me?
You've probably moved on from now, but I'm going to add to this thread for posterity sake. I suppose people were just mad that you didn't pose an attempt? I stumbled upon this post looking for help and some of the respondents up there were completely unhelpful. I tried your approach with not much success for my application and wrote the following function, circlefit(), to perform a least squares approximation of the points along the arc if supplied a dataframe with column 1= X, and column2=Y. I'm pretty sure that the code above failed in my application because I had >100 of points along a "fuzzy" edge so my application was more attuned to a least squares approach.
cheers!
x_x<-c(0,0.5, 1, 1.5, 2, 2.5, 3)
y_x<-c(0,.25, 1, 2.25, 4, 6.25, 9)
df<-as.data.frame(cbind(x_x, y_x))
circlefit<-function (df){
names(df)<-c("X", "Y")
#find mean x y so we can cacluate the difference of each X, Y from its respective mean
xmean<-mean(df$X)
ymean<-mean(df$Y)
#adds needed columns for summations required to perform least squares
mat2<-df%>%
mutate(a=X-xmean)%>%
mutate(b=Y-ymean)%>%
mutate(aa=a^2)%>%
mutate(ab=a*b)%>%
mutate(bb=b^2)%>%
mutate(aaa=a^3)%>%
mutate(abb=a*b^2)%>%
mutate(baa=b*a^2)%>%
mutate(bbb=b^3)
#column sums for construction of linear system of equations
Saa<-sum(mat2$aa)
Sab<-sum(mat2$ab)
Sbb<-sum(mat2$bb)
Saaa<-sum(mat2$aaa)
Sbbb<-sum(mat2$bbb)
Sabb<-sum(mat2$abb)
Sbaa<-sum(mat2$baa)
#linear stystem of equations
sums_row1<-c(Saa, Sab)
sums_row2<-c(Sab, Sbb)
sum_mat<-as.matrix(rbind(sums_row1, sums_row2), nrow=2)
#gauss elimination ratio
gauss_ratio<-sum_mat[1,2]/sum_mat[1,1]
#new eliminated row
elim_row2<-sums_row2-(sums_row1*gauss_ratio)
#initial (A,B)
Ac<-0.5*(Saaa+Sabb)
Bc<-0.5*(Sbbb+Sbaa)
#result of Bc after elimination
elim_Bc<-Bc-(gauss_ratio*Ac)
#final deviation of (A, B) from mean
fin_Bc<-elim_Bc/elim_row2[2]
fin_Ac<-(Ac-(fin_Bc*sum_mat[1,2]))/sum_mat[1,1]
#center of least squares fit of circle (xc,yc)
Xc<-xmean+fin_Ac
yc<-ymean+fin_Bc
alpha<-fin_Ac^2+fin_Bc^2+((Saa+Sbb)/nrow(mat2))
#radius of circle
radius<-sqrt(alpha)
#temporarily stores circle parameters, names them and then puts them in the globalEnv
circle_parms<-c(Xc, yc, radius)
names(circle_parms)<-c("Xc", "Yc", "Radius")
circle_parms<<-circle_parms
#generates a ggplot of the the input data and the approximated circle; puts plot in the globalEnv as circleplot
circleplot<<-ggplot(df, aes(x=X, y=Y))+geom_point()+
geom_point(aes(x=Xc, y=yc), color="Red", size=4)+theme(aspect.ratio = 1)
#defines a circle fit function such that it can be added to the circleplot above; this function is available in globalEnv
gg_circle <<- function(r, xc, yc, color="blue", fill=NA, ...) {
x <- xc + r*cos(seq(0, pi, length.out=100))
ymax <- yc + r*sin(seq(0, pi, length.out=100))
ymin <- yc + r*sin(seq(0, -pi, length.out=100))
annotate("ribbon", x=x, ymin=ymin, ymax=ymax, color=color, fill=fill, ...)
}
#adds the fit circle to the data.
circleplot+gg_circle(r=radius, xc=Xc, yc=yc)
}
circlefit(df)
circle_parms
I used the link that was given in comments. My code is as below
#finding circles center
p3=c(0,5,5,0,-5,0)#coordinates of point in (x1,y1,x2,y2,x3,y3) format
mat1=matrix(c(p3[1]^2+p3[2]^2,p3[2],1,p3[3]^2+p3[4]^2,p3[4],1,p3[5]^2+p3[6]^2,p3[6],1),nrow=3,ncol=3,byrow=TRUE)
mat2=matrix(c(p3[1],p3[1]^2+p3[2]^2,1,p3[3],p3[3]^2+p3[4]^2,1,p3[5],p3[5]^2+p3[6]^2,1),nrow=3,ncol=3,byrow=TRUE)
mat3=matrix(c(p3[1],p3[2],1,p3[3],p3[4],1,p3[5],p3[6],1),nrow=3,ncol=3,byrow=TRUE)
mat1
mat2
mat3
xcenter=det(mat1)/(2*det(mat3))
ycenter=det(mat2)/(2*det(mat3))
radius=sqrt((p3[1]-xcenter)^2+(p3[2]-ycenter)^2)
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.
I am trying to create a figure like the one depicted in the third column of the following image:
Link for the image in case of backup.
Basically I have x and y positions of 200 particles and I have the MSD data for these 200 positions. I'd like MSD to be the value that should determine a color map for the particles in coordinates (x,y). So MSD should be like the height, or the z position corresponding to each particle in (x,y).
I am surprised at my incompetence, because I have been trying to solve this problem for the last couple of days but none of the Google searches gave me any result. The closest thing that I have found is the concept of "self-organizing map" in Matlab and R, but I do not know how to use R and Matlab's toolbox for SOM was utterly useful for my needs.
I tried the following code in Matlab and get the attached plot as a result:
clear all; close all; clc;
x = (dlmread('xdata.dat'))'; % x is 1x200 array
y = (dlmread('ydata.dat'))'; % y is 1x200 array
msd = (dlmread('msd_field.txt'))'; % msd is 1x200 array
[X,Y] = meshgrid(x,y);
Z = meshgrid(msd);
z = [X; Y; Z];
surf(z)
But I think this plot is not useful at all. What I want is a 2D scatter plot of (x,y) depicting particle positions and on top of that color code this scatter plot with the values stored in msd like the plot I showed in the beginning. How can I create this through Matlab, or any other visualization tool? Thank you in advance.
It is not clear whay you want to have. Here a scatter plot using ggplot2.
## some reproducible data
set.seed(1)
dat <- data.frame(
x = round(runif(200,-30,30),2),
y = round(runif(200,-2,30),2),
msd = sample(c(0,2,3),200,rep=T))
## scatter plot where the size/color of points depends in msd
library(ggplot2)
ggplot(dat) +
geom_point(aes(x,y,size=msd,color=msd)) +
theme_bw()
First, this is my first Stack Overflow question so I apologize for violating and decorum. Second, I realize this will be very trivial but I'm stumped. I'm trying to figure out how to find the minimum and maximum gradients on a sigmoidal curve.
I have a function that generates a vector of y values that form a sigmoidal curve:
#function to generate Sigmoid curves - works better with enough Xs to be smooth
genSigmoid = function(a, b, c, theta){
y = c + ((1-c) / (1 + exp(-a*(theta-b))))
return(y)
}
x<-c(1:100)
y<-genSigmoid(.25, .50, 0, x)
plot(x, y, type="n")
lines(x, y)
What I would like to do is find the points along this curve where the gradient is the smallest or zero and the points where the gradient is largest. My ultimate goal is to plot the different sections of this curve with different lines styles according the strength of the gradient along the curve. I can generate these different styles by 'eye-balling' it but it would be nice to have something that can do this more precisely.
You could do this using the grad(...) function in package numDeriv.
genSigmoid = function(theta,pars){
y <- with(pars,c + ((1-c) / (1 + exp(-a*(theta-b)))))
return(y)
}
x<-c(1:100)
pars <- list(a=0.25, b=0.50, c=0.0)
y<-genSigmoid(x, pars)
plot(x, y, type="l", ylim=c(0,1), col="blue")
library(numDeriv)
z<-grad(genSigmoid,x,pars=pars)
lines(x,z,col="red")
Here z is a vector of the derivative of genSigmoid(...) with respect to theta.
I redefined your function a bit to make the calling sequence simpler (combined the parameters into a named list, and reversed the order of the arguments).
Plotting segments of the curve with different line styles is a bit trickier:
lt <- as.integer(3*(z-min(z))/diff(range(z))+1)
df <- data.frame(x,y,z,lt)
plot(x,y,type="n")
lapply(split(df,df$lt),function(df)with(df,lines(x,y,lty=lt)))
So this creates a vector of line types (1,2,3, or 4) based on the value of the derivative, then splits the data based on line type, and plots the segments.
Basically I have lists with 2 matrices (u and v) containing the windspeed in longitudal and latitudal direction (and vectors x and y containing the coordinates). I would like to make a map with arrows pointing in the resulting direction, of which the size is proportional to the wind speed. This question was asked before: http://www.mail-archive.com/r-help#r-project.org/msg18875.html.
Uforunately, the link given in the answer is broken. I tried using the quiver function, but I don't get it working.
Here is how my data looks like:
x=seq(10,15,by=0.25)
y=seq(40,50,by=0.25)
u=matrix(runif(length(x)*length(y),-2,3),nrow=length(y),ncol=length(y))
v=matrix(runif(length(x)*length(y),-2,3),nrow=length(y),ncol=length(y))
wind=list(u,v)
For the quiver function:
library(pracma)
quiver(x=x, y=y, u=wind[[1]], v=wind[[2]])
Which gives twice:
Error: invalid graphics state
I assume that u and v are wrong and need to be coordinates as well, but I honestly don't understand the explanation given in the package discription (u, v : x,y-coordinates of start points).
I saw that more info is available for quiver in matlab or python, but I never worked with that, so any advice about doing this in R would be greatly appreciated.
x=seq(10,15,by=0.25)
y=seq(40,50,by=0.25)
u=matrix(runif(length(x)*length(y),-2,3),nrow=length(x),ncol=length(y))
v=matrix(runif(length(x)*length(y),-2,3),nrow=length(x),ncol=length(y))
#note that I corrected these
#melt for plotting
library(reshape2)
u <- melt(u,value.name = "u")
v <- melt(v,value.name = "v")
wind <- merge(u, v)
wind$x <- x[wind[,1]]
wind$y <- y[wind[,2]]
#plot
library(ggplot2)
library(grid)
scaler <- 1
p <- ggplot(wind, aes(x=x, y=y, xend=x+u*scaler, yend=y+v*scaler)) + geom_segment(arrow=arrow())
print(p)