Related
I am making a series of plots from a point pattern (PPP) with the density (kernel) function. I would like that the maximum plotted number is 200 in all cases and just the heatmap accordingly (two of the images only go up to 100). I have not been able to find a solution to this problem using the R base plot.
Microglia_Density <- density(Microglia_PPP, sigma =0.1, equal.ribbon = TRUE, col = topo.colors, main = "")
plot(Microglia_Density, main = "Microglia density")
Astrocytes_Density <- density(Astrocytes_PPP, sigma =0.1, equal.ribbon = TRUE, col = topo.colors, main = "")
plot(Astrocytes_Density, main = "Astrocytes density")
Neurons_Density <- density(Neurons_PPP, sigma =0.1, equal.ribbon = TRUE, col = topo.colors, main = "")
plot(Neurons_Density, main = "Neuronal density")
I would appreciate recommendations. Regards
Since we don’t have access to your data I simulate fake data in a square.
There are several options to do what you want. First you should know that
density() is a generic function, so when you invoke it on a ppp like
Microglia_PPP actually the function density.ppp() is invoked.
This function returns an im object (effectively a 2-d “image” of values).
You plot this with plot() which in turn calls plot.im(), so you should
read the help file of plot.im(), where it says that the argument col
controls the colours used in the plot. Either you can make a colour map
covering the range of values you are interested in and supply that, or if you
know that one of the images has the colour map you want to use you can save
it and reuse for the others:
library(spatstat)
set.seed(42)
Microglia_PPP <- runifpoint(100)
Neurons_PPP <- runifpoint(200)
Neurons_Density <- density(Neurons_PPP, sigma = 0.1)
Microglia_Density <- density(Microglia_PPP, sigma = 0.1)
my_colourmap <- plot(Neurons_Density, main = "Neuronal density", col = topo.colors)
plot(Microglia_Density, main = "Microglia density", col = my_colourmap)
Notice the colour maps are the same, but it only covers the range from
approximately 80 to 310. Any values of the image outside this range will not
be plottet, so they appear white.
You can make a colour map first and then use it for all the plots
(see help(colourmap)):
my_colourmap <- colourmap(topo.colors(256), range = c(40,315))
plot(Neurons_Density, main = "Neuronal density", col = my_colourmap)
plot(Microglia_Density, main = "Microglia density", col = my_colourmap)
Finally another solution if you want the images side by side is to make them
an imlist (image list) and use plot.imlist() with equal.ribbon = TRUE:
density_list <- as.imlist(list(Neurons_Density, Microglia_Density))
plot(density_list, equal.ribbon = TRUE, main = "")
I would like your help with the route_local function of the stplanr package (https://cran.r-project.org/web/packages/stplanr/stplanr.pdf), which is on page 89.
You may realize that a map is generated from the example function, showing the path between two points (I left the code and the image generated below). I would like to do the same thing. In my case it is show the path between two points considering my roads. Both are the shapefile file. I managed to generate the roads to show (code below), but I would like to show the route between any two points from these roads. Can someone help me??
I left it at the following site https://github.com/JovaniSouza/JovaniSouza5/blob/master/Example.zip to download the shapefiles.
library(geosphere)
library(sf)
library(stplanr)
roads<-st_read("C:/Users/Jose/Downloads/Example/Roads/Roads.shp")
p <- SpatialLinesNetwork(roads, uselonglat = FALSE, tolerance = 0)
plot(p)
Map generated by code
Example
from <- c(-1.535181, 53.82534)
to <- c(-1.52446, 53.80949)
sln <- SpatialLinesNetwork(route_network_sf)
r <- route_local(sln, from, to)
plot(sln)
plot(r$geometry, add = TRUE, col = "red", lwd = 5)
plot(cents[c(3, 4), ], add = TRUE)
r2 <- route_local(sln = sln, cents_sf[3, ], cents_sf[4, ])
plot(r2$geometry, add = TRUE, col = "blue", lwd = 3)
Try this. To adapt the example to your case you have to convert the coordinate system of the roads to the points shapefile (or the other way around):
library(geosphere)
library(sf)
library(stplanr)
roads <- st_read("Example/Roads/Roads.shp")
points <- st_read("Example/Points/Points.shp")
# Convert roads to coordinate system of points
roads_trf <- st_transform(roads, st_crs(points))
# Convert to points to SpatialPointsDataframe
points_sp <- as(points, "Spatial")
from <- c(-49.95058, -24.77502) # Feature 1
to <- c(-49.91084, -24.75200) # Feature 9
p <- SpatialLinesNetwork(roads_trf, uselonglat = FALSE, tolerance = 0)
r <- route_local(p, from, to)
plot(p)
plot(r$geometry, add = TRUE, col = "red", lwd = 5)
plot(points_sp[c(3, 4), ], add = TRUE)
r2 <- route_local(sln = p, points[3, ], points[4, ])
plot(r2$geometry, add = TRUE, col = "blue", lwd = 3)
Is it possible in R to create a color key like the one below? (this one comes from the software Grid Analysis and Display System - Grads).
There are two features that I can't reproduce in R:
The sequence is non linear however it is displayed as if
Values bigger than 200 are grey / Values smaller than 0 are white
I'm using levelplot from rastervis that plots rasters using the lattice levelplot:
require(raster)
require(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F","#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600",
"#D53E4F","#FF6A6A"))
my.at = c(0,1,5,10,15,20,25,30,40,50,75,100,150,200)
myColorkey <- list(at=my.at,
space="bottom",
labels=list(at=my.at))
p=levelplot(r, par.settings=mapTheme,at = my.at, colorkey=myColorkey,margin=F)
print(p)
The result:
As you can see, both values smaller than 0 and bigger than 200 are white, I've no idea how to set values bigger than or smaller than a certain value to appear as a specific color. Morover, how can I make the space between consecutive thick marks in the color key to have the same size although the intervals are not the same?
This is a workaround for equally sized intervals for non linear sequences:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F",
"#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600", "#D53E4F","#FF6A6A"))
my.at=c(0,1,5,10,15,20,25,30,40,50,75,100,150,200)
my.brks=seq(0, 200, by=15)
myColorkey <- list(at=my.brks, labels=list(at=my.brks, labels=my.at), space="bottom")
p=levelplot(r, par.settings=mapTheme, at=my.at, colorkey=myColorkey, margin=F)
print(p)
This could be a solution for values smaller 0 and greater than 200:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
mapTheme <- rasterTheme(region=c('white','#EEF7FA','#D6F8F7',"#BEDAFF",'#5DA4FF',"#0000FF","#D4F9E2","#00FF7F",
"#008000","#FFFF00","#FFD27F", "#FFB732" ,"#EE7600", "#D53E4F","#FF6A6A", "gray"))
max(values(r))
min(values(r))
my.at=c(min(values(r)), 0,1,5,10,15,20,25,30,40,50,75,100,150,200, max(values(r)))
my.brks=seq(0, 200, by=13)
myColorkey <- list(at=my.brks, labels=list(at=my.brks, labels=c(-276,0,1,5,10,15,20,25,30,40,50,75,100,150,200, 388)), space="bottom")
p=levelplot(r, par.settings=mapTheme, at=my.at, colorkey=myColorkey, margin=F)
print(p)
Your colors are not progressing from light to dark. You can use the RColorBrewer package to fix this.
library(RColorBrewer)
reds = brewer.pal(5, "YlOrRd")
greens = brewer.pal(3, "Greens")
blues = brewer.pal(5, "Blues")
mapTheme <- rasterTheme(region=c('white', blues, greens, reds, "gray"))
This is a very helpful workaround. While not addressing question 1, something I found useful for question 2 (adding triangles for values below/above the limits of the colorbar range) can be achieved by adding this:
library(s2dverification)
data_array <- array(Z, dim = c(length(X), length(Y)))
PlotEquiMap(data_array, X, Y,bar_limits=c(0,200),col_inf='white',col_sup='gray')
raster with colorbar
Another solution with updates to lattice:
library(raster)
library(rasterVis)
set.seed(200)
X = seq(-40,0,by=1)
Y = seq(-60,-40,by=1)
grid = expand.grid(list(X=X,Y=Y))
Z = rnorm(nrow(grid),mean=10,sd=100)
data = data.frame(grid,Z)
r = rasterFromXYZ(data)
levelplot(r, margin=F, at=c(-Inf, seq(0, 200, 20), Inf),
colorkey = list(tri.lower = TRUE, tri.upper = TRUE))
As long as you add "-Inf" and "Inf" to your at definition, the option to add triangles to the colorbar is activated.
I'm trying to connect every point in my array with all other points in this array using line segment and write some text slightly above this lines. So, I want to achieve next:
I already tried to use segments() and lines() functions, but I don't know how can I do exactly what I described.
And as I said, now I have only array of coordinates and array of strings which I want to write.
How can I achieve this(It will be good if I will need to use only standard R libraries)?
UPD:
dataset.csv:
,A,B,C
A,0,1,2
B,1,0,3
C,2,3,0
script.r:
myDataset <- read.csv("dataset.csv")
row.names(myDataset) <- myDataset[, 1]
myDataset <- myDataset[, -1]
d <- dist(myDataset)
fit <- cmdscale(d,eig=TRUE, k=2)
x <- fit$points[,1]
y <- fit$points[,2]
Here's an example that uses combn to generate combinations of two points and then draw lines between them and to compute distances and write them in the middle too.
#DATA
set.seed(42)
df = data.frame(x = rnorm(4), y = rnorm(4))
#DRAW POINTS
plot(df)
#DRAW LINES
combn(1:NROW(df), 2, function(x)
lines(df[x,]), simplify = FALSE)
#WRITE TEXT
combn(1:NROW(df), 2, function(x)
text(x = mean(df[x,1]), #calculate center point x-value in the line
y = mean(df[x,2]), #calculate center point y-value in the line
labels = round(dist(df[x,]), 2), #calculate distance to write
srt = 180 * atan(diff(df[x, 2])/diff(df[x,1]))/pi, #calculate rotation angle of text
pos = 3, #place text slightly above given x and y
font = 2), #bold text
simplify = FALSE)
UPDATE
myDataset <- read.csv(strip.white = TRUE, stringsAsFactors = FALSE, header = TRUE, text = ",A,B,C
A,0,1,2
B,1,0,3
C,2,3,0")
row.names(myDataset) <- myDataset[, 1]
myDataset <- myDataset[, -1]
d <- dist(myDataset)
fit <- cmdscale(d,eig=TRUE, k=2)
x <- fit$points[,1]
y <- fit$points[,2]
df = data.frame(x, y)
#DRAW POINTS
plot(df, asp = 1)
text(x = df[,1], y = df[,2], labels = rownames(df), pos = 1)
#Create a list of combination of indices
temp = combn(1:NROW(df), 2, simplify = FALSE)
#DRAW LINES
sapply(temp, function(i) lines(df[i,]))
#WRITE TEXT
sapply(temp, function(x)
text(x = mean(df[x,1]), #calculate center point x-value in the line
y = mean(df[x,2]), #calculate center point y-value in the line
labels = myDataset[cbind(which(row.names(myDataset) == row.names(df)[x[1]]),
which(colnames(myDataset) == row.names(df)[x[2]]))],
srt = 180 * atan(diff(df[x, 2])/diff(df[x,1]))/pi, #calculate rotation angle of text
pos = 3, #place text slightly above given x and y
font = 2), #bold text
simplify = FALSE)
Trying to achieve this with graphics primitives (such as lines) is bound to be a pain.
Use a dedicated library for graph plotting instead, e.g. ggraph. The “Edges” vignette has an example with edge labels:
ggraph(simple, layout = 'graphopt') +
geom_edge_link(aes(label = type),
angle_calc = 'along',
label_dodge = unit(2.5, 'mm'),
arrow = arrow(length = unit(4, 'mm')),
end_cap = circle(3, 'mm')) +
geom_node_point(size = 5)
The one drawback: ggraph doesn’t allow you to explicitly set the node positions; however, you can manipulate them manually.
I found many resources on how to draw Venn diagrams in R. Stack Overflow has a lot of them. However, I still can't draw my diagrams the way I want. Take the following code as an example:
library("VennDiagram")
A <- 1:4
B <- 3:6
d <- list(A, B)
vp <- venn.diagram(d, fill = c("white", "white"), alpha = 1, filename = NULL,
category.names=c("A", "B"))
grid.draw(vp)
I want the intersection between the sets to be red. However, if I change any of the white colors to red, I get the following:
vp_red <- venn.diagram(d, fill = c("red", "white"), alpha = 1, filename = NULL,
category.names=c("A", "B"))
grid.draw(vp_red)
That's not quite what I want. I want only the intersection to be red. If I change the alpha, this is what I get:
vp_alpha <- venn.diagram(d, fill = c("red", "white"), alpha = 0.5, filename = NULL,
category.names=c("A", "B"))
grid.draw(vp_alpha)
Now I have pink in my intersection. This is not what I want as well. What I want is something like this image from Wikipedia:
How can I do this? Maybe VennDiagram package can't do it and I need some other package, but I've been testing different ways to do it, and I'm not being able to find a solution.
I will show two different possibilities. In the first example, polyclip::polyclip is used to get the intersection. In the second example, circles are converted to sp::SpatialPolygons and we get the intersection using rgeos::gIntersection. Then we re-plot the circles and fill the intersecting area.
The resulting object when using venn.diagram is
"of class gList containing the grid objects that make up the diagram"
Thus, in both cases we can grab relevant data from "vp". First, check the structure and list the grobs of the object:
str(vp)
grid.ls()
# GRID.polygon.234
# GRID.polygon.235
# GRID.polygon.236 <~~ these are the empty circles
# GRID.polygon.237 <~~ $ col : chr "black"; $ fill: chr "transparent"
# GRID.text.238 <~~ labels
# GRID.text.239
# GRID.text.240
# GRID.text.241
# GRID.text.242
1. polyclip
Grab x- and y-values, and put them in the format required for polyclip:
A <- list(list(x = as.vector(vp[[3]][[1]]), y = as.vector(vp[[3]][[2]])))
B <- list(list(x = as.vector(vp[[4]][[1]]), y = as.vector(vp[[4]][[2]])))
Find intersection:
library(polyclip)
AintB <- polyclip(A, B)
Grab labels:
ix <- sapply(vp, function(x) grepl("text", x$name, fixed = TRUE))
labs <- do.call(rbind.data.frame, lapply(vp[ix], `[`, c("x", "y", "label")))
Plot it!
plot(c(0, 1), c(0, 1), type = "n", axes = FALSE, xlab = "", ylab = "")
polygon(A[[1]])
polygon(B[[1]])
polygon(AintB[[1]], col = "red")
text(x = labs$x, y = labs$y, labels = labs$label)
2. SpatialPolygons and gIntersection
Grab the coordinates of the circles:
# grab x- and y-values from first circle
x1 <- vp[[3]][["x"]]
y1 <- vp[[3]][["y"]]
# grab x- and y-values from second circle
x2 <- vp[[4]][["x"]]
y2 <- vp[[4]][["y"]]
Convert points to SpatialPolygons and find their intersection:
library(sp)
library(rgeos)
p1 <- SpatialPolygons(list(Polygons(list(Polygon(cbind(x1, y1))), ID = 1)))
p2 <- SpatialPolygons(list(Polygons(list(Polygon(cbind(x2, y2))), ID = 2)))
ip <- gIntersection(p1, p2)
Plot it!
# plot circles
plot(p1, xlim = range(c(x1, x2)), ylim = range(c(y1, y2)))
plot(p2, add = TRUE)
# plot intersection
plot(ip, add = TRUE, col = "red")
# add labels (see above)
text(x = labs$x, y = labs$y, labels = labs$label)
I'm quite sure you could work directly on the grobs using clipping functions in grid or gridSVG package.
It's very easy in eulerr R package
library(eulerr)
plot(euler(c("A"=5,"B"=4,"A&B"=2)),quantities = TRUE,fills=c("white","white","red"))
euler set colours