Rotate a matrix 45 degrees and visualize it using ggplot - r

I have plot quite easily a matrix (thus giving a heatmap) with ggplot like this:
test <- data.frame(start1=c(1,1,1,1,2,2,2,3,3,4),start2=c(1,2,3,4,2,3,4,3,4,4),logFC=c(5,5,1,0,8,0,5,2,4,3))
ggplot(test, aes(start1, start2)) +
geom_tile(aes(fill = logFC), colour = "gray", size=0.05) +
scale_fill_gradientn(colours=c("#0000FF","white","#FF0000"), na.value="#DAD7D3")
Since I have only the lower part of the heatmap, it gives this plot:
But I would like to rotate the matrix 45 degrees, just like I can find here: Visualising and rotating a matrix. So, the diagonal next to the X axis. However, they use the graphics from R without ggplot. Do you have any idea how to do that with ggplot?

You can first rotate the matrix (data frame) by the following function:
rotate <- function(df, degree) {
dfr <- df
degree <- pi * degree / 180
l <- sqrt(df$start1^2 + df$start2^2)
teta <- atan(df$start2 / df$start1)
dfr$start1 <- round(l * cos(teta - degree))
dfr$start2 <- round(l * sin(teta - degree))
return(dfr)
}
Rotate the data frame by 90 degrees counter clockwise by
test2 <- rotate(test, -90)
Then plot test2 by using the same code.

Related

Add an ellipse on raster plot in R

I need to plot an ellipse on a raster plot. I tried plotting raster with simple plot(r1) (r1 is the raster layer) and then add=T for ellipse plotting but it doesn't work. Then I tried axes=F for plotting raster and again tried add=T for ellipse. It still doesn't work.
So I tried converting the ellipse data to dataframe and try adding to raster plot.
#Creating a raster
r <- matrix(sample(1:400),20,20)
r1<-raster(r)
#Creating ellipse with given mean and standard deviation values
theta <- seq(0, 2 * pi, length=(2000))
x <- 0.2 - 0.15 * cos(theta)
y <- 0.5 - 0.15 * sin(theta)
elp<- cbind(na.omit(x),na.omit(y))
#Converting ellipse data frame (elp) to SpatialDataFrame (ps)
ps <- SpatialPolygons(list(Polygons(list(Polygon(elp)),2)))
#Plotting raster with ellipse
plot(r1)
plot(ps, add=T)
What I get is;
Ideally ps should appear as ellipse but it is a circle. On the other hand if I plot elp (data frame from which ps is created), I get an ellipse.
plot(elp)
Can someone please help with this?
Be aware that you are not creating an ellipse flattened in horizontal direction at all. As shown in the below console output, the horizontal and vertical extent of ps is almost equal.
> diff(range(x))
[1] 0.2999998
> diff(range(y))
[1] 0.2999999
I rather assume that the ellipsoid shape of the plot depicted above originates from the sizing of your plotting device. In order to create an ellipse in the first place, you are required to do something like the following (note the difference between the x and y related expansion factors).
x <- 0.2 - 0.15 * cos(theta)
y <- 0.5 - 0.05 * sin(theta)
elp <- cbind(na.omit(x),na.omit(y))
ps <- SpatialPolygons(list(Polygons(list(Polygon(elp)),2)))
Once you have a proper ellipse, you may then display it on top of the RasterLayer e.g. by using
library(latticeExtra)
spplot(r1, alpha.regions = 0.5, scales = list(draw = TRUE)) +
layer(sp.polygons(ps, col = "black", lwd = 2))

Plot 3d surface or ploygon in R based on specific combinations of 3 variables

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.

Finding the angle and distance over a ggplot/grid in R

