Overlap heatmaps in R - r

I'm new to R and I tried to solve the problem looking for other questions, but I coulndn't. I have a problem with overlapping different heatmaps I created using ggplot2 and ggmap. When plotting the maps singularly it works. Only when I try to plot them together the error :
Scale for 'fill' is already present. Adding another scale for 'fill', which will replace the existing scale.
appears.
This is my code:
us_map_g_str <- get_map(location = "detroit", zoom = 10)
ggmap(us_map_g_str, extent = "device") +
geom_density2d(data = data1,
aes(x=as.numeric(lon), y = as.numeric(lat)),
size = 0.3) +
stat_density2d(data = data1,
aes(x = as.numeric(lon), y = as.numeric(lat),
fill = ..level.., alpha = ..level..),
size = 0.3, bins = 500, geom = "polygon") +
scale_fill_gradient(low = "green", high = "red") +
scale_alpha(range = c(0, 0.3), guide = FALSE) +
geom_density2d(data = data2,
aes(x = as.numeric(lon), y = as.numeric(lat)),
size = 0.3) +
stat_density2d(data = data2,
aes(x = as.numeric(lon), y = as.numeric(lat),
fill = ..level.., alpha = ..level..),
size = 0.3, bins = 500, geom = "polygon") +
scale_fill_gradient(low = "blue", high = "black") +
scale_alpha(range = c(0, 0.3), guide = FALSE) +
geom_density2d(data = data3,
aes(x = as.numeric(lon), y = as.numeric(lat)),
size = 0.3) +
stat_density2d(data = data3,
aes(x = as.numeric(lon), y = as.numeric(lat),
fill = ..level.., alpha = ..level..),
size = 0.3, bins = 500, geom = "polygon") +
scale_fill_gradient(low = "yellow", high = "orange") +
scale_alpha(range = c(0, 0.3), guide = FALSE)
When I run it, he applies to every heat map the the last colour, in this case yellow-orange.
This is what I get:

Related

How to present the results of a dataframe in a serial scale using ggplot as in the example attached?

