I'm currently working on SOM vizualisations.
This is a SOM map with codes plots generated by using kohonen package
Shortly, each circle is a neuron and inside each neuron we plot all the variable in a spectra shape.
This plot is obtain by som_obj$codes[nameoftheneuron] (som_obj is the return value of som() function)
here i have written basic function derived from https://github.com/geoss/som_visualization_r
plotCluster <- function(som_obj, cutree.obj , col_palette){
if (som_obj$grid$topo != "hexagonal"){
stop("function assumes hexgonal SOM")
}
Hexagon <- function (x, y, unitcell = 1, col = "grey", border=NA) {
polygon(c(x, x, x + unitcell/2, x + unitcell, x + unitcell,
x + unitcell/2), c(y + unitcell * 0.125, y + unitcell *
0.875, y + unitcell * 1.125, y + unitcell * 0.875,
y + unitcell * 0.125, y - unitcell * 0.125),
col = col, border=border)
}
plot(0, 0, type = "n", axes = FALSE, xlim=c(0, som_obj$grid$xdim),
ylim=c(0, som_obj$grid$ydim), xlab="", ylab= "", asp=1, main= "Clusters")
if(!is.null(col_palette)){
ColorCode = col_palette[cutree.obj]
}
else{
ColorCode <- as.factor(cutree.obj)
}
offset <- 0.5 #offset for the hexagons when moving up a row
ind <- 1
for (row in 1:som_obj$grid$ydim) {
for (column in 0:(som_obj$grid$xdim - 1)) {
Hexagon(column + offset, row - 1, col = ColorCode[ind])
ind <- ind +1}
offset <- ifelse(offset, 0, 0.5)
}
}
I only want to know how to add each plot in the tiles on my own plot.
I have 0 idea how to perform that. I have literally no clue for doing that.
I tried to get the code of the plot function from plot.kohonen but I get the truncated code only from getAnywhere(plot.kohonen)
This problem seems to be complex but I just need hints with the following question:
1 - In the plot systems imagined in the code below, how to plot something (plot or text) in each tiles?
Related
I am trying to plot a raster in a projected in a coordinated system which follows the curvature of the earth like most projections that are not WGS84. The problem is that the places were the globe wraps around the data should not be plotted outside the globe. I realize that ggplot cannot do a rounded/elliptical plot but how do I mask or remove automatically the data outside the globe? I have to plot more than 100 maps and I can't do this manually especially if I want to change to a different projection.
There's an answer here but it's hackish and doesn't seem to apply to every case, is there function or package that deals with this problem? I don't think R users only plot maps in WGS84?
I am attaching a file and code to quickly plot the map. I cannot use xlim because it would cut some parts of the map since the borders are not straight.
#netcdf file
https://ufile.io/fy08x33d
library(terra);library(tidyterra)
r=rast('Beck_KG_V1_present_0p5.tif')
#background map
r[r==0]=NA
ggplot() +geom_spatraster(data=r)+scale_fill_viridis_c(na.value='transparent') +coord_sf(crs=st_crs("+proj=hatano"),expand=FALSE)
With these data
library(terra)
library(tidyterra)
r1 <- rast('Beck_KG_V1_present_0p5.tif')
r <- subst(r1, 0, NA)
You can do
library(ggplot2)
p <- project(r, method="near", "+proj=hatano", mask=TRUE)
ggplot() +geom_spatraster(data=p)+scale_fill_viridis_c(na.value='transparent')
And here are two alternatives with base plot
First with your own color palette and a legend
library(viridis)
g <- graticule(60, 45, "+proj=hatano")
plot(g, background="azure", mar=c(.2,.2,.2,4), lab.cex=0.5, col="light gray")
plot(p, add=TRUE, axes=FALSE, plg=list(shrink=.8), col=viridis(25))
With the colors that came with the file:
coltab(p) <- coltab(r1)
plot(g, background="azure", mar=.5, lab.cex=0.5, col="light gray")
plot(p, add=TRUE, axes=FALSE, col=viridis(25))
I would go with one of Robert Hijman's options here, but if you want to create a mask in ggplot, you could do something like this:
library(grid)
y <- seq(0, 1, length = 100)
x <- ifelse(y < 0.5,
-cos(pi/2 * (2 * y - 1)) * 0.125 + 0.125,
-cos(pi/2 * (2 * y - 1)) * 0.175 + 0.175)
y <- c(0, y, 1, 0)
x <- c(0, x, 0, 0)
ggplot() +
geom_spatraster(data=r)+
scale_fill_viridis_c(na.value = 'transparent') +
coord_sf(crs = st_crs("+proj=hatano"), expand = FALSE) +
annotation_custom(polygonGrob(x = x, y = y,
gp = gpar(col = "white", lwd = 1))) +
annotation_custom(polygonGrob(x = 1-x, y = y,
gp = gpar(col = "white", lwd = 1)))
I have a plot where I draw arrows from points to points. I would like to put this arrow heads not to the end of the line, but to middle. Is there a simple way to do it other than placing extra arrows with half length of the according line?
My code is this:
plot(x, y, xlim=range(x), ylim=range(y), xlab="x", ylab="y", pch=16,
main="Filled Plane")
for(i in 1:20){
arrows(x[i], y[i], x[i+1], y[i+1], length = 0.25, angle = 30, col = i)
}
Make a custom function myArrow() and add one new argument cut to control the proportion of the arrows
myArrow <- function(x0, y0, x1, y1, cut = 1, ...){
x.new <- (1 - cut) * x0 + cut * x1
y.new <- (1 - cut) * y0 + cut * y1
# segments(x0, y0, x1, y1, ...)
arrows(x0, y0, x.new, y.new, ...)
}
Note1 : The computation of x.new and y.new in this custom function uses a simple mathematical concept, i.e. the Section Formula. The value of cut must be between 0 to 1.
Note2 : The use of this function is equivalent to that of the original functionarrows() other than that it has one more new argument cut.
Note3 : If you want complete lines behind the arrows, just remove the hash(#) in the function.
Plot and try different cut value. For example, I use cut = 0.7. (If you want the arrowheads to the middle, use cut = 0.5.)
# Toy Data
x <- seq(1, 5.5, by = 0.5)
y <- rep(c(1, 5), 5)
plot(x, y, pch = 16)
for(i in 1:9){
myArrow(x[i], y[i], x[i+1], y[i+1], cut = 0.7, col = i, lwd = 2)
}
Since you do not provide your x and y, I made up some data. There is no need for the loop. arrows will handle a vector of coordinates. One way is to draw a full-length arrow with no arrowhead and another that just goes halfway but has the arrowhead.
## Some bogus data
set.seed(123)
x = runif(4)
y = runif(4)
## Compute the midpoints
midx = diff(x)/2 + x[-length(x)]
midy = diff(y)/2 + y[-length(y)]
## Draw it
plot(x,y,xlim=range(x), ylim=range(y), xlab="x", ylab="y",
main="Filled Plane",pch=16)
arrows(x[-length(x)], y[-length(y)],x[-1],y[-1],
angle = 0, col = 1:3)
arrows(x[-length(x)], y[-length(y)],midx,midy,
length = 0.25, angle = 30, col = 1:3)
I would like to plot shaded confidence regions for various lines, but would like the alpha level in these regions to vary gradually from b to c, where b is the alpha at the median, and c is the alpha at whatever outer quantile I am using. The following code generates a line and confidence region plot as I would like, but without the variable transparency.
x= 1:10+rnorm(10)
xhigh=x+rnorm(10)^2
xlow=x-rnorm(10)^2
plot(x,type='l')
polygon(x=c(1:length(xlow),length(xlow):1), y=c(xhigh,xlow[length(xlow):1]),col = rgb(1,0,0,.1),border=NA)
You can overplot many polygons:
plot(x,type='l')
for (i in seq(0, 1, 0.01)) {
polygon(x = c(x + i * (xhigh - x), x - i * (xlow - x)),
col = rgb(1, 0, 0, .005), border = NA)
}
Altough, I think your example is actually wrong, and probably want something like:
plot(x,type='l')
for (i in seq(0, 1, 0.01)) {
polygon(x = c(1:10, 10:1),
y = c(x + i * (xhigh - x), rev(x - i * abs(x - xlow))),
col = rgb(1, 0, 0, .005), border = NA)
}
I wrote following R script:
#energy diagram
x <- c(0.1, 0.3, 0.5, 0.7, 0.9 ) #chosen randomly, reaction axis
y <- c(-5.057920, -5.057859, -5.057887,-5.057674, -5.057919 ) #energy of the educt, intermediate, transtition states and product
plot(x,y, type="p",
xlim=c(0,1),
ylim=c(-5.058,-5.0575),
xlab="reaction axis",
ylab=expression(paste(E[el] ," / ",10^6," ",kJ/mol)),
xaxt="n" #hide x-axis
)
#h- and v-lines, so i can draw curves by hand
abline(v=seq(0,1,0.1),h=seq(-5.0600,-5.0500,0.00005),col="black",lty=1,lwd=1)
abline(h=c(-5.057920, -5.057859, -5.057887,-5.057674), col="blue", lty=1,lwd=0.7)
Is it possible to draw a curve through the points that would look like a energy diagram. An example of an energy diagram is here:
A lot could be done to streamline / vectorize this code, but for a smallish diagram this works pretty well:
# get that data
x <- c(0.1, 0.3, 0.5, 0.7, 0.9 ) # reaction axis
y <- c(-5.057920, -5.057859, -5.057887,-5.057674, -5.057919 ) # energies
I'm going to make a little Bezier curve to connect each point to the next---this way we can make sure the smooth line passes through the data, not just close to it. I'll give each point a single 'control point' to define the slope. By using the same y-values for a point and it's control point, the slope at the point will be 0. I'll call the offset between the point and the control point delta. We'll start with one point-pair:
library(Hmisc)
delta = 0.15
bezx = c(0.1, 0.1 + delta, 0.3 - delta, 0.3)
bezy = rep(y[1:2], each = 2)
plot(bezx, bezy, type = 'b', col = "gray80")
lines(bezier(bezx, bezy), lwd = 2, col = "firebrick4")
Here I plotted the points and control points in gray, and the smooth line in red so we can see what's going on.
It looks promising, let's turn it into a function that we can apply to each pair of points:
bezf = function(x1, x2, y1, y2, delta = 0.15) {
bezier(x = c(x1, x1 + delta, x2 - delta, x2), y = c(y1, y1, y2, y2))
}
You can play with the delta parameter, I think 0.1 looks pretty good.
plot(x, y, xlab = "Reaction coordinate", ylab = "E", axes = F)
box(bty = "L")
axis(side = 2)
for(i in 1:(length(x) - 1)) {
lines(bezf(x1 = x[i], x2 = x[i + 1], y1 = y[i], y2 = y[i + 1], delta = 0.1))
}
You can of course tweak the plot, add labels, and ablines as in your original. (Use my for loop with the lines command to draw only the smoothed lines.) I left the points on to show that we are passing through them, not just getting close.
I prefer plotting in ggplot2, if you do too you'll need to extract the data into a data.frame:
bezlist = list()
for (i in 1:(length(x) - 1)) {
bezlist[[i]] = bezf(x1 = x[i], x2 = x[i + 1], y1 = y[i], y2 = y[i + 1], delta = 0.1)
}
xx = unlist(lapply(bezlist, FUN = '[', 'y'))
yy = unlist(lapply(bezlist, FUN = '[', 'y'))
bezdat = data.frame(react = xx, E = yy)
library(ggplot2)
ggplot(bezdat, aes(x = react, y = E)) +
geom_line() +
labs(x = "Reaction coordinate")
You could use a spline fit. Define some points along the energy diagram, and then fit to them using a spline function. The more points that you provide, the better that your fit will be. You can check out the smooth.splines function in the stats package for one implementation of the spline fit.
I have a plot with two logarithmic axes. I'd like to add a circle to a certain position of the plot. I tried to use plotrix, but this does not give options for "log-radius".
# data to plot
x = 10^(-1 * c(5:0))
y = x ^-1.5
#install.packages("plotrix", dependencies=T)
# use require() within functions
library("plotrix")
plot (x, y, log="xy", type="o")
draw.circle(x=1e-2, y=1e2, radius=1e1, col=2)
How can I add a circle to my log-log plot?
As krlmlr suggests, the easiest solution is to slightly modify plotrix::draw.circle(). The log-log coordinate system distorts coordinates of a circle given in the linear scale; to counteract that, you just need to exponentiate the calculated coordinates, as I've done in the lines marked with ## <- in the code below:
library("plotrix")
draw.circle.loglog <-
function (x, y, radius, nv = 100, border = NULL, col = NA, lty = 1,
lwd = 1)
{
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
angle.inc <- 2 * pi/nv
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
if (length(col) < length(radius))
col <- rep(col, length.out = length(radius))
for (circle in 1:length(radius)) {
xv <- exp(cos(angles) * log(radius[circle])) * x[circle] ## <-
yv <- exp(sin(angles) * ymult * log(radius[circle])) * y[circle] ## <-
polygon(xv, yv, border = border, col = col[circle], lty = lty,
lwd = lwd)
}
invisible(list(x = xv, y = yv))
}
# Try it out
x = 10^(-1 * c(5:0))
y = x ^-1.5
plot (x, y, log="xy", type="o")
draw.circle.loglog(x = c(1e-2, 1e-3, 1e-4), y = c(1e2, 1e6, 1e2),
radius = c(2,4,8), col = 1:3)
A work around would be to apply log10 explicitly.
plot (log10(x), log10(y), type="o")
draw.circle(x=log10(1e-2), y=log10(1e2), radius=log10(1e1), col=2)
Edit (using symbols):
plot (x, y, log="xy", type="o",xlim=c(1e-5,1), ylim=c(1,1e8))
par(new=T)
symbols(x=1e-2, y=1e2, circles=1e1, xlim=c(1e-5,1), ylim=c(1,1e8),
xaxt='n', yaxt='n', ann=F, log="xy")
The function draw.circle from the plotrix package looks like that on my system:
> draw.circle
function (x, y, radius, nv = 100, border = NULL, col = NA, lty = 1,
lwd = 1)
{
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
angle.inc <- 2 * pi/nv
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
if (length(col) < length(radius))
col <- rep(col, length.out = length(radius))
for (circle in 1:length(radius)) {
xv <- cos(angles) * radius[circle] + x
yv <- sin(angles) * radius[circle] * ymult + y
polygon(xv, yv, border = border, col = col[circle], lty = lty,
lwd = lwd)
}
invisible(list(x = xv, y = yv))
}
<environment: namespace:plotrix>
What happens here is essentially that the circle is approximated by a polygon of 100 vertices (parameter nv). You can do either of the following:
Create your own version of draw.circle that does the necessary coordinate transformation to "undo" the log transform of the axes.
The function invisibly returns the list of coordinates that are used for plotting.
(If you pass a vector as radius, then only the coordinates of the last circle are returned.) You might be able to apply a transform to those coordinates and call polygon on the result. Pass appropriate values for border, col, lty and/or lwd to hide the polygon drawn by the functions itself.
The first version sounds easier to me. Simply replace the + x by a * x, same for y, inside the for loop, and you're done. Equivalently, for the second version, you subtract x and then multiply by x each coordinate, same for y. EDIT: These transformations are slightly wrong, see Josh's answer for the correct ones.