I have made a ggplot using some A and B numeric values. (If possible can you give me the solution for grid too?)
Such as:
A B
2 3
3 7
4 8
5 9
6 2
7 1
Now from the points, lets say A1 and A2 as shown in diagram, I want to measure the angle and the distance covered from each point.
I know how to calculate the distance (via euclidean distance formula) from one point and for angle it can be calculated as cross and dot product of the vectors. But I am facing the problem to code this and to represent it.
Can you help?
Okay, here is a first pass - doing it in grid. This could be done in ggplot2 too I imagine, but I want to learn grid for now since ggplot2 and lattice are based on it. This plot has some issues, for example the angle of the annotation text really has to be calculated in device coordinates, not native coordinates, so it only looks right if your grid squares are really square. I might fix that later, but I don't have time now. Also I would think I could specify the defaults so that each primitive doesn't have that default.units parameter. This should get you started though.
library(grid)
grid.newpage()
df <- data.frame(a=c(2,3,4,5,6,7),b=c(3,7,8,9,2,1))
vp <- viewport(x=0.5,y=0.5,width=0.999,height=0.999,xscale=c(0,1),yscale=c(0,1))
pushViewport(vp)
# a rectangle (with dashed lines) on the border of the viewport:
grid.rect(gp=gpar(lty="dashed",col="steelblue"))
vp <- viewport(x=0.5,y=0.5,width=0.9,height=0.9,xscale=c(0,8),yscale=c(0,10),
default.units="native")
pushViewport(vp)
#draw the background grid
grid.polyline(x=rep(0:8,each=2),y=rep(c(0,10),9),id=rep(1:9,each=2),
gp=gpar(lty="solid",col="gray"),default.units="native")
grid.polyline(x=rep(c(0,8),11),y=rep(0:10,each=2),id=rep(1:11,each=2),
gp=gpar(lty="solid",col="gray"),default.units="native")
# add the lables
grid.text(as.character(0:8),x=0:8,y=rep(-0.2,9),
gp=gpar(col="gray",fontsize=12),default.units="native")
grid.text(as.character(0:10),y=0:10,x=rep(-0.2,11),
gp=gpar(col="gray",fontsize=12),default.units="native")
grid.lines(x=df$a,y=df$b,gp=gpar(col="steelblue"),default.units="native")
grid.points(x=df$a,y=df$b,gp=gpar(col="steelblue"),default.units="native")
for (i in 1:(nrow(df)-1)){
x0 <- df$a[i]
y0 <- df$b[i]
x1 <- df$a[i+1]
y1 <- df$b[i+1]
dx <- x1-x0
dy <- y1-y0
dist <- sqrt( dx^2 + dy^2 )
ang <- (180/3.14159)*atan2(dy,dx)
txt <- sprintf("D: %.1f Ang:%.1f",dist,ang)
xt <- (x0+x1)/2
yt <- (y0+y1)/2 + 0.2*abs(dy/dx)
grid.text(txt,x=xt,y=yt,rot=ang,
gp=gpar(col="steelblue",fontsize=9),default.units="native")
}
It sounds easier to calculate those angles and distances outside the plot,
library(dplyr)
d <- data.frame(x=c(2,3,4,5,6,7),
y=c(3,7,8,9,2,1))
d2 <- with(d, data.frame(dx=diff(x), dy=diff(y)))
d2 <- mutate(d2, distance = sqrt(dx^2 + dy^2),
angle = atan2(dy, dx))
ann <- mutate(cbind(d[-nrow(d),], d2),
x=x+dx/2, y=y+dy/2,
label = sprintf("%.2f\n %2.f degrees",
distance, angle*180/pi))
library(ggplot2)
ggplot(d, aes(x,y)) + geom_line() +
geom_text(data = ann, vjust = 0,
aes(x, y, label=label, angle=angle*180/pi)) +
coord_equal()

Inputting a fixed colour input vector with RGL in R

Is there any way to input a fixed vector of colours to any 3D rgl plots? If so it would be possible to extrude a map tile to a 3D surface based on a raster of the same area. But I'm finding the surface3d function behaves the same as raster::plot by insisting on mapping the input colour vector to the z variable. Is this beyond rgl's functionality at present?
I don't actually know if what you say about the coloring is correct for all rgl coloring functions, but it is not correct for rgl.surface(). This is a corruption of the example on the ?rgl.surface page. The color vector index was formed from the x-y (actually x-z) coordinates and gives a striping effect because they were modulo-ized to pull values from from a limited range.
library(rgl)
data(volcano)
y <- 2 * volcano
x <- 10 * (1:nrow(y))
z <- 10 * (1:ncol(y))
ylim <- range(y)
ylen <- ylim[2] - ylim[1] + 1
colorlut <- terrain.colors(ylen)
col <- colorlut[(x+length(x)*y +1)%%ylen ]
rgl.open()
rgl.surface(x, z, y, color=col, back="lines")
rgl.snapshot("striped_volcano.png")

Rotate graph by angle