I have this data frame :
Raw.Score = c(0,1,2,3,4,5,6,7,8)
Severity = c(-3.56553994,-2.70296933,-1.63969850,-0.81321707,-0.04629182,
0.73721320,1.61278518,2.76647043,3.94804472)
x = data.frame(Raw.Score = Raw.Score, Severity = Severity)
Raw.score are raw numbers from 0 to 8 (let's consider them as the labels of the severity numbers)
Severity are relative numbres that represent the locations of the scores in the diagram
I want to graphically present the results as in the following example using ggplot (the example includes different numbers but I want something similar)
As a fun exercise in ggplot-ing here is one approach to achieve or come close to your desired result.
Raw.Score = c(0,1,2,3,4,5,6,7,8)
Severity = c(-3.56553994,-2.70296933,-1.63969850,-0.81321707,-0.04629182,
0.73721320,1.61278518,2.76647043,3.94804472)
dat <- data.frame(Raw.Score, Severity)
library(ggplot2)
dat_tile <- data.frame(
Severity = seq(-4.1, 4.1, .05)
)
dat_axis <- data.frame(
Severity = seq(-4, 4, 2)
)
tile_height = .15
ymax <- .5
ggplot(dat, aes(y = 0, x = Severity, fill = Severity)) +
# Axis line
geom_hline(yintercept = -tile_height / 2) +
# Colorbar
geom_tile(data = dat_tile, aes(color = Severity), height = tile_height) +
# Sgements connecting top and bottom labels
geom_segment(aes(xend = Severity, yend = -ymax, y = ymax), color = "orange") +
# Axis ticks aka dots
geom_point(data = dat_axis,
y = -tile_height / 2, shape = 21, stroke = 1, fill = "white") +
# ... and labels
geom_text(data = dat_axis, aes(label = Severity),
y = -tile_height / 2 - .1, vjust = 1, fontface = "bold") +
# Bottom labels
geom_label(aes(y = -ymax, label = scales::number(Severity, accuracy = .01))) +
# Top labels
geom_point(aes(y = ymax, color = Severity), size = 8) +
geom_text(aes(y = ymax, label = Raw.Score), fontface = "bold") +
# Colorbar annotations
annotate(geom = "text", fontface = "bold", label = "MILD", color = "black", x = -3.75, y = 0) +
annotate(geom = "text", fontface = "bold", label = "SEVERE", color = "white", x = 3.75, y = 0) +
# Fixing the scales
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(limits = c(-ymax, ymax)) +
# Color gradient
scale_fill_gradient(low = "orange", high = "red", guide = "none") +
scale_color_gradient(low = "orange", high = "red", guide = "none") +
# Get rid of all non-data ink
theme_void() +
# Add some plot margin
theme(plot.margin = rep(unit(10, "pt"), 4)) +
coord_cartesian(clip = "off")

ggplot2 scale_color_identity() how to change linestyle and design of the legend?

I coded the following ggplot. The problem is that the design of the legend is flawed: The elements of the legend are interconnected with what appears to be dashed lines. How can this be removed? And furthermore, navy should be a dashed line, but it is shown as a solid one. Is there a possibility to change that? This is my code:
plot1 <- ggplot() +
geom_line(aes(x = datacom$Datum , y = datacom$`CDU/CSU`, colour = "black"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$SPD, colour = "red"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$GRÜNE, col = "green"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$FDP, col = "gold1"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$`Linke/PDS`, col = "darkred"),size=0.8) +
geom_line(aes(x = datacom$Datum[154:168] , y = datacom$Piraten[154:168], col = "tan1"),size=0.8) +
geom_line(aes(x = datacom$Datum[169:272] , y = datacom$AfD[169:272], col = "blue"),size=0.8) +
geom_line(aes(x = datacom$Datum , y = datacom$Sonstige, col = "grey"),size=0.8) +
geom_vline(aes(xintercept = datacom$Datum[263], color = "navy"), linetype="longdash",size = 0.5)+
geom_vline(xintercept = datacom$Datum[215], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[167], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[127], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[79], color = "navy", size = 0.5,linetype="longdash")+
geom_vline(xintercept = datacom$Datum[44], color = "navy", size = 0.5,linetype="longdash")+
scale_color_identity(name = NULL, labels = c(black = "CDU/CSU", red = "SPD",green="Die Grünen",gold1="FDP",darkred = "Die Linke/PDS",tan1="Piraten",blue="AfD",grey="Sonstige",navy="Bundestagswahlen"), guide = "legend") +
theme_bw() +
theme(legend.position = "bottom") +
theme(axis.text.x = element_text(angle = 90)) +
labs(title="Forsa-Sonntagsfrage Bundestagswahl in %")+ylab("Prozent")+xlab("Jahre")
plot1
Thanks in advance
Your code has a lot of unnecessary repetition and you are not taking advantage of the syntax of ggplot.
The reason for the vertical dashed lines in the legend is that one of your geom_vline calls includes a color mapping, so its draw key is being added to the legend. You can change its key_glyph to draw_key_path to fix this. Note that you only need a single geom_vline call, since you can have multiple x intercepts.
ggplot(datacom, aes(x = Datum)) +
geom_line(aes(y = `CDU/CSU`, colour = "black"), size = 0.8) +
geom_line(aes(y = SPD, colour = "red"), size = 0.8) +
geom_line(aes(y = GRÜNE, col = "green"), size = 0.8) +
geom_line(aes(y = FDP, col = "gold1"), size = 0.8) +
geom_line(aes(y = `Linke/PDS`, col = "darkred"),size = 0.8) +
geom_line(aes(y = Piraten, col = "tan1"),
data = datacom[154:168,], size = 0.8) +
geom_line(aes(y = AfD, col = "blue"),
data = datacom[169:272,], size = 0.8) +
geom_line(aes(y = Sonstige, col = "grey"), size = 0.8) +
geom_vline(data = datacom[c(263, 215, 167, 127, 79, 44),],
aes(xintercept = Datum, color = "navy"), linetype = "longdash",
size = 0.5, key_glyph = draw_key_path)+
scale_color_identity(name = NULL,
labels = c(black = "CDU/CSU", red = "SPD",
green = "Die Grünen", gold1 = "FDP",
darkred = "Die Linke/PDS",
tan1 = "Piraten", blue = "AfD",
grey = "Sonstige",
navy = "Bundestagswahlen"),
guide = "legend") +
theme_bw() +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 90)) +
labs(title = "Forsa-Sonntagsfrage Bundestagswahl in %",
y = "Prozent",
x = "Jahre")
An even better way to make your plot would be to pivot the data into long format. This would mean only a single geom_line call:
library(tidyverse)
datacom %>%
mutate(Piraten = c(rep(NA, 153), Piraten[154:168],
rep(NA, nrow(datacom) - 168)),
AfD = c(rep(NA, 168), AfD[169:272],
rep(NA, nrow(datacom) - 272))) %>%
pivot_longer(-Datum, names_to = "Series") %>%
ggplot(aes(x = Datum, y = value, color = Series)) +
geom_line(size = 0.8, na.rm = TRUE) +
geom_vline(data = datacom[c(263, 215, 167, 127, 79, 44),],
aes(xintercept = Datum, color = "Bundestagswahlen"),
linetype = "longdash", size = 0.5, key_glyph = draw_key_path) +
scale_color_manual(name = NULL,
values = c("CDU/CSU" = "black", SPD = "red",
"GRÜNE" = "green", FDP = "gold1",
"Linke/PDS" = "darkred",
Piraten = "tan1", AfD = "blue",
Sonstige = "grey",
"Bundestagswahlen" = "navy")) +
theme_bw() +
theme(legend.position = "bottom",
axis.text.x = element_text(angle = 90)) +
labs(title = "Forsa-Sonntagsfrage Bundestagswahl in %",
y = "Prozent",
x = "Jahre")
Data used to create plot
Obviously, I had to create some data to get your code to run, since you didn't supply any. Here is my code for creating the data
var <- seq(5, 15, length = 280)
datacom <- data.frame(Datum = seq(as.POSIXct("1999-01-01"),
as.POSIXct("2022-04-01"), by = "month"),
`CDU/CSU` = 40 + cumsum(rnorm(280)),
SPD = 40 + cumsum(rnorm(280)),
GRÜNE = rpois(280, var),
FDP = rpois(280, var),
`Linke/PDS` = rpois(280, var),
Piraten = rpois(280, var),
AfD = rpois(280, var),
Sonstige = rpois(280, var), check.names = FALSE)

