ggmap with ggsubplot creates blank map - r

I am trying to place some plots on a map but nothing appears on the map. Here is a reproducible example. The first plot shows how each subplot should look. The second excludes the map but the subplot sizes are too large. The last is one attempt at the final product. I have tried many permutations but this has me stuck. Thanks in advance.
library(ggplot2)
library(ggmap)
library(ggsubplot)
pDat <- structure(list(Location = structure(c(13L, 12L, 14L, 14L, 15L, 15L, 16L, 16L, 17L, 17L, 18L, 19L, 32L, 19L, 19L, 20L, 20L, 20L, 21L, 21L, 21L, 22L, 22L, 22L, 23L, 23L, 24L, 25L, 25L, 26L, 27L, 28L, 28L, 29L, 30L, 30L, 31L), .Label = c("PW-29", "PW-31", "PW-32", "PW-33", "PW-35", "PW-36", "PW-37", "PW-38", "PW-39", "PW-40", "PW29", "SD-03", "SD-03a", "SD-12", "SD-18", "SD-19", "SD-27", "SD-29", "SD-30", "SD-31", "SD-32", "SD-33", "SD-35", "SD-36", "SD-37", "SD-38", "SD-40", "SD-41", "SD-42", "SD-43", "SD-44", "SD30"), class = "factor"), Lat = c(47.292351, 47.292351, 47.289376, 47.289376, 47.288299, 47.288299, 47.288014, 47.288014, 47.287338, 47.287338, 47.29476, 47.293246, 47.293246, 47.293246, 47.293246, 47.293259, 47.293259, 47.293259, 47.292206, 47.292206, 47.292206, 47.291523, 47.291523, 47.291523, 47.290496, 47.290496, 47.289826, 47.288262, 47.288262, 47.287735, 47.286672, 47.290059, 47.290059, 47.290482, 47.28852, 47.28852, 47.288377), Long = c(-73.098418, -73.098418, -73.101282, -73.101282, -73.102558, -73.102558, -73.102178, -73.102178, -73.103016, -73.103016, -73.096432, -73.096412, -73.096412, -73.096412, -73.096412, -73.098245, -73.098245, -73.098245, -73.097552, -73.097552, -73.097552, -73.100022, -73.100022, -73.100022, -73.099395, -73.099395, -73.100051, -73.101199, -73.101199, -73.101895, -73.102629, -73.100954, -73.100954, -73.100184, -73.102246, -73.102246, -73.101477), SBD_ft = c(0, 2, 0, 7, 0, 10, 0, 6, 2, 5, 0, 0.5, 0.5, 0, 2.5, 0.5, 0, 3, 0.5, 0, 2.5, 0.5, 0, 2.5, 0.5, 0, 0, 0.5, 0, 0, 0, 2, 5, 3, 0, 6, 0), SED_ft = c(20, 4, 2, 9, 2, 12, 2, 8, 4, 7, 0.5, 2.5, 2.5, 0.5, 4.5, 2.5, 0.5, 5, 2.5, 0.5, 4.5, 2.5, 0.5, 3.5, 2.5, 0.5, 0.5, 2.5, 0.5, 0.5, 0.5, 4, 7, 5, 2, 8, 2), Cluster = structure(c(3L, 3L, 3L, 4L, 5L, 5L, 2L, 2L, 4L, 5L, 1L, 6L, 6L, 6L, 6L, 1L, 1L, 1L, 6L, 1L, 6L, 4L, 1L, 6L, 1L, 1L, 1L, 5L, 1L, 4L, 1L, 3L, 4L, 3L, 4L, 4L, 4L), .Label = c("1", "2", "3", "4", "5", "6"), class = "factor")), .Names = c("Location", "Lat", "Long", "SBD_ft", "SED_ft", "Cluster"), row.names = 5:41, class = "data.frame")
BBox<-c(-73.01, 47.28, -73.1, 47.30)
#Base <-get_map(BBox,zoom=13,source='google',maptype = 'hybrid')
Base_z <-get_map(BBox,zoom=15,source='google',maptype = 'hybrid')
fm0<-ggmap(Base_z,legend = "none",
base_layer=ggplot(aes(x=Long,y=Lat),data=pDat))
# Example subplots
ggplot(pDat,aes(ymin=SBD_ft,ymax=SED_ft,xmin=0,xmax=1,fill=Cluster))+
facet_wrap(~Location)+
geom_rect() +
scale_y_reverse()
# TEST 1, need to control size of subplots
ggplot(pDat)+
geom_subplot(aes(x=Long,y=Lat,group=Location,
subplot=geom_rect(data=pDat,aes(ymin=SBD_ft,ymax=SED_ft,xmin=0,xmax=1,fill=Cluster))))
# Final , does not work
fm0+
geom_subplot(aes(x=Long,y=Lat,group=Location,
subplot=geom_rect(data=pDat,aes(ymin=SBD_ft,ymax=SED_ft,xmin=0,xmax=1,fill=Cluster))))

Related

Different legend positions on plot with multiple legends

