I'm looking for some help creating a "Canopy Height Model (CHM)-Zmax-curve/line" on my las-plots. I extracted a transect with the lidR package
las_tr <- clip_transect(las, p1, p2, width = 3, xz=T)
And I plotted it with ggplot
ggplot(las_tr#data, aes(X,Z, color = Z)) +
geom_point(size = 0.5) +
coord_equal() +
theme_minimal() +
scale_color_gradientn(colours = height.colors(50)) +
xlim(-80,0) + ylim(0,45) +
labs(title = "2D profile", subtitle= paste(round(x[i]),round(y[i])))
I have this
But I would like something like this
I hope someone can help me.
library(lidR)
library(dplyr)
library(ggplot2)
LASfile <- system.file("extdata", "Megaplot.laz", package="lidR")
las = readLAS(LASfile, select = "xyz")
p1 <- c(684800, y = 5017800)
p2 <- c(684900, y = 5017900)
tr <- clip_transect(las, p1, p2, width = 4, xz = T)
DSM <- tr#data[ , .(Z = max(Z)), by = list(X = plyr::round_any(X, 1))]
ggplot(tr#data) +
aes(X,Z, color = Z) +
geom_point(size = 0.5) +
geom_line(data = DSM, color = "black") +
coord_equal() +
theme_minimal() +
scale_color_gradientn(colours = height.colors(50))
Created on 2021-05-27 by the reprex package (v2.0.0)
Related
I have a code to plot histogram in R that works fine:
fun_hist <- function(c, E, HS, log_EC_50) {
df <- data.frame(log_c = c, response = V({{c}}, {{E}}, {{HS}}, {{log_EC50}}))
ggplot2::ggplot(df, aes( response)) + geom_histogram(binwidth=0.03)
}
I want to correct my histogram so that its bars have a graphic design as in the attached photo.
This looks pretty similar to my eye:
library(ggplot2)
set.seed(1)
df <- data.frame(response = rnorm(25000, 15, 2))
ggplot(df, aes(response)) +
geom_histogram(binwidth = 0.5, color = 'black', fill = "#547fbf") +
xlim(c(0, 24)) +
labs(x = NULL, y = NULL) +
theme_bw(base_size = 16)
Created on 2022-11-03 with reprex v2.0.2
I have written the following code to show four plots
Scores <- as.factor(sampleXYPCA$PC1)
p1 <- ggplot(sampleXYPCA, aes(x = X_UTM_, y = Y_UTM_, color=PC1)) +
geom_point( ) + scale_color_gradient(low="blue", high="red") +
geom_polygon(data = xy, aes(x = xBounds, y = yBounds),
color="orange", alpha = 0.2, show.legend = FALSE) + labs( x ="x (m) ", y = "y (m)") +
theme(axis.text.x=element_blank(),axis.text.y=element_blank(),
axis.ticks.x=element_blank(),axis.ticks.y=element_blank(),
legend.position="right", legend.direction="vertical")
Scores <- as.factor(sampleXYPCA$PC2)
p2 <- ggplot(sampleXYPCA, aes(x = X_UTM_, y = Y_UTM_, color=PC2)) +
geom_point( ) + scale_color_gradient(low="blue", high="red") +
geom_polygon(data = xy, aes(x = xBounds, y = yBounds),
color="orange", alpha = 0.2, show.legend = FALSE) + labs( x ="x (m) ", y = "y (m)") +
theme(axis.text.x=element_blank(),axis.text.y=element_blank(),
axis.ticks.x=element_blank(),axis.ticks.y=element_blank())
Scores <- as.factor(sampleXYPCA$PC3)
p3 <- ggplot(sampleXYPCA, aes(x = X_UTM_, y = Y_UTM_, color=PC3)) +
geom_point( ) + scale_color_gradient(low="blue", high="red") +
geom_polygon(data = xy, aes(x = xBounds, y = yBounds),
color="orange", alpha = 0.2, show.legend = FALSE) + labs( x ="x (m) ", y = "y (m)") +
theme(axis.text.x=element_blank(),axis.text.y=element_blank(),
axis.ticks.x=element_blank(),axis.ticks.y=element_blank())
Scores <- as.factor(sampleXYPCA$PC4)
p4 <- ggplot(sampleXYPCA, aes(x = X_UTM_, y = Y_UTM_, color=PC4)) +
geom_point( ) + scale_color_gradient(low="blue", high="red") +
geom_polygon(data = xy, aes(x = xBounds, y = yBounds),
color="orange", alpha = 0.2, show.legend = FALSE) + labs( x ="x (m) ", y = "y (m)") +
theme(axis.text.x=element_blank(),axis.text.y=element_blank(),
axis.ticks.x=element_blank(),axis.ticks.y=element_blank())
figure <- ggarrange(p1, p2,p3,p4 + font("x.text", size = 10),
ncol = 2, nrow = 2)
show(figure)
I have two issues that I am trying to fix:
I want to remove the values at x-axis at the last plot (PC4), as in the previous plots.
I want to set the same scale at the colour bar for all plots (from -3,3)
For convenience, I copy the first lines of the dataframe (sampleXYPCA) that I am using:
X_UTM_ Y_UTM_ PC1 PC2 PC3 PC4
1 6501395 1885718 -1.37289727 2.320717816 0.93434761 1.24571643
2 6500888 1885073 -1.22111900 4.021127182 1.89434320 1.26801802
3 6500939 1885241 -0.58212873 3.301443355 -1.79458946 0.63329006
4 6500965 1884644 -1.13872381 4.521231473 2.43925215 0.53962882
5 6501608 1884654 -0.24075643 5.871225725 0.69257238 0.89294843
6 6501407 1883939 -0.15938861 3.965081981 1.40970861 -0.77825417
7 6501581 1883630 -0.59187192 2.904278269 0.40655574 -1.66513966
Using facet_wrap and adding an aerial basemap for visualisation (personal prefence when plotting spatial data):
#sample data as dput
dt <- structure(list(x = c(6501395, 6500888, 6500939, 6500965, 6501608,
6501407, 6501581), y = c(1885718, 1885073, 1885241, 1884644,
1884654, 1883939, 1883630), pca1 = c(-1.37289727, -1.221119,
-0.58212873, -1.13872381, -0.24075643, -0.15938861, -0.59187192
), pca2 = c(2.320717816, 4.021127182, 3.301443355, 4.521231473,
5.871225725, 3.965081981, 2.904278269), pca3 = c(0.93434761,
1.8943432, -1.79458946, 2.43925215, 0.69257238, 1.40970861, 0.40655574
), pca4 = c(1.24571643, 1.26801802, 0.63329006, 0.53962882, 0.89294843,
-0.77825417, -1.66513966)), class = "data.frame", row.names = c(NA,
-7L))
#load libraries
library(sf)
library(tidyr)
library(ggplot2)
library(ggspatial)
library(tmaptools)
#pivot_longer on PCA
dt <- pivot_longer(dt, cols = c("pca1", "pca2", "pca3", "pca4"), names_to = "PCA", values_to = "Score")
#convert to sf object (assumed that you use espg:32629, change to whatever you use as the coordinate system)
dt <- st_as_sf(dt, coords = c("x", "y"), crs = st_crs(32629))
#load a basemap
basemap <- read_osm(dt, type = "https://mt1.google.com/vt/lyrs=y&x={x}&y={y}&z={z}", zoom = 15, ext = 1.2)
#plot
ggplot() + layer_spatial(basemap) + geom_sf(data = dt, aes(col = Score), size = 3) + facet_wrap(~PCA) + labs( x ="x (m) ", y = "y (m)") +
theme_bw() + theme(axis.text.x=element_blank(),axis.text.y=element_blank(),
axis.ticks.x=element_blank(),axis.ticks.y=element_blank()) +
scale_x_continuous(expand = c(0.01,0.01)) +
scale_y_continuous(expand = c(0.01,0.01)) +
scale_color_gradient(low="blue", high="red")
Using some dummy data to illustrate a possible solution, this may help.
The issue in the OP's question seems to be with the call to ggarrange. Check out the documentation with ?ggarrange
library(ggpubr)
library(ggplot2)
p1 <-
ggplot(mtcars, aes(mpg, wt))+
geom_point() +
theme(axis.text.x=element_blank(),axis.text.y=element_blank(),
axis.ticks.x=element_blank(),axis.ticks.y=element_blank())
figure <-
ggarrange(p1, p1, p1, p1,
font.label = list(size = 10),
ncol = 2,
nrow = 2)
show(figure)
Created on 2021-12-10 by the reprex package (v2.0.1)
Let's consider very simple plot and try to name it
library(ggplot2)
plot_1 <- ggplot() + aes(x = 1:10, y = 1:10) + geom_line()
patchwork::wrap_plots(plot_1, plot_1, plot_1, ncol = 1, nrow = 3) + ggtitle("a")
However, this code will only name the very last plot:
Is there any possibility that I can have a name for whole plot and not for only the last one ? i.e. to have a name in the place of black rectangle
you want plot_annotation
library(ggplot2)
library(patchwork)
plot_1 <- ggplot() + aes(x = 1:10, y = 1:10) + geom_line()
wrap_plots(rep(list(plot_1), 4), ncol = 2, nrow = 2) +
plot_annotation(title = "a")&
theme(plot.title = element_text(hjust = .5))
Created on 2021-03-03 by the reprex package (v1.0.0)
I need to delete that symbol 'a' that is coming in the legend, plus I would like to know if there is a possibility to place the label on the top of the bars.
This my example file:
Residue,Position,Weight,SVM Count,Odd,Ttest,lower,upper,Resistance
G163R,163,0.357,49,19.9453848,6.978518E-82,5.6628402,70.2925768,Accessory
V165I,165,0.268,49,2.98167788,1.60934E-80,1.25797484,7.06728692,Novel
N155H,155,0.253,50,38.6089584,1.089188E-83,9.5815554,155.7070612,Major
library(ggplot2)
m <- read.csv('example.csv', header=T, row.names=1)
boxOdds = m$Odd
df <- data.frame(
yAxis = length(boxOdds):1,
boxnucleotide = m$Position,
boxCILow = m$lower,
boxCIHigh = m$upper,
Mutation = m$Resistance)
ticksy<-c(seq(0,0.3,by=.1), seq(0, 1, by =.5), seq(0, 20, by =5), seq(0, 150, by =50))
ticksx<-c(seq(0,300,by=25))
p <- ggplot(df, aes(x = boxnucleotide, y = boxOdds, colour=Mutation,label=rownames(m)))
p1 <- p + geom_errorbar(aes(ymax = boxCIHigh, ymin = boxCILow), size = .5, height = .01) +
geom_point(size = 1) +
theme_bw() +
theme(panel.grid.minor = element_blank()) +
scale_y_continuous(breaks=ticksy, labels = ticksy) +
scale_x_continuous(breaks=ticksx, labels = ticksx) +
coord_trans(y = "log10") +
ylab("Odds ratio (log scale)") +
scale_color_manual(values=c("#00BFC4","#F8766D","#619CFF")) +
xlab("Integrase nucleotide position") +
geom_text(size=4,hjust=0, vjust=0)+
theme(legend.position = c(0.9, 0.9))
p1
I already tried all possible solutions from Remove 'a' from legend when using aesthetics and geom_text but none worked out
I have the following data:
groups = c(rep(1,5),rep(2,5),rep(3,5))
scores = c(seq(1,5),seq(1,5),seq(1,5))
times1 = rnorm(15, mean = 3 , sd = 2)
times2 = rnorm(15, mean = 1 , sd = 0.5)
df = data.frame(groups,scores, times1,times2)
and I have the following plot
df = data.frame(groups,scores, times1,times2)
plt = ggplot(df, aes(x = scores, y = times1, color = factor(groups)))
plt = plt + geom_point(cex = 4) + geom_line() + theme_bw()
plt = plt + geom_point(aes(x = scores, y=times2),pch = 23, cex =4)+ geom_line(aes(x = scores, y=times2))
plt = plt + facet_wrap(~ groups, ncol = 4, scales = "free_x")
plt
which results in
How can I add a guide for the diamond points, and how can I change the title of each of the corresponding guides.
If you want a legend for something, it should be specified as an aesthetic. Perhaps something like
ggplot(df, aes(x = scores, color = factor(groups))) +
geom_point(aes(y=times1, shape="times1"), cex = 4) +
geom_line(aes(y=times1)) +
geom_point(aes(y=times2, shape="times2"),cex =4) +
geom_line(aes(y=times2)) +
facet_wrap(~ groups, ncol = 4, scales = "free_x") + theme_bw()
Rather than mannally adding layers, it would be even better if you properly rehaped your data to a format that ggplot perfers
ggplot(reshape2::melt(df, id=c("groups","scores")),
aes(x=scores,y=value, shape=variable, color=factor(groups))) +
geom_point() +
geom_line() +
facet_wrap(~groups)