how to ggplot with upper and lower bound as shaded using facet_wrap in R?

I am trying to automate the process of plotting data using ggplot and the facet_wrap functionality. I want a single y-axis label instead individual plot Ob (i.e., A_Ob, B_ob etc) and also a single X-axis not all the plots having label for x-axis such as below. Below is my sample code using gridextra package. However, i would like to do it through facet_wrap as i have many other plots to draw which i think will save me sometime.
graphics.off()
rm(list = ls())
library(tidyverse)
library(gridExtra)
G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
Pos = 1:1000)
A1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = A_Ob), col = "black")+
geom_line(aes(y = A_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")
B1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = B_Ob), col = "black")+
geom_line(aes(y = B_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")
C1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = C_Ob), col = "black")+
geom_line(aes(y = C_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")
D1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = D_Ob), col = "black")+
geom_line(aes(y = D_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")
grid.arrange(A1,B1,C1,D1, nrow = 4)
Here is the result of the code
You need to reshape your dataframe into a longer format and separate values for Ob, Sim, upper and lower.
Using the function melt from data.table package can help you to achieve this:
library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))
levels(g.m$variable) <- c("A","B","C","D")
Pos variable OBS SIM UP LOW
1: 1 A 5.965488 29.167666 26.66783 29.97259
2: 2 A 23.855719 8.570245 43.75830 30.65616
3: 3 A 16.947887 51.201047 15.20758 39.76122
4: 4 A 49.883306 3.715319 34.38066 20.73177
5: 5 A 5.021938 3.102880 30.05036 32.05123
6: 6 A 19.887176 15.400853 53.67156 28.54982
and now, you can plot it:
library(ggplot2)
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_grid(variable~.)
EDIT: Adding annotations & renaming labels
To rename and replace facet labels, you can re-define levels of variable and use facet_wrap instead of facet_grid using ncol = 1 as argument.
To add multiple annotations on a single panel, you need to define a dataframe that you will use in geom_text.
Altogether, you have to do:
# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")
# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
x = c(740,760),
y = c(65,65),
hjust = c(1,0),
variable = factor("M1", levels = c("M1","M2","M3","M4")))
# Plotting
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_wrap(variable~., ncol = 1)+
theme(strip.text.x = element_text(hjust = 0),
strip.background = element_rect(fill = "white"))+
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")
Does it look what you are expecting ?