When making a geom_point() that has both color = column_1 and size = column_2 options passed through, ggplot provides two separate legends. One for the color column and one for the size. This is great.
I would like to split the two legends so the bit which maps onto color is shown across the top horizontally and the bit that maps onto size is shown on the right-hand side of the plotregion vertically.
The data and code below reproduce the graph shown below. In that graph I would like the size shown on the right-hand size of the graph vertically and the bit that maps onto the actor's name to be shown along the top as it is.
Is this kind of thing possible? I've found ways to put both of them on the left-hand side but that's not really what I want as you read the actor's name left to right in the plot, and you read size top to bottom, so I want the legends to display in the same way the reader would naturally read the data.
df <- structure(list(count = c(1025, 360, 625, 1108, 3018, 7376, 16318,
19114, 16947, 21532, 2088, 923, 1109, 1751, 3710, 7160, 13904,
20096, 17049, 24597, 2094, 607, 817, 1340, 2909, 6667, 13870,
18657, 17502, 34533, 1132, 447, 606, 940, 2038, 4564, 12141,
19197, 18426, 31272, 1144, 387, 646, 1081, 2164, 5451, 12343,
16194, 16783, 24880, 1450, 549, 759, 1278, 2568, 5623, 11406,
15957, 16445, 22850, 1707, 788, 1023, 1594, 3292, 6852, 14749,
18550, 13815, 19754, 1977, 819, 1051, 1522, 2873, 5469, 10692,
14740, 12352, 16335, 1256, 554, 633, 946, 1780, 3301, 6260, 10608,
11575, 20720, 1365, 547, 565, 1066, 2177, 4650, 9590, 11570,
8160, 11119, 13175, 3088, 2869, 3375, 5123, 7292, 9714, 9088,
5927, 10775, 8387, 1954, 1817, 1996, 2776, 3972, 5746, 5968,
3965, 5969), doctor = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L), .Label = c("Christopher Eccleston", "David Tennant", "Matt Smith",
"Peter Capaldi", "Jodie Whitaker"), class = "factor"), rating = c(1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1,
2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10), season_num = c(27L,
27L, 27L, 27L, 27L, 27L, 27L, 27L, 27L, 27L, 28L, 28L, 28L, 28L,
28L, 28L, 28L, 28L, 28L, 28L, 29L, 29L, 29L, 29L, 29L, 29L, 29L,
29L, 29L, 29L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L, 30L,
31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 32L, 32L, 32L,
32L, 32L, 32L, 32L, 32L, 32L, 32L, 33L, 33L, 33L, 33L, 33L, 33L,
33L, 33L, 33L, 33L, 34L, 34L, 34L, 34L, 34L, 34L, 34L, 34L, 34L,
34L, 35L, 35L, 35L, 35L, 35L, 35L, 35L, 35L, 35L, 35L, 36L, 36L,
36L, 36L, 36L, 36L, 36L, 36L, 36L, 36L, 37L, 37L, 37L, 37L, 37L,
37L, 37L, 37L, 37L, 37L, 38L, 38L, 38L, 38L, 38L, 38L, 38L, 38L,
38L, 38L)), row.names = c(NA, -120L), groups = structure(list(
season_num = 27:38, .rows = structure(list(1:10, 11:20, 21:30,
31:40, 41:50, 51:60, 61:70, 71:80, 81:90, 91:100, 101:110,
111:120), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = c(NA, -12L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
df %>%
ggplot() +
geom_point(aes(x = factor(season_num), y = rating, size = count, color = doctor)) +
labs(x = "Season", y = "Rating (1-10)", title = "IMDb ratings distributions by Season") +
theme(legend.position = 'top',
legend.title = element_blank(),
plot.title = element_text(size = 10),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10)) +
scale_size_continuous(range = c(1,8)) +
scale_y_continuous(limits=c(1, 10), breaks=c(seq(1, 10, by = 1))) +
scale_x_discrete(breaks=c(seq(27, 38, by = 1))) +
scale_color_brewer(palette = "Dark2")

I do not think this is possible with ggplot2-only functions. However, a common trick is:
to make a plot without the legend,
make other plots with target legends,
extract the legends from these plots,
arrange everything in a grid using packages like cowplot or gridExtra
You can find some examples of this process on SO:
ggplot - Multiple legends arrangement
How to place legends at different sides of plot (bottom and right side) with ggplot2?
How do I position two legends independently in ggplot
Here is an example with the provided data, I have not put much effort in arranging the grid because it can change a lot depending on the package you choose in the end. It is just to showcase the process.
library(cowplot)
library(ggplot2)
# plot without legend
main_plot <- ggplot(data = df) +
geom_point(aes(x = factor(season_num), y = rating, size = count, color = doctor)) +
labs(x = "Season", y = "Rating (1-10)", title = "IMDb ratings distributions by Season") +
theme(legend.position = 'none',
legend.title = element_blank(),
plot.title = element_text(size = 10),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10)) +
scale_size_continuous(range = c(1,8)) +
scale_y_continuous(limits=c(1, 10), breaks=c(seq(1, 10, by = 1))) +
scale_x_discrete(breaks=c(seq(27, 38, by = 1))) +
scale_color_brewer(palette = "Dark2")
# color legend, top, horizontally
color_plot <- ggplot(data = df) +
geom_point(aes(x = factor(season_num), y = rating, color = doctor)) +
theme(legend.position = 'top',
legend.title = element_blank()) +
scale_color_brewer(palette = "Dark2")
color_legend <- cowplot::get_legend(color_plot)
# size legend, right-hand side, vertically
size_plot <- ggplot(data = df) +
geom_point(aes(x = factor(season_num), y = rating, size = count)) +
theme(legend.position = 'right',
legend.title = element_blank()) +
scale_size_continuous(range = c(1,8))
size_legend <- cowplot::get_legend(size_plot)
# combine all these elements
cowplot::plot_grid(plotlist = list(color_legend,NULL, main_plot, size_legend),
rel_heights = c(1, 5),
rel_widths = c(4, 1))
Output:

Make ggplot2 heatmap with different colors for values over/under thresholds

I want to make a table with cells highlighted according to their value, Perc_Diff in this case. I want values between -100 and +100 to follow a scale_fill_gradient2 pattern (see code below), but values <= -100 to be blue, and values of >= 100 to be yellow. Here is the data (some of it has been changed to illustrate my question).
plot30 <- structure(list(Station = structure(c(20L, 20L, 20L, 20L, 20L,
20L, 15L, 15L, 15L, 15L, 15L, 15L, 25L, 25L, 25L, 25L, 25L, 25L,
6L, 6L, 6L, 6L, 6L, 6L, 36L, 36L, 36L, 36L, 36L, 36L, 13L, 13L,
13L, 13L, 13L, 13L, 18L, 18L, 18L, 18L, 18L, 18L, 45L, 45L, 45L,
45L, 45L, 45L, 29L, 29L, 29L, 29L, 29L, 29L, 7L, 7L, 7L, 7L,
7L, 7L, 39L, 39L, 39L, 39L, 39L, 39L, 33L, 33L, 33L, 33L, 33L,
33L, 24L, 24L, 24L, 24L, 24L, 24L, 41L, 41L, 41L, 41L, 41L, 41L,
22L, 22L, 22L, 22L, 22L, 22L, 28L, 28L, 28L, 28L, 28L, 28L, 32L,
32L, 32L, 32L, 32L, 32L, 23L, 23L, 23L, 23L, 23L, 23L, 3L, 3L,
3L, 3L, 3L, 3L, 31L, 31L, 31L, 31L, 31L, 31L, 34L, 34L, 34L,
34L, 34L, 34L, 8L, 8L, 8L, 8L, 8L, 8L, 27L, 27L, 27L, 27L, 27L,
27L, 37L, 37L, 37L, 37L, 37L, 37L, 5L, 5L, 5L, 5L, 5L, 5L, 19L,
19L, 19L, 19L, 19L, 19L, 44L, 44L, 44L, 44L, 44L, 44L, 17L, 17L,
17L, 17L, 17L, 17L, 43L, 43L, 43L, 43L, 43L, 43L, 40L, 40L, 40L,
40L, 40L, 40L, 9L, 9L, 9L, 9L, 9L, 9L, 4L, 4L, 4L, 4L, 4L, 4L,
30L, 30L, 30L, 30L, 30L, 30L, 38L, 38L, 38L, 38L, 38L, 38L, 12L,
12L, 12L, 12L, 12L, 12L, 35L, 35L, 35L, 35L, 35L, 35L, 14L, 14L,
14L, 14L, 14L, 14L, 10L, 10L, 10L, 10L, 10L, 10L, 11L, 11L, 11L,
11L, 11L, 11L, 42L, 42L, 42L, 42L, 42L, 42L, 26L, 26L, 26L, 26L,
26L, 26L, 21L, 21L, 21L, 21L, 21L, 21L, 16L, 16L, 16L, 16L, 16L,
16L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("WTES2",
"WRIS2", "WEBS2", "VGAS2", "UNIS2", "TIMS2", "STMS2", "SHSS2",
"SFWS2", "SFSS2", "RDFS2", "RBMS2", "PSTS2", "PRFS2", "ORRS2",
"OCMS2", "OAKS2", "NISS2", "MHTS2", "MCTS2", "MCMS2", "MATS2",
"LMNS2", "LLAS2", "JWLS2", "HMLS2", "HIHS2", "GTBS2", "GOTS2",
"FLNS2", "FLKS2", "EGBS2", "EDTS2", "CTWS2", "CTNS2", "CPTS2",
"CLRS2", "BWLS2", "BTNS2", "BTCS2", "BSNS2", "BKMS2", "BFMS2",
"AURS2", "ATRS2"), class = "factor"), Comp_Data = structure(c(1L,
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L,
4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L,
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L,
4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L,
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L,
4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L,
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L,
4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L,
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L,
4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L,
2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), .Label = c("Total_QPE",
"Stn_PP", "Diff_in", "Perc_Diff", "Frz_Days", "Miss_Days"), class = "factor"),
stuff = c(3.831, 3.07, -0.761, -24.79, 0, 0, 3.075, 1.81,
-1.265, -69.89, 0, 5, 2.941, 2.2, -0.741, -33.68, 0, 0, 2.907,
2.33, -0.577, -24.76, 0, 0, 2.319, 0.36, -1.959, -100, 0,
19, 2.241, 1.24, -1.001, -80.73, 0, 0, 1.926, 1.23, -0.696,
-56.59, 0, 0, 1.91, 1.07, -0.84, -78.5, 0, 0, 1.877, 1.47,
-0.407, -27.69, 0, 0, 1.867, 1.35, -0.517, -38.3, 0, 0, 1.773,
1.22, -0.553, -45.33, 0, 0, 1.773, 1.43, -0.343, -23.99,
0, 0, 1.717, 1.35, -0.367, -27.19, 0, 0, 1.659, 0.71, -0.949,
-100, 0, 0, 1.481, 0.5, -0.981, -100, 0, 0, 1.401, 0.23,
-1.171, -100, 0, 2, 1.377, 0.08, -1.297, -100, 0, 0, 1.296,
0.97, -0.326, -33.61, 0, 0, 1.263, 0.8, -0.463, -57.88, 0,
0, 1.255, 1.06, -0.195, -18.4, 0, 0, 1.212, 0.63, -0.582,
-92.38, 0, 0, 1.203, 0.71, -0.493, -69.44, 0, 0, 1.189, 0.01,
-1.179, -100, 0, 0, 1.18, 0.53, -0.65, -100, 0, 0, 1.144,
0.42, -0.724, -100, 0, 0, 1.105, 0.65, -0.455, -70, 0, 0,
1.062, 0.62, -0.442, -71.29, 0, 0, 1.043, 0.45, -0.593, -100,
0, 0, 1.032, 0.68, -0.352, -51.76, 0, 13, 0.99, 0.66, -0.33,
-50, 0, 0, 0.985, 0.67, -0.315, -47.01, 0, 0, 0.972, 0.7,
-0.272, -38.86, 0, 0, 0.946, 0.5, -0.446, -89.2, 0, 0, 0.916,
0.63, -0.286, -45.4, 0, 0, 0.87, 0.55, -0.32, -58.18, 0,
5, 0.854, 0.6, -0.254, -42.33, 0, 0, 0.825, 0.56, -0.265,
-47.32, 0, 0, 0.816, 0.74, -0.076, -10.27, 0, 0, 0.808, 0.24,
-0.568, -100, 0, 6, 0.765, 0.577, -0.188, -32.58, 0, 4, 0.723,
0.79, 0.067, 8.48, 0, 0, 0.713, 0.66, -0.053, -8.03, 0, 0,
0.647, 0.79, 0.143, 18.1, 0, 0, 0.452, 0.4, -0.052, -13,
0, 0, 0.328, 0.5, 0.172, 34.4, 0, 0), Perc_Diff = c(0, 0,
0, -24.79, 0, 0, 0, 0, 0, -69.89, 0, 0, 0, 0, 0, -33.68,
0, 0, 0, 0, 0, -24.76, 0, 0, 0, 0, 0, -100, 0, 0, 0, 0, 0,
-80.73, 0, 0, 0, 0, 0, -56.59, 0, 0, 0, 0, 0, -78.5, 0, 0,
0, 0, 0, -27.69, 0, 0, 0, 0, 0, -38.3, 0, 0, 0, 0, 0, -45.33,
0, 0, 0, 0, 0, -23.99, 0, 0, 0, 0, 0, -27.19, 0, 0, 0, 0,
0, -100, 0, 0, 0, 0, 0, -100, 0, 0, 0, 0, 0, -100, 0, 0,
0, 0, 0, -100, 0, 0, 0, 0, 0, -33.61, 0, 0, 0, 0, 0, -57.88,
0, 0, 0, 0, 0, -18.4, 0, 0, 0, 0, 0, -92.38, 0, 0, 0, 0,
0, -69.44, 0, 0, 0, 0, 0, -100, 0, 0, 0, 0, 0, -100, 0, 0,
0, 0, 0, -100, 0, 0, 0, 0, 0, -70, 0, 0, 0, 0, 0, -71.29,
0, 0, 0, 0, 0, -100, 0, 0, 0, 0, 0, -51.76, 0, 0, 0, 0, 0,
-50, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0, 0, -38.86, 0, 0,
0, 0, 0, -89.2, 0, 0, 0, 0, 0, -45.4, 0, 0, 0, 0, 0, -58.18,
0, 0, 0, 0, 0, -42.33, 0, 0, 0, 0, 0, 100, 0, 0, 0, 0,
0, -10.27, 0, 0, 0, 0, 0, -100, 0, 0, 0, 0, 0, -32.58, 0,
0, 0, 0, 0, 8.48, 0, 0, 0, 0, 0, -8.03, 0, 0, 0, 0, 0, 18.1,
0, 0, 0, 0, 0, -13, 0, 0, 0, 0, 0, 34.4, 0, 0)), row.names = c(NA,
-270L), class = c("tbl_df", "tbl", "data.frame"))
This is my working code to make the plot, but without the values above or below 100 specially colored:
library(ggplot2)
ggplot(plot30, aes(Comp_Data, Station)) + geom_tile(aes(fill = Perc_Diff),color='black') + geom_text(aes(label = stuff)) +
scale_fill_gradient2(low = "green", mid = 'white', high = "red",limits=c(min(plot30$Perc_Diff,na.rm=T), max(plot30$Perc_Diff,na.rm=T))) +
ggtitle(paste('30 Day Precipitation Comparison (Inches) for',date_30,'to',date_1,'\nCell Values Represent Differences (SD Mesonet minus QPE; Inches)')) +
theme(legend.key.height = unit(3, "cm")) +
theme(axis.title = element_blank()) + theme(plot.title = element_text(hjust = 0.5)) + theme(panel.background = element_blank()) +
theme(axis.ticks = element_blank()) + theme(axis.text.y = element_text(margin = margin(r = 0))) + theme(legend.title = element_blank()) +
theme(legend.text = element_text(colour="black", size = 14, face = "bold")) +
scale_y_discrete(labels = parse(text = levels(plot30$Station))) +
theme(axis.text = element_text(size = 12, colour = "black", face='bold'))
I have tried putting ifelse statements in the fill statement like this (as seen in a couple other questions and online sources), but it doesn't work for me as coded.
geom_tile(aes(fill = if (Perc_Diff >= 100) {'yellow'} else if (Perc_Diff) <= -100 {'blue'} else {'Perc_Diff')), color = 'black')
Do I need to switch to a manual scale here to get this to work? I'd really like to avoid that if possible, to keep the continuous scale between -100 and +100. Any help would be wonderful. Thank you.

This approach is a potential solution, but the figure looks a little 'weird' as the colors (Perc Diff) and label (stuff) sometimes match, sometimes don't match.
Regardless, here is how I would split the dataset into 3 'groups' for plotting (<= -100 , > -100 & < 100, >= 100):
ggplot(plot30) +
geom_tile(data = plot30 %>% filter(Perc_Diff < 100 & Perc_Diff > -100),
aes(x = Comp_Data,
y = factor(Station, levels = unique(Station)),
fill = Perc_Diff), color='black') +
geom_tile(data = plot30 %>% filter(Perc_Diff <= -100),
aes(x = Comp_Data,
y = factor(Station, levels = unique(Station))),
fill = "blue", color='black') +
geom_tile(data = plot30 %>% filter(Perc_Diff >= 100),
aes(x = Comp_Data,
y = factor(Station, levels = unique(Station))),
fill = "yellow", color='black') +
geom_text(aes(x = Comp_Data,
y = factor(Station, levels = unique(Station)),
label = stuff)) +
scale_fill_gradient2(low = "green", mid = 'white', high = "red",
limits=c(min(plot30$Perc_Diff,na.rm=T),
max(plot30$Perc_Diff,na.rm=T))) +
ggtitle(paste('30 Day Precipitation Comparison (Inches) for', "date_30",'to',"date_1",'\nCell Values Represent Differences (SD Mesonet minus QPE; Inches)')) +
theme(legend.key.height = unit(3, "cm")) +
theme(axis.title = element_blank()) +
theme(plot.title = element_text(hjust = 0.5)) +
theme(panel.background = element_blank()) +
theme(axis.ticks = element_blank()) +
theme(axis.text.y = element_text(margin = margin(r = 0))) +
theme(legend.title = element_blank()) +
theme(legend.text = element_text(colour="black", size = 14, face = "bold")) +
theme(axis.text = element_text(size = 12, colour = "black", face='bold'))

png(filename = "E:\\Precip_QC_Folder\\New_Output\\30_day_pp.png",height = 3000, width = 2250, res = 250)
ggplot(plot30) +
geom_tile(data = plot30 %>% filter(Perc_Diff > -100 & Perc_Diff < 100),
aes(x = Comp_Data, y = Station, fill = Perc_Diff), color='black') +
geom_tile(data = plot30 %>% filter(Perc_Diff <= -100),
aes(x = Comp_Data, y = Station), fill = 'lightblue', color= 'black') +
geom_tile(data = plot30 %>% filter(Perc_Diff >= 100),
aes(x = Comp_Data, y = Station), fill = 'yellow', color= 'black') +
geom_text(aes(x = Comp_Data, y = Station, label = stuff)) +
scale_fill_gradient2(low = "lightgreen", mid = 'white', high = "orange",limits=c(min(plot30$Perc_Diff,na.rm=T), max(plot30$Perc_Diff,na.rm=T))) +
ggtitle(paste('30 Day Precipitation Comparison (Inches) for',date_30,'to',date_1,'\nCell Values Represent Differences (SD Mesonet minus QPE; Inches)')) +
theme(legend.key.height = unit(3, "cm")) +
theme(axis.title = element_blank()) + theme(plot.title = element_text(hjust = 0.5)) + theme(panel.background = element_blank()) +
theme(axis.ticks = element_blank()) + theme(axis.text.y = element_text(margin = margin(r = 0))) + theme(legend.title = element_blank()) +
theme(legend.text = element_text(colour="black", size = 14, face = "bold")) +
scale_y_discrete(labels = parse(text = levels(plot30$Station))) +
theme(axis.text = element_text(size = 12, colour = "black", face='bold'))
dev.off()

Cannot use self-starting models when manually defining maxiter for nls()?

Data:
structure(list(ID = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L,
11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L,
24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L,
37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L,
50L, 51L, 52L, 53L, 54L, 55L, 56L, 57L, 58L, 59L, 59L, 60L, 61L,
62L, 63L, 64L, 65L, 66L, 67L, 68L, 69L, 70L), Stage = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 7L,
7L, 7L, 7L, 7L, 7L, 7L, 7L, 3L, 3L, 5L, 5L, 5L, 1L, 1L, 6L, 6L,
4L, 4L, 2L, 2L, 7L, 7L), .Label = c("milpa", "robir", "jurup che",
"pak che kor", "mehen che", "nu kux che", "tam che"), class = "factor"),
Time.Since.Burn = c(4, 2, 0.21, 2, 0.42, 4, 0.33, 0.33, 3,
6, 2.5, 5, 4, 5, 1.5, 6, 4, 6, 3, 6.5, 6.5, 6, 4, 2.5, 12,
10, 8, 18, 5, 10, 8, 16, 28, 22, 22, 21, 20, 18, 30, 27,
30, 36, 36, 40, 32, 28, 50, 32, 60, 60, 60, 60, 60, 60, 60,
60, 6, 6, 24, 26, 22, 2, 1, 50, 45, 10, 10, 4, 4, 60, 60),
meandec = c(0.3625, 0.3025, 0.275, 0.1075, 0.26, 0.395, 0.265,
0.4075, 0.9, 0.9275, 0.7075, 0.9625, 0.7725, 0.9325, 0.9875,
0.81, 0.575, 0.3075, 0.4675, 0.6975, 0.33, 0.8725, 0.46,
0.19, 0.495, 0.3825, 0.58, 0.2275, 0.45, 0.3925, 0.605, 0.515,
0.425, 0.34, 0.2475, 0.1375, 0.4225, 0.505, 0.36, 0.4325,
0.26, 0.1575, 0.125, 0.3125, 0.1725, 0.3175, 0.43, 0.3475,
0.2025, 0.395, 0.12, 0.1625, 0.3175, 0.1975, 0.1525, 0.2775,
0.4975, 0.725, 0.04, 0.326666666666667, 0.1425, 0.445, 0.4725,
0.3775, 0.27, 0.2225, 0.23, 0.3275, 0.9725, 0.215, 0.2325
)), row.names = c(NA, -71L), class = c("grouped_df", "tbl_df",
"tbl", "data.frame"), vars = c("ID", "Stage"), drop = TRUE)
Problem:
I'm trying to run an exponential decay model on these data. I've done it with similar data, but when I try to do it on this particular dataset, it says that the number of max iterations has been exceeded without convergence.
nonlinmod6<-nls(meandec~SSasymp(Time.Since.Burn, Asym,R0,lrc),data=averaged_perherb)
Error in nls(y ~ cbind(1 - exp(-exp(lrc) * x), exp(-exp(lrc) * x)), data = xy, : number of iterations exceeded maximum of 50
So, I tried to manually increase the maximum number of iterations using the code below:
nonlinmod6<-nls(meandec~SSasymp(Time.Since.Burn, Asym,R0,lrc),data=averaged_perherb,nls.control(maxiter=500))
but it then gives me an error saying that :
Error in nls(meandec ~ SSasymp(Time.Since.Burn, Asym, R0, lrc), data =
averaged_perherb,: parameters without starting value in 'data': Asym, R0, lrc
which I don't think should be the case given that I'm using a self-starting function to identify the starting parameters. Is there any way to resolve this?

The problem is that the SSaymp intialization routine itself uses nls and it is that hidden invocation of nls that is the problem.
You are going to have to hack the intialization routine. Make a new copy of SSasymp called SSasymp2, grab its initialization routine and call it SSasymp2Init, say. Then use trace to insert into the initialization a new version of nls having the required control argument. To do that we use the partial function in the pryr package. Replace the initialization routine with the hacked one and then run nls.
library(pryr)
SSasymp2 <- SSasymp
SSasymp2Init <- attr(SSasymp2, "initial")
trace(SSasymp2Init,
quote(nls <- partial(stats::nls, control = nls.control(maxiter = 500))))
attr(SSasymp2, "initial") <- SSasymp2Init
nls(meandec ~ SSasymp2(Time.Since.Burn, Asym, R0, lrc), data = averaged_perherb)
giving:
Tracing (attr(object, "initial"))(mCall = mCall, data = data, LHS = LHS) on entry
Nonlinear regression model
model: meandec ~ SSasymp2(Time.Since.Burn, Asym, R0, lrc)
data: averaged_perherb
Asym R0 lrc
0.1641 0.5695 -3.4237
residual sum-of-squares: 2.977
Number of iterations to convergence: 15
Achieved convergence tolerance: 5.875e-06

r geom_bar reorder layers of bars by values

I have produced a bar chart that shows cumulative totals over periods of months for various programs using the following data structure and code:
library(dplyr)
data_totals <- data_long %>%
group_by(Period, Program) %>%
arrange(Period, Program) %>%
ungroup() %>%
group_by(Program) %>%
mutate(Running_Total = cumsum(Value))
dput(data_totals)
structure(list(Period = structure(c(1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L,
5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L,
8L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L, 11L, 11L, 11L,
11L, 11L, 12L, 12L, 12L, 12L, 12L), .Label = c("2018-04", "2018-05",
"2018-06", "2018-07", "2018-08", "2018-09", "2018-10", "2018-11",
"2018-12", "2019-01", "2019-02", "2019-03", "Apr-Mar 2019"), class = "factor"),
Program = structure(c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L,
5L, 1L, 2L, 3L, 4L, 5L), .Label = c("A",
"B", "C", "D",
"E"), class = "factor"), Value = c(5597,
0, 0, 0, 1544, 0, 0, 0, 0, 1544, 0, 0, 0, 0, 1544, 0, 0,
850, 0, 1544, 0, 0, 0, 0, 1544, 0, 0, 0, 0, 1544, 0, 0, 0,
0, 1544, 0, 0, 0, 0, 1544, 0, 0, 0, 0, 1544, 0, 0, 0, 0,
1544, 0, 0, 0, 0, 1544, 0, 0, 0, 0, 1544), Running_Total = c(5597,
0, 0, 0, 1544, 5597, 0, 0, 0, 3088, 5597, 0, 0, 0, 4632,
5597, 0, 850, 0, 6176, 5597, 0, 850, 0, 7720, 5597, 0, 850,
0, 9264, 5597, 0, 850, 0, 10808, 5597, 0, 850, 0, 12352,
5597, 0, 850, 0, 13896, 5597, 0, 850, 0, 15440, 5597, 0,
850, 0, 16984, 5597, 0, 850, 0, 18528)), .Names = c("Period",
"Program", "Value", "Running_Total"), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -60L), vars = "Program", labels = structure(list(
Program = structure(1:5, .Label = c("A",
"B", "C", "D",
"E"), class = "factor")), class = "data.frame", row.names = c(NA,
-5L), vars = "Program", drop = TRUE, .Names = "Program"), indices = list(
c(0L, 5L, 10L, 15L, 20L, 25L, 30L, 35L, 40L, 45L, 50L, 55L
), c(1L, 6L, 11L, 16L, 21L, 26L, 31L, 36L, 41L, 46L, 51L,
56L), c(2L, 7L, 12L, 17L, 22L, 27L, 32L, 37L, 42L, 47L, 52L,
57L), c(3L, 8L, 13L, 18L, 23L, 28L, 33L, 38L, 43L, 48L, 53L,
58L), c(4L, 9L, 14L, 19L, 24L, 29L, 34L, 39L, 44L, 49L, 54L,
59L)), drop = TRUE, group_sizes = c(12L, 12L, 12L, 12L, 12L
), biggest_group_size = 12L)
# reorder the groups descending so that the lowest total will be on layers from front to back
reorder(data_totals$Program, -data_totals$Running_Total)
ggplot(data = data_totals, aes(x = Period, y = Running_Total)) +
geom_bar(aes(color = Program, group = Program, fill = Program),
stat = "identity", position = "identity", alpha = 1.0)
It works in that it creates the graph with all the proper data, but the smaller Running_Totals are obscured by the larger ones.
I get the following error message as well:
Warning message:
The plyr::rename operation has created duplicates for the following name(s): (`colour`)
Even though I do not have the plyr package loaded.
I can see all the Running_Totals if I set the alpha to 0.5
Running_Total for each Program by Period, alpha = 0.5:
How can I get the layers ordered so that the smallest values are on the front most layers working back toward the highest values?

