Related
I am analyzing difference scores with polynomial regression in R. Based on [Edwards and Parry's (1993)][1] recommendations I have been trying to combine a persp() plot with a contour() plot. I would also need to plot the first two principal axes on the contour plot. My attempts so far have only provided me with each individual plot, but I don't know how to combine them. An example for the end-result is :
Edwards & Parry (1993) example difference score visualisation
I manage to get the persp() plot just fine. I have also obtained the contour plot. I can't seem to find any way to combine the two. I have managed to make the plot in plotly using the add_surface() option in the pipeline. My problem with the output is that the surface is smooth, and the contourplot lacks the values in the plot. Basically: persp() and contour() are visualised in a way that is extremely similar to the look I'm aiming for, per the example in the source.
My current attempt (in minimalistic code) is as follows:
surface <- function(e, i){
y <- .2*e + .14*i + .08*e^2 + + .1*e*i + .2*i^2
}
e <- i <- seq(-3, 3, length= 20)
y <- outer(e, i, surface)
persp(e, i, y,
xlab = 'Explicit',
ylab = 'Implicit',
zlab = 'Depression',
theta = 45)
contour(e,i,y)
So basically my question is: how can I make a plot like Edwards and Parry (1993) make, with a similar visual style, in R. It does not have to be base-R, I'm happy with any method. I've been stuck on this problem for a week now.
My attempt in plotly (to compare it to my desired end-result) is:
if(!"plotly" %in% installed.packages){install.packages('plotly')}
library(plotly)
plot_ly(z = ~y) %>% add_surface(x = ~e, y= ~i, z= ~y,
contours = list(
z = list(
show=TRUE,
usecolormap=FALSE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
) %>%
layout(
scene=list(
xaxis = list(title = "Explicit"),
yaxis = list(title = "Implicit"),
zaxis = list(title = "Depression")
)
)
[1]: Edwards, J. R., & Parry, M. E. (1993). On the use of polynomial regression as an alternative to difference scores. Academy of Management Journal, 36(6), 1577–1613. https://doi.org/10.2307/256822
I have found an answer and I will share it here. It seems it cannot be done in base-R. But the RSM-package allows for the addition of contour lines to the base of the plot.
In this answer I will give a minimal example of:
the persp() plot
the contour lines in the base
addition of x=y and x=-y axis
calculation and addition of the first and second principal axis
The only thing I could not solve is that the lines now are drawn over the surface. I don't know how to solve it.
library(rsm)
x <- seq(-3,3,by=0.25)
y <- seq(-3,3,by=0.25)
d <- expand.grid(x=x,y=y)
z <- c(data=NA,1089)
b0 = .140; b1 = -.441; b2 = -.154; b3 = .161 ; b4 =-.106; b5 = .168
k=1
for (i in 1:25) {
for (j in 1:25) {
z[k]=b0+b1*x[i]+b2*y[j]+b3*x[i]*x[i]+b4*x[i]*y[j]+ b5*y[j]*y[j]
k=k+1
} }
data.lm <- lm(z~poly(x,y,degree=2),data=d)
res1 <- persp(data.lm,x~y,
zlim=c(-2,max(z)),
xlabs = c('X','Y'),
zlab = 'Z',
contour=list(z="bottom"),
theta=55,
phi=25)
# draw x=y line (lightly dotted)
xy_pos <- matrix(c(-3,-3,3,3),ncol=2,byrow = T)
lines(trans3d(xy_pos[,2], xy_pos[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 3,
col = 'darkgrey')
# draw x=-y line (lightly dotted)
xy_neg <- matrix(c(-3,3,3,-3),ncol=2,byrow = T)
lines(trans3d(xy_neg[,2], xy_neg[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 3,
col = 'darkgrey')
# Find stationary points:
X0 <- (b2*b4 - 2*b1*b5) / (4*b3*b5 - b4^2)
Y0 <- (b1*b4 - 2*b2*b3) / (4*b3*b5 - b4^2)
# First Principal Axis
p11 = (b5-b3+sqrt((b3-b5)^2+b4^2))/b4
p10 = Y0 - p11*X0
Ypaf1 = p10 + p11*x
# plot first principal axis (full line)
xypaf1 <- matrix(c(Ypaf1[1], -3, Ypaf1[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf1[,2], xypaf1[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 1,
col = 'black')
# Second Principal Axis
p21 = (b5-b3-sqrt((b3-b5)^2+b4^2))/b4
p20 = Y0 - p21*X0
Ypaf2 = p20 + p21*x
# plot second principal axis (dashed line)
xypaf2 <- matrix(c(Ypaf2[1], -3, Ypaf2[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf2[,2], xypaf2[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 2,
col = 'black')
I plotted a 3d scatter plot in R using the scatter3d function.
Now, I want to plot the labels on every dot in the 3d scatter, such as every point has its ID next to it i.e., "1", "2" etc..
Here is what I tried:
library("car")
library("rgl")
scatter3d(geometry[,1],geometry[,2],geometry[,3] , surface=FALSE, labels = rownames(geometry), id.n=nrow(geometry))
This tutorial says that adding arguments labels=rownames(geometry), id.n=nrow(geometry) should display the labels on every dot but that did not work.
EDIT:
I uploaded the coordinate file here, you can read it like this
geometry = read.csv("geometry.txt",sep = " ")
colnames(geometry) = c("x","y","z")
EDIT:
Actually, even the example from the tutorial does not label the points and does not produce the plot displayed. There is probably something wrong with the package.
scatter3d(x = sep.l, y = pet.l, z = sep.w,
surface=FALSE, labels = rownames(iris), id.n=nrow(iris))
I can give you a quick fix if you want to use any other function other than scatter3d. This can be achieved using plot3d and text3d function. I have provided the basic code block of how it can be implemented. You can customize it to your needs.
plot3d(geometry[,1],geometry[,2],geometry[,3])
text3d(geometry[,1],geometry[,2],geometry[,3],rownames(geometry))
points3d(geometry[,1],geometry[,2],geometry[,3], size = 5)
After much messing around I got it (I also have the method for plot_ly if you,re interested)
test2 <- cbind(dataSet[,paste(d)],set.final$Groups,test)
X <- test2[,1]
Y <- test2[,2]
Z <- test2[,3]
# 3D plot with the regression plane
scatter3d(x = X, y = Y, z = Z, groups = test2$`set.final$Groups`,
grid = FALSE, fit = "linear",ellipsoid = FALSE, surface=FALSE,
surface.col = c("green", "blue", "red"),
#showLabels(x = x, y = y, z = z, labels=test2$test, method="identify",n = nrow(test2), cex=1, col=carPalette()[1], location=c("lr"))
#labels = test2$test,
id=list(method = "mahal", n = length(test2$test), labels = test2$test)
#id.n=nrow(test2$test)
)
#identify3d(x = X, y = Y, z = Z, labels = test2$test, n = length(test2$test), plot = TRUE, adj = c(-0.1, 0.5), tolerance = 20, buttons = c("right"))
rglwidget()
I have data from several sources describing an y value in a 360 degrees space but I cannot plot them together with a fitted spline on a single polar plot.
Here's some simulated data:
# Data for test
set.seed(35)
sim1 <- cbind(rnorm(6,0),seq(0,359,359/5))
sim2 <- cbind(rnorm(9,0),seq(0,359,359/8))
sim3 <- cbind(rnorm(7,0),seq(0,359,359/6))
If not doing a polar plot my procedure would be as follows:
# Create spline for points
total <- rbind(sim1,sim2,sim3)
fit= smooth.spline(total[,2],total[,1], cv=T)
# Classic solution if not polar plot
plot(sim1[,2],sim1[,1],ylim = c(-3,4), col = "darkgrey")
lines(sim1[,2],sim1[,1], pch=2, col = "darkgrey")
points(sim2[,2],sim2[,1], pch=2, col = "darkgrey")
lines(sim2[,2],sim2[,1], pch=2, col = "darkgrey")
points(sim3[,2],sim3[,1], pch=2, col = "darkgrey")
lines(sim3[,2],sim3[,1], pch=2, col = "darkgrey")
lines(fit, , col = "red")
Which would give me this kind of figure:
Plot
But trying to plot it in a polar plot. I cannot get further than plotting each individually:
# Plot
library(plotrix)
polar.plot(sim1[,1],sim1[,2],lwd=3,line.col="red", radial.lim=c(-3,3),clockwise=TRUE,rp.type = "s")
polar.plot(sim2[,1],sim2[,2],lwd=3,line.col="blue", radial.lim=c(-3,3),clockwise=TRUE,rp.type = "s")
polar.plot(sim3[,1],sim3[,2],lwd=3,line.col="darkgrey", radial.lim=c(-3,3),clockwise=TRUE,rp.type = "s")
Poor plot but 360
I have also tried using ggplot2 as well as plotly but nothing yielded what I was hoping for.
Use the add parameter to add lines. Perhaps something like this?
polar.plot(sim1[,1], sim1[,2], lwd=1, line.col = "grey20", radial.lim = c(-3,3),
clockwise = TRUE, rp.type = "p")
polar.plot(sim2[,1], sim2[,2], lwd=1, line.col = "grey20", radial.lim = c(-3,3),
clockwise = TRUE, rp.type = "p", add = TRUE)
polar.plot(sim3[,1], sim3[,2], lwd=1, line.col = "grey20", radial.lim = c(-3,3),
clockwise = TRUE, rp.type = "p", add = TRUE)
polar.plot(fit$y, fit$x, lwd=2, line.col = "firebrick", radial.lim = c(-3,3),
clockwise = TRUE, rp.type = "p", add = TRUE)
GGplot alternative:
library(ggplot2,ggthemes)
# Data for test
set.seed(35)
sim1 <- cbind(rnorm(6,0),seq(0,359,359/5))
sim2 <- cbind(rnorm(9,0),seq(0,359,359/8))
sim3 <- cbind(rnorm(7,0),seq(0,359,359/6))
# Create spline for points
total <- rbind(sim1,sim2,sim3)
colnames(total)=c('Col1','Col2')
total=as.data.frame(total)
MyNames=c(rep('sim1',nrow(sim1)),rep('sim2',nrow(sim2)),rep('sim3',nrow(sim3)))
total=cbind(MyNames,total)
Radial=ggplot(total)+
theme_light()+
geom_line(aes(x=Col2,y=Col1,group=MyNames,colour=MyNames),alpha=0.4)+
geom_point(aes(x=Col2,y=Col1,group=MyNames,colour=MyNames))+
geom_line(aes(x=Col2,y=Col1),stat='smooth', method = "loess", span=0.5, alpha=0.4, size=1.2)+
scale_x_continuous(breaks=seq(0,360,by=60),expand=c(0,0),lim=c(0,360))+
coord_polar(theta='x',start=0)+
ggtitle('Sim')+
theme(axis.text=element_text(size=14),axis.title=element_text(size=16,face="bold"),legend.text=element_text(size=14),legend.title=element_text(size=14),title=element_text(size=16,face="bold"),plot.title = element_text(hjust = 0.5))
Radial
I have created a scatterplot3d with a linear model applied.
Unfortunately the results of the LM are subtle and need to be emphasised, my question is how can I extend the LM grid outside of the 'cube'.
Plot:
Code:
Plot1 <-scatterplot3d(
d$MEI,
d$YYYYMM,
d$AOELog10,
pch=20,
grid = FALSE,
color = "black",
xlab="MEI",
ylab="Date",
zlab="AOE Log(10)"
)
fit <- lm(d$AOELog10 ~ d$MEI+d$Rank)
Plot1$plane3d(fit)
Now I guess it might be a variable within lm(), but I cant find anything....
To see a larger region, or region of interest, specify the x, y, and z limits in the scatterplot command.
library(scatterplot3d)
d<-data.frame(MEI=runif(200,-3,3),
YYYYMM=runif(200,1,300),
AOELog10=runif(200,1,20),
Rank=runif(200,1,5))
fit <- lm(d$AOELog10 ~ d$MEI+d$Rank)
Plot1 <-scatterplot3d(
d$MEI, d$YYYYMM, d$AOELog10,
pch=20, grid = FALSE, color = "black",
xlab="MEI", ylab="Date", zlab="AOE Log(10)",
main="baseline"
)
Plot1$plane3d(fit)
Plot2 <-scatterplot3d(
x=d$MEI, y=d$YYYYMM, z=d$AOELog10,
pch=20, grid = FALSE, color = "black",
xlab="MEI", ylab="Date", zlab="AOE Log(10)",
xlim = c(-5,5), ylim = c(-50,400), zlim = c(-10,50), # Specify the plot range
main="larger region"
)
Plot2$plane3d(fit)
I am trying to plot rose diagrams/ circular histograms on specific coordinates on a map analogous to drawing pie charts on a map as in the package mapplots.
Below is an example generated with mapplots (see below for code), I'd like to replace the pie charts with rose diagrams
The package circular lets me plot the rose diagrams, but I am unable to integrate it with the mapplots package. Any suggestions for alternative packages or code to achieve this?
In response to the question for the code to make the map. It's all based on the mapplots package. I downloaded a shapefile for the map (I think from http://www.freegisdata.org/)
library(mapplots)
library(shapefiles)
xlim = c(-180, 180)
ylim = c(-90, 90)
#load shapefile
wmap = read.shapefile ("xxx")
# define x,y,z for pies
x <- c(-100, 100)
y <- c(50, -50)
z1 <- c(0.25, 0.25, 0.5)
z2 <- c(0.5, 0.2, 0.3)
z <- rbind(z1,z2)
# define radii of the pies
r <- c(5, 10)
# it's easier to have all data in a single df
plot(NA, xlim = xlim, ylim = ylim, cex = 0.75, xlab = NA, ylab = NA)
draw.shape(wmap, col = "grey", border = "NA")
draw.pie(x,y,z,radius = r, col=c("blue", "yellow", "red"))
legend.pie (x = -160, y = -70, labels = c("0", "1", "2"), radius = 5,
bty = "n", cex = 0.5, label.dist=1.5, col = c("blue", "yellow", "red"))
the legend for the pie size can then be added using legend.bubble
Have a look at this example, you can use the map as background an plot your rose diagrams withPlotrix or ggplot2. In either case you would want to overlay multiple of these diagrams on top of your map which is easy to do in ggplot, just have a look at the example.
I discovered subplot() in the package Hmisc, which seems to do exactly what I wanted. Below is my solution (without the map in the background, which can be plotted using mapplots). I am open to suggestions on how to improve this though...
library(Hmisc)
library (circular)
dat <- data.frame(replicate(2,sample(0:360,10,rep=TRUE)))
lat <- c(50, -40)
lon <- c(-100, 20)
# convert to class circular
cir.dat <- as.circular (dat, type ='angles', units = 'degrees', template = 'geographic', modulo = 'asis', zero = 'pi/2', rotation = 'clock')
# function for subplot, plots relative frequencies, see rose.diag for how to adjust the plot
sub.rose <- function(x){
nu <- sum(!is.na(x))
de <- max(hist(x, breaks = (seq(0, 360, 30)), plot = FALSE)$counts)
prop <- nu/de
rose.diag(x, bins = 12, ticks = FALSE, axes = FALSE,
radii.scale = 'linear',
border = NA,
prop = prop,
col = 'black'
)
}
plot(NA, xlim = xlim, ylim = ylim)
for(i in 1:length(lat)){
subplot(sub.rose(cir.dat[,i]), x = lon[i], y = lat[i], size = c(1, 1))
}