R add legend for multiple layers

I want to add a legend for the plot, but it doesn't work,
can anyone please help me to see where it went wrong.
this is the code.
ggplot(data = dfNorm1, aes(x = X)) +
geom_col(aes(y = Government_suppliment),
fill = "#0000FF", color = "white", alpha = 0.8) +
geom_smooth(data = subset(dfNorm1,X >= 24), aes(y = Government_suppliment),
method = "lm", se = FALSE, color = "#FF4040",
linetype = "dashed", size = 0.7) +
geom_smooth(data = subset(dfNorm1, X <= 24), aes(y = Government_suppliment),
method = "lm", se = FALSE, color = "#FF4040",
linetype = "dashed", size = 0.7) +
geom_vline(xintercept = 24.5, size = 0.8, alpha = 0.8) +
geom_line(aes(y = Poverty_funds),
color = "#FF0000", size = 1, alpha = 0.7) +
geom_line(aes(y = MLI), color = "#EF3EFF", size = 1,
alpha = 0.8) +
scale_fill_manual(name = "",values = c("bar.label" = "#0000FF")) +
scale_color_manual(name = "", values = c("line.label1" = "#FF0000", "line.label2" = "#EF3EFF",
"line.labeld" = "#FF4040"))
You usually can produce a legend by setting aes(color = column_title) in one of your geom layers. This code doesn't particularly make sense because you are referencing more than one y-axis without creating a second y-axis (a bad habit if you are trying to do so). Is there a way you can post more relevant code or a reproducible example so people can see exactly what you're trying to do?

how to plot a network on to a geographic map in R?

Hi, I want to get a spatial network like the attach, but I don't know how to make, I have tried ggplot, ggraph, igraph with no nice result.
Could any one like to share some codes or give me some suggustions?
I tried ggplot2 method, but raised error (Error in FUN(X[[i]], ...) : object 'to.lon' not found).
ggplot(chicken_QH,
aes(x = from.lon, y = from.lat, xend = to.lon, yend = to.lat)) +
geom_edges(aes(size = chickenBatchs/10000,
alpha = chickenBatchs/10000,
color = type),
curvature = 0.3,
arrow = arrow(length = unit(10, "pt"),
type = "closed")) +
geom_nodes(color = "gold", size = 10, alpha = .5) +
geom_nodes(color = "gold", size = 3) +
geom_nodetext(aes(label = from), fontface = "bold") +
scale_linetype_discrete(guide = F) +
geom_polygon(data = china_blank,
aes(x = long, y = lat, group = group),
fill = "white",
col = "grey",
size = rel(.3)) +
coord_quickmap()
also, with the basic plot method, although it does work, but the the polt is quite plain.
map(china_blank, asp = 1)
plot(dg_cattle_QH,
edge.color = adjustcolor(qc, alpha.f = .7),
edge.curved = 0.2,
edge.width = qw,
vertex.size = 6,
vertex.color = adjustcolor("gold", alpha.f = .7),
layout = as.matrix(xy_province_capital_ch[, 3:4]),
add = TRUE,
rescale = FALSE)

Resources