The way I was trying to represent the data in the original question was flawed.
There is no advantage to having the Program with the maximum value for each Period be the top of the bar.
A more illustrative solution is to have a stacked bar, with labels indicating the contribution of each Program to the overall value of each Period:
ggplot(data = data_totals[which(data_totals$Running_Total > 0),], aes(x = Period, y = Running_Total, fill = Program)) +
geom_bar(aes(color = Program, group = Program, fill = Program), stat = "identity", position = "stack", alpha = 1.0) +
geom_text(aes(label = Running_Total), position = position_stack(vjust = 0.5))
I used [which(data_totals$Running_Total > 0),] to eliminate any "0" bars and labels.

Set the thickness of geom_line based on frequency (like geom_count)

I would like to set the thickness of geom_line to the proportion of data that follows that path, in the same way that geom_count sets the size of points based on the proportion of data that overlap at that point, or find a function that will allow me to do this.
I would also be happy if I could do this as a count rather than a proportion - either would work. I have attached the graph the grey lines represent connections between the same ID (ie. same individual in different categories), if I could set the thickness of the lines I can show the most common connection pathways.
My current code is:
ggplot(dat, aes(x = Category, y = Metric, group = ID)) +
geom_line(aes(group = ID), colour = "gray59") +
geom_count(aes(size = ..prop.., group = 1), colour = "gray59") +
scale_size_area(max_size = 5) +
theme_bw() +
geom_smooth(method = "lm", se = F, colour = "black",
aes(group = 1), linetype = "dotdash") +
xlab("Category") +
ylab("Metric") +
theme(text = element_text(size = 16))
This is the resulting graph, point size shows the proportion of data that overlaps at that point, I would like to do the same with line thickness if possible:
My searching has so far turned up nothing helpful but maybe I am searching the wrong terms. Any help would be much appreciated!
Here is the data - unsure how to upload it as a file
dat <- structure(list(IDD = structure(c(1L, 1L, 1L, 1L, 3L, 3L, 4L,
4L, 4L, 4L, 4L, 5L, 5L, 5L, 6L, 6L, 2L, 2L, 2L, 2L, 7L, 7L, 7L,
8L, 8L, 8L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 12L,
12L, 13L, 13L, 13L, 13L, 14L, 14L, 15L, 15L, 15L, 15L, 16L, 16L,
16L, 16L, 17L, 17L, 18L, 18L, 18L, 18L, 19L, 19L, 20L, 20L, 21L,
21L, 21L, 22L, 22L, 23L, 23L, 24L, 24L, 25L, 25L, 25L, 26L, 26L,
26L, 26L, 27L, 27L, 28L, 28L, 29L, 29L, 29L, 30L, 30L, 30L, 31L,
31L, 31L, 31L, 32L, 32L, 33L, 33L, 33L, 34L, 34L, 34L, 34L, 35L,
35L, 36L, 36L, 36L, 37L, 37L, 37L, 37L, 38L, 38L, 38L, 39L, 39L,
39L, 40L, 40L, 40L, 41L, 41L, 42L, 42L, 43L, 43L, 44L, 44L, 44L,
44L, 45L, 45L, 45L, 46L, 46L, 46L, 47L, 47L, 47L, 48L, 48L, 49L,
49L, 50L, 50L, 51L, 51L, 51L, 51L, 52L, 52L, 53L, 53L, 54L, 54L,
55L, 55L, 56L, 56L, 57L, 57L, 57L, 58L, 58L, 59L, 59L, 59L, 59L
), .Label = c("ID005", "ID040", "ID128", "ID131", "ID133", "ID134",
"ID147", "ID149", "ID166", "ID167", "ID175", "ID181", "ID191",
"ID198", "ID213", "ID235", "ID254", "ID257", "ID259", "ID273",
"ID279", "ID287", "ID292", "ID299", "ID300", "ID321", "ID334",
"ID348", "ID349", "ID354", "ID359", "ID377", "ID379", "ID383",
"ID390", "ID395", "ID409", "ID445", "ID467", "ID469", "ID482",
"ID492", "ID496", "ID524", "ID526", "ID527", "ID534", "ID535",
"ID538", "ID545", "ID564", "ID576", "ID578", "ID579", "ID600",
"ID610", "ID622", "ID631", "ID728"), class = "factor"), Category = c(2L,
4L, 5L, 5L, 2L, 4L, 1L, 3L, 3L, 4L, 4L, 2L, 4L, 5L, 5L, 5L, 2L,
5L, 5L, 5L, 3L, 2L, 5L, 4L, 5L, 5L, 4L, 4L, 5L, 5L, 3L, 4L, 5L,
5L, 2L, 4L, 2L, 5L, 3L, 4L, 5L, 5L, 4L, 5L, 3L, 4L, 5L, 5L, 3L,
4L, 5L, 5L, 5L, 5L, 2L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 4L, 4L, 5L,
5L, 5L, 3L, 4L, 5L, 5L, 4L, 5L, 5L, 1L, 3L, 4L, 4L, 3L, 5L, 3L,
5L, 2L, 3L, 4L, 3L, 4L, 4L, 3L, 3L, 4L, 4L, 3L, 5L, 3L, 4L, 4L,
3L, 3L, 4L, 5L, 2L, 3L, 2L, 3L, 4L, 2L, 2L, 3L, 4L, 4L, 5L, 5L,
2L, 3L, 4L, 2L, 3L, 4L, 3L, 4L, 4L, 5L, 3L, 4L, 1L, 2L, 3L, 4L,
1L, 3L, 4L, 1L, 3L, 4L, 1L, 3L, 4L, 3L, 4L, 3L, 3L, 2L, 3L, 2L,
2L, 3L, 3L, 2L, 3L, 2L, 3L, 3L, 4L, 3L, 4L, 3L, 4L, 1L, 2L, 3L,
2L, 3L, 1L, 3L, 4L, 4L), Metric = c(2, 2, 3.5, 4, 2, 1.5, 2,
2, 3, 3, 2, 2, 2, 2, 3.5, 3.5, 2, 3, 3.5, 4, 2, 2, 3, 2, 3, 3,
2, 3, 3, 2.5, 1.5, 3, 3.5, 4, 2, 2, 1.5, 2, 1.5, 2, 2, 2, 2.5,
3, 2.5, 3.5, 3.5, 3.5, 1.5, 2, 2.5, 2.5, 3.5, 4, 2, 2, 1.5, 3,
3.5, 3, 3, 3, 3.5, 2.5, 3, 3, 3, 2, 3, 2.5, 2.5, 2, 2, 2, 2,
2, 2, 2, 2.5, 2.5, 2, 3, 2.5, 2, 2.5, 2, 2.5, 2.5, 2, 2, 2.5,
3.5, 2, 2.5, 2.5, 2.5, 2.5, 2, 2, 2, 2.5, 2, 2, 1.5, 2, 2, 2.5,
2, 2, 2.5, 2, 2, 2.5, 2.5, 2.5, 3, 2.5, 2.5, 2.5, 2, 2, 2.5,
2.5, 2, 2, 2, 2, 1.5, 2, 1.5, 2, 2, 2, 1.5, 2, 2, 2.5, 2.5, 1.5,
1.5, 2, 2.5, 2, 2, 2, 2, 2.5, 2, 1.5, 2, 2.5, 2, 1.5, 1.5, 1.5,
2, 2, 2, 2, 2, 1.5, 2, 2.5, 2, 2, 2.5, 2.5)), .Names = c("IDD",
"Category", "Metric"), class = "data.frame", row.names = c(NA,
-167L))

I am a bit confused about how you want to scale different line segments, but I was able to create a proportional variable within dat and then plot that as an argument to geom_line():
dat$thickness <- with(dat, ave(Category, Metric, FUN = prop.table))
ggplot(dat, aes(x = Category, y = Metric, group = ID)) +
geom_line(aes(group = ID), colour = "gray59", size = dat$thickness) +
geom_count(aes(size = ..prop.., group = 1), colour = "gray59") +
scale_size_area(max_size = 5) +
theme_bw() +
geom_smooth(method = "lm", se = F, colour = "black",
aes(group = 1), linetype = "dotdash") +
xlab("Category") +
ylab("Metric") +
theme(text = element_text(size = 16))
Which yields this plot:

Resources