I have multiple matrices filled with the x and y coordinates of multiple points in 2D space that make up a graph. The matrices look something like this
x1 x2 x3 x4 ...
y1 y2 y3 y4 ...
A possible graph looks something like this
What I want to do is rotate the graph around point A so that the line between the points A and B are parallel to the X-Axis.
My idea was to treat the line AB as the hypothenuse of a right-triangle, calculate α (the angle at point A) and rotate the matrix for this graph by it using a rotation matrix.
What I did so far is the following
#df is the subset of my data that describes the graph we're handling right now,
#df has 2 or more rows
beginx=df[1,]$xcord #get the x coordinate of point A
beginy=df[1,]$ycord #get the y coordinate of point A
endx=df[nrow(df)-1,]$xcord #get the x coordinate of point B
endy=df[nrow(df)-1,]$ycord #get the y coordinate of point B
xnow=df$xcord
ynow=df$ycord
xdif=abs(beginx-endx)
ydif=abs(beginy-endy)
if((xdif != 0) & (ydif!=0)){
direct=sqrt(abs((xdif^2)-(ydif^2))) #calculate the length of the hypothenuse
sinang=abs(beginy-endy)/direct
angle=1/sin(sinang)
if(beginy>endy){
angle=angle
}else{
angle=360-angle
}
rotmat=rot(angle) # use the function rot(angle) to get the rotation matrix for
# the calculated angle
A = matrix(c(xnow,ynow),nrow=2,byrow = TRUE) # matrix containing the graph coords
admat=rotmat%*%A #multiply the matrix with the rotation matrix
}
This approach fails because it isn't flexible enough to always calculate the needed angle with the result being that the graph is rotated by the wrong angle and / or in the wrong direction.
Thanks in advance for reading and hopefully some of you can bring some fresh ideas to this
Edit: Data to reproduce this can be found here
X-Coordinates
Y-Coordinates
Not sure how to provide the data you've asked for, I'll gladly provide it in another way if you specify how you'd like it
Like this?
#read in X and Y as vectors
M <- cbind(X,Y)
#plot data
plot(M[,1],M[,2],xlim=c(0,1200),ylim=c(0,1200))
#calculate rotation angle
alpha <- -atan((M[1,2]-tail(M,1)[,2])/(M[1,1]-tail(M,1)[,1]))
#rotation matrix
rotm <- matrix(c(cos(alpha),sin(alpha),-sin(alpha),cos(alpha)),ncol=2)
#shift, rotate, shift back
M2 <- t(rotm %*% (
t(M)-c(M[1,1],M[1,2])
)+c(M[1,1],M[1,2]))
#plot
plot(M2[,1],M2[,2],xlim=c(0,1200),ylim=c(0,1200))
Edit:
I'll break down the transformation to make it easier to understand. However, it's just basic linear algebra.
plot(M,xlim=c(-300,1200),ylim=c(-300,1200))
#shift points, so that turning point is (0,0)
M2.1 <- t(t(M)-c(M[1,1],M[1,2]))
points(M2.1,col="blue")
#rotate
M2.2 <- t(rotm %*% (t(M2.1)))
points(M2.2,col="green")
#shift back
M2.3 <- t(t(M2.2)+c(M[1,1],M[1,2]))
points(M2.3,col="red")
Instead of a data frame, it looks like your data is better served as a matrix (via as.matrix).
This answer very similar to Roland's, but breaks things down into more steps and has some special-case handling when the angle is a multiple of pi/2.
#sample data
set.seed(1) #for consistency of random-generated data
d <- matrix(c(sort(runif(50)),sort(runif(50))),ncol=2)
#rotation about point A
rotA <- function(d) {
d.offset <- apply(d,2,function(z) z - z[1]) #offset data
endpoint <- d.offset[nrow(d.offset),] #gets difference
rot <- function(angle) matrix(
c(cos(angle),-sin(angle),sin(angle),cos(angle)),nrow=2) #CCW rotation matrix
if(endpoint[2] == 0) {
return(d) #if y-diff is 0, then no action required
} else if (endpoint[1] == 0) {
rad <- pi/2 #if x-diff is 0, then rotate by a right angle
} else {rad <- atan(endpoint[2]/endpoint[1])}
d.offset.rotate <- d.offset %*% rot(-rad) #rotation
d.rotate <- sapply(1:2,function(z) d.offset.rotate[,z] + d[1,z]) #undo offset
d.rotate
}
#results and plotting to check visually
d.rotate <- rotA(d)
plot(d.rotate)
abline(h=d[1,2])

Resources