Polygon draws pointwise instead of area ggplot2 and ggmap in r - r

I would like to draw a map similar to this
My aim is to remove different point shapes and keep the rest as it is. However, I end up with the following plot.
Except polygon shape, everything is correct. How can I change this drawing of polygon?
library(data.table)
plot.data <- as.data.frame(fread("plotdata.csv", header = TRUE, sep = ","))
library(ggmap)
library(ggplot2)
map <- get_map(location = "california", maptype = "roadmap", zoom = 6, source = 'google', scale = 1,color = "color")
plot.size = 11
point.size = 0.85
line.size = 0.3
p2 <- ggmap(map) +
geom_point(data = plot.data, size = 1,
aes_string("x", "y", color = as.factor(plot.data$cluster)), alpha = 0.7) +
scale_shape(solid = T) +
geom_polygon(data = plot.data, mapping = aes_string(x = "x",
y = "y",
colour = as.factor(plot.data$cluster),
fill = as.factor(plot.data$cluster)),
alpha = 0.3) +
geom_text(aes(label = "", x = -114, y = 41), size = plot.size-3) +
xlab(expression(paste("Longitude [", degree, "]"))) +
ylab(expression(paste("Latitude [", degree, "]"))) +
theme_bw() +
theme(plot.margin = unit(c(1,1,0,0), "lines"), text = element_text(family = "Times"), axis.title = element_text(size = plot.size), axis.text = element_text(size = plot.size), legend.position = "none")
p2
The data is in the following link.
https://mega.nz/#!J9JiwD4R!3cEmCvoE1oDvGoYZtl7Pumw95uQtHqtPvrfR3y5mUc4
get_map gives error sometimes, please keep trying. Eventually, it downloads the map.
> dput(plot.data)
structure(list(x = c(-114.62, -115.1, -116.26, -116.7, -115.66,
-116.02, -116.86, -115.98, -116.22, -115.22, -115.58, -116.42,
-117.3, -117.46, -116.62, -117.46, -114.74, -114.94, -116.26,
-117.46, -115.62, -116.26, -116.78, -116.58, -117.22, -117.82,
-115.42, -118.1, -114.54, -114.7, -115.42, -115.46, -114.82,
-117.06, -117.1, -117.94, -114.94, -115.86, -117.74, -117.18,
-115.38, -117.3, -115.42, -115.66, -116.62, -118.94, -114.34,
-116.38, -116.98, -117.94, -119.14, -118.02, -118.7, -118.94,
-114.58, -115.34, -116.26, -114.78, -115.5, -114.7, -115.06,
-115.7, -117.74, -116.06, -116.26, -120.58, -118.02, -119.22,
-114.54, -116.1, -116.98, -117.46, -115.94, -119.02, -119.34,
-119.54, -120.5, -115.1, -115.42, -116.46, -116.98, -117.46,
-115.42, -116.02, -116.54, -117.62, -114.7, -115.38, -116.34,
-117.54, -117.86, -116.66, -120.58, -114.9, -117.14, -117.9,
-119.38, -119.9, -117.3, -120.18, -117.5, -120.1, -119.26, -120.38,
-120.46, -115.38, -115.86, -117.34, -116.7, -119.9, -119.14,
-115.82, -116.22, -116.94, -119.3, -116.62, -116.74, -118.74,
-119.1, -119.26, -119.94, -115.78, -115.86, -119.26, -118.3,
-120.46, -118.38, -119.66, -116.62, -118.22, -118.3, -121.02,
-116.5, -117.06, -117.62, -117.74, -118.98, -119.62, -119.98,
-120.74, -120.9, -115.98, -116.66, -118.06, -118.22, -119.1,
-117.82, -119.34, -119.54, -117.26, -117.38, -120.34, -120.94,
-119.66, -120.62, -116.46, -121.42, -116.58, -117.62, -118.7,
-118.94, -120.46, -119.34, -120.86, -116.54, -117.94, -119.86,
-117.1, -119.26, -121.14, -117.86, -119.5, -120.62, -120.66,
-118.46, -119.5, -120.7, -120.74, -119.26, -120.74, -121.58,
-117.26, -120.9, -121.38, -116.82, -117.74, -118.66, -118.98,
-120.22, -117.26, -118.1, -117.14, -117.58, -119.26, -120.66,
-121.18, -118.1, -119.18, -119.26, -117.58, -119.22, -121.06,
-117.38, -118.54, -120.86, -122.02, -117.7, -119.34, -120.7,
-120.14, -120.66, -118.1, -119.06, -117.5, -118.02, -119.14,
-120.74, -121.54, -117.54, -120.02, -121.78, -118.58, -119.66,
-119.7, -117.82, -118.94, -119.38, -119.7, -118.1, -121.7, -121.06,
-117.9, -118.1, -118.9, -118.58, -119.46, -120.7, -120.82, -121.22,
-119.9, -121.5, -122.46, -118.34, -119.42, -119.62, -118.98,
-119.62, -119.74, -120.62, -121.18, -122.18, -122.54, -122.14,
-121.94, -120.22, -120.98, -121.14, -122.98, -122.58, -119.38,
-119.5, -121.06, -121.46, -122.74, -119.1, -121.74, -119.1, -121.46,
-121.9, -121.22, -119.82, -120.74, -120.98, -121.22, -119.34,
-123.02, -122.78, -122.1, -122.62, -120.06, -120.98, -120.9,
-123.34, -120.38, -120.66, -120.46, -123.66, -122.46, -120.14,
-120.1, -120.62, -122.14, -120.82, -121.38, -120.06, -123.18,
-121.42, -120.58, -120.94, -121.18, -121.62, -121.02, -121.82,
-122.3, -120.1, -121.34, -121.46, -122.02, -121.74, -121.9, -120.06,
-120.94, -122.18, -122.66, -123.06, -123.78, -121.5, -120.62,
-121.3, -120.22, -121.02, -120.3, -120.1, -120.98, -120.98, -121.66,
-121.82, -121.54, -121.1, -121.06, -122.98, -123.14, -123.9,
-120.14, -122.3, -120.42, -122.86, -123.46, -122.74, -123.46,
-121.46, -121.54, -122.42, -122.94, -123.94, -120.46, -121.54,
-121.94, -120.86, -123.22, -120.54, -120.98, -123.7, -121.42,
-122.58, -120.82, -121.38, -121.62, -122.06, -120.38, -120.54,
-120.62, -121.58, -123.1, -123.9, -120.94, -121.74, -122.38,
-121.78, -123.54, -121.74, -122.46, -122.78, -122.34, -123.26,
-123.06, -122.94, -120.42, -121.06, -121.1, -120.82, -122.26,
-123.58, -120.58, -121.82, -123.82, -120.58, -120.62, -122.22,
-123.74, -120.5, -123.7, -120.74, -122.42, -122.46, -120.78,
-122.46, -120.42, -123.5, -123.74), y = c(32.81, 32.81, 32.89,
32.97, 33.09, 33.09, 33.17, 33.21, 33.21, 33.29, 33.37, 33.37,
33.41, 33.41, 33.45, 33.53, 33.57, 33.57, 33.61, 33.65, 33.69,
33.73, 33.73, 33.81, 33.81, 33.81, 33.85, 33.85, 33.89, 33.89,
33.93, 33.97, 34.05, 34.09, 34.09, 34.09, 34.13, 34.17, 34.17,
34.21, 34.25, 34.25, 34.29, 34.29, 34.29, 34.29, 34.33, 34.33,
34.37, 34.37, 34.37, 34.41, 34.41, 34.41, 34.45, 34.45, 34.45,
34.49, 34.49, 34.53, 34.53, 34.57, 34.57, 34.61, 34.61, 34.61,
34.65, 34.65, 34.69, 34.69, 34.69, 34.69, 34.73, 34.73, 34.73,
34.73, 34.73, 34.77, 34.77, 34.77, 34.77, 34.81, 34.85, 34.85,
34.93, 34.93, 34.97, 35.01, 35.01, 35.01, 35.01, 35.05, 35.05,
35.09, 35.09, 35.09, 35.09, 35.09, 35.13, 35.13, 35.17, 35.21,
35.29, 35.29, 35.29, 35.33, 35.37, 35.37, 35.45, 35.49, 35.53,
35.57, 35.57, 35.57, 35.57, 35.69, 35.69, 35.69, 35.69, 35.69,
35.69, 35.73, 35.73, 35.73, 35.77, 35.77, 35.81, 35.81, 35.85,
35.85, 35.85, 35.85, 35.89, 35.89, 35.89, 35.89, 35.89, 35.89,
35.89, 35.89, 35.93, 35.97, 35.97, 35.97, 35.97, 35.97, 36.09,
36.09, 36.09, 36.13, 36.13, 36.13, 36.13, 36.17, 36.17, 36.21,
36.25, 36.29, 36.29, 36.29, 36.33, 36.33, 36.37, 36.37, 36.41,
36.41, 36.41, 36.45, 36.45, 36.45, 36.49, 36.49, 36.49, 36.49,
36.53, 36.53, 36.53, 36.57, 36.61, 36.61, 36.61, 36.65, 36.65,
36.65, 36.69, 36.73, 36.73, 36.73, 36.77, 36.81, 36.81, 36.85,
36.85, 36.85, 36.85, 36.85, 36.89, 36.89, 36.89, 36.93, 36.93,
36.93, 36.97, 36.97, 36.97, 36.97, 37.01, 37.01, 37.01, 37.05,
37.05, 37.09, 37.09, 37.17, 37.17, 37.17, 37.17, 37.21, 37.25,
37.25, 37.29, 37.33, 37.33, 37.33, 37.37, 37.37, 37.37, 37.37,
37.41, 37.41, 37.45, 37.49, 37.53, 37.53, 37.57, 37.61, 37.61,
37.61, 37.61, 37.69, 37.69, 37.69, 37.77, 37.77, 37.77, 37.81,
37.81, 37.81, 37.81, 37.81, 37.81, 37.89, 37.97, 38.01, 38.05,
38.05, 38.05, 38.05, 38.09, 38.17, 38.17, 38.17, 38.17, 38.21,
38.25, 38.29, 38.33, 38.33, 38.33, 38.37, 38.41, 38.41, 38.41,
38.41, 38.53, 38.53, 38.57, 38.61, 38.61, 38.65, 38.65, 38.69,
38.73, 38.81, 38.89, 38.93, 38.93, 38.97, 39.01, 39.09, 39.13,
39.13, 39.17, 39.17, 39.21, 39.21, 39.33, 39.41, 39.41, 39.41,
39.41, 39.45, 39.45, 39.53, 39.57, 39.57, 39.57, 39.61, 39.65,
39.69, 39.73, 39.73, 39.73, 39.77, 39.77, 39.77, 39.81, 39.85,
39.85, 39.93, 39.93, 39.97, 40.01, 40.01, 40.05, 40.05, 40.05,
40.13, 40.17, 40.21, 40.21, 40.21, 40.21, 40.25, 40.25, 40.33,
40.33, 40.33, 40.37, 40.37, 40.41, 40.41, 40.41, 40.41, 40.45,
40.49, 40.49, 40.49, 40.61, 40.61, 40.65, 40.65, 40.65, 40.69,
40.69, 40.73, 40.77, 40.81, 40.81, 40.85, 40.85, 40.85, 40.89,
40.89, 40.89, 40.93, 40.97, 41.01, 41.09, 41.09, 41.17, 41.17,
41.17, 41.21, 41.21, 41.25, 41.33, 41.37, 41.37, 41.37, 41.41,
41.41, 41.49, 41.57, 41.57, 41.57, 41.61, 41.61, 41.61, 41.65,
41.69, 41.73, 41.77, 41.77, 41.77, 41.85, 41.85, 41.89, 41.93,
41.97), cluster = c(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,
5L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 5L, 3L, 3L, 5L, 3L, 3L, 3L, 3L,
3L, 3L, 5L, 3L, 3L, 3L, 5L, 5L, 5L, 5L, 5L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 5L, 3L, 3L, 2L, 5L, 2L, 3L, 3L, 3L, 5L, 3L, 5L, 2L,
2L, 2L, 3L, 3L, 3L, 3L, 5L, 3L, 3L, 3L, 5L, 3L, 3L, 3L, 5L, 5L,
3L, 2L, 3L, 5L, 5L, 2L, 2L, 5L, 2L, 5L, 2L, 2L, 2L, 2L, 3L, 3L,
5L, 5L, 2L, 2L, 3L, 3L, 5L, 2L, 5L, 5L, 5L, 2L, 2L, 2L, 3L, 3L,
2L, 5L, 2L, 5L, 2L, 5L, 5L, 5L, 2L, 5L, 5L, 5L, 5L, 2L, 2L, 2L,
2L, 2L, 5L, 5L, 5L, 5L, 2L, 5L, 2L, 2L, 5L, 5L, 2L, 2L, 2L, 2L,
5L, 2L, 5L, 5L, 5L, 2L, 2L, 2L, 2L, 5L, 5L, 2L, 5L, 2L, 2L, 5L,
2L, 2L, 2L, 5L, 2L, 2L, 2L, 2L, 2L, 2L, 5L, 2L, 2L, 5L, 5L, 2L,
2L, 2L, 5L, 5L, 5L, 5L, 2L, 2L, 2L, 5L, 2L, 2L, 5L, 2L, 2L, 5L,
5L, 2L, 1L, 5L, 2L, 2L, 2L, 2L, 5L, 2L, 5L, 5L, 2L, 2L, 1L, 5L,
2L, 1L, 2L, 2L, 2L, 5L, 2L, 2L, 2L, 5L, 1L, 1L, 5L, 5L, 2L, 2L,
2L, 1L, 1L, 1L, 2L, 1L, 1L, 5L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 4L, 4L, 4L, 4L, 4L, 4L,
4L, 4L, 1L, 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, 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, 4L,
4L, 4L, 4L, 4L, 4L)), .Names = c("x", "y", "cluster"), row.names = c(NA,
-400L), class = "data.frame")

You can use chull(Compute Convex Hull of a Set of Points).
find_hull <- function(df) df[chull(df$x, df$y), ]
hulls <- plyr::ddply(plot.data, "cluster", find_hull)
p2 <- ggmap(map) +
geom_point(data = plot.data, size = 1,
aes_string("x", "y", color = as.factor(plot.data$cluster)), alpha = 0.7) +
scale_shape(solid = T) +
geom_polygon(data = hulls, mapping = aes_string(x = "x",
y = "y",
colour = as.factor(hulls$cluster),
fill = as.factor(hulls$cluster)),
alpha = 0.3) +
geom_text(aes(label = "", x = -114, y = 41), size = plot.size-3) +
xlab(expression(paste("Longitude [", degree, "]"))) +
ylab(expression(paste("Latitude [", degree, "]"))) +
theme_bw() +
theme(plot.margin = unit(c(1,1,0,0), "lines"),
text = element_text(family = "Times"),
axis.title = element_text(size = plot.size),
axis.text = element_text(size = plot.size),
legend.position = "none")
p2

Related

Adding 95% confidence interval of prediction using ggplot2

I am using your facet_grid2 function from ggh4x to make both x and y-axis scales to be free like
ggplot(data_calibration, aes(Observed,Predicted))+
geom_point(color="black",alpha = 1/3) +
facet_grid2(Station ~ Method, scales="free", independent = "all")+
xlab("Measured") +
ylab("Predicted") +
theme_bw()+
geom_smooth(method="lm") +
theme(panel.grid.minor = element_blank())
Now how can I add the 95% confidence interval of prediction to this plot like the following plot
Data
data_calibration = structure(list(Observed = c(17229L, 15964L, 13373L, 17749L, 12457L,
7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L, 7197L, 7220L,
7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L, 11465L,
11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L, 10759L,
9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L, 3183L,
9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L, 17749L,
12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L, 7197L,
7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L), Station = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Raigad",
"Ratnagiri", "Thane "), class = "factor"), Method = structure(c(6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 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, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 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, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
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, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("ANN",
"ELNET", "LASSO", "PCA-ANN", "PCA-MLR", "SMLR"), class = "factor"),
Predicted = c(14463L, 14285L, 14452L, 12765L, 11917L, 8143L,
11251L, 8611L, 6789L, 2059L, 2787L, 2201L, 3062L, 4508L,
4975L, 15357L, 15605L, 12326L, 10377L, 9113L, 13926L, 13142L,
11407L, 8711L, 7801L, 2064L, 4563L, 4725L, 6247L, 7170L,
9492L, 8857L, 10323L, 7389L, 6776L, 7842L, 8261L, 6156L,
8627L, 4326L, 8094L, 8897L, 10370L, 10214L, 8548L, 16043L,
16671L, 15831L, 13463L, 11921L, 10239L, 9110L, 8090L, 10794L,
5826L, 3621L, 5639L, 7364L, 8152L, 5515L, 15182L, 14370L,
13559L, 12748L, 11936L, 11125L, 10313L, 9502L, 8691L, 7879L,
7068L, 6257L, 5445L, 4634L, 3822L, 10045L, 9911L, 11038L,
9255L, 8736L, 8848L, 8063L, 7847L, 8538L, 6744L, 9583L, 10474L,
8343L, 10353L, 8791L, 13185L, 13331L, 13099L, 12557L, 11898L,
10474L, 11199L, 10255L, 9251L, 6148L, 6795L, 6166L, 7775L,
8157L, 7990L, 14843L, 15086L, 12585L, 10987L, 10193L, 13663L,
11317L, 11071L, 9392L, 6991L, 4484L, 4667L, 4846L, 5830L,
6577L, 9085L, 8802L, 9570L, 7770L, 7652L, 8006L, 7995L, 6599L,
9050L, 4876L, 8360L, 8981L, 9931L, 9479L, 8009L, 13775L,
13890L, 13416L, 12851L, 12141L, 10693L, 10834L, 10372L, 9585L,
5914L, 5930L, 5922L, 7854L, 7407L, 7697L, 14941L, 15174L,
12572L, 10817L, 10412L, 13705L, 11154L, 10886L, 9448L, 7215L,
4389L, 4875L, 4809L, 5747L, 6385L, 9034L, 8749L, 9410L, 7820L,
7798L, 7940L, 7957L, 6803L, 8844L, 5227L, 8369L, 8972L, 9789L,
9514L, 7940L, 15309L, 14477L, 14219L, 18581L, 12084L, 10550L,
8666L, 8812L, 11415L, 5566L, 3928L, 4592L, 7861L, 7489L,
6903L, 12509L, 13366L, 11956L, 11880L, 8711L, 12768L, 11690L,
10922L, 4101L, 10106L, 2811L, 2979L, 4785L, 5944L, 5901L,
10007L, 8710L, 8688L, 7383L, 7575L, 8047L, 7938L, 6585L,
9517L, 3729L, 8816L, 8704L, 10847L, 8812L, 8493L, 18115L,
15670L, 15931L, 16804L, 12450L, 7701L, 7588L, 8450L, 9205L,
5477L, 4666L, 4948L, 8262L, 7095L, 6798L, 12902L, 12883L,
12864L, 12788L, 12690L, 12896L, 12491L, 12199L, 11982L, 5213L,
5357L, 5053L, 5013L, 5321L, 5596L, 9467L, 8931L, 9305L, 7867L,
8427L, 8282L, 7291L, 6396L, 9725L, 5509L, 8545L, 8997L, 10171L,
10389L, 8700L)), class = "data.frame", row.names = c(NA,
-270L))
In short, the geom_smooth function only calculates confidence intervals. To get prediction intervals as well, these should be calculated outside of ggplot and passed in. This is a bit of a long way of coding, but hopefully you can see that predict is called twice on the lm model, once to produce two columns of confidence intervals, once to produce two columns of prediction intervals. These are passed on to geom_ribbons:
library(ggh4x)
library(tidyverse)
data_calibration |>
group_by(Station, Method) |>
nest() |>
mutate(model = map(data, ~ lm(Predicted ~ Observed, data = .x))) |>
mutate(fit = map2(model, data, ~ as.tibble(
predict(.x, interval = "conf"), new_data = tibble(Observed = seq(min(
data$Observed, max(data$Observed), 100
)))
)),
pred = map2(model, data, ~ as.tibble(
predict(.x, interval = "pred", new_data = tibble(Observed = seq(
min(data$Observed, max(data$Observed), 100)
)))
))) |>
unnest(c(data, fit, pred), names_sep = "_") |>
ggplot(aes(data_Observed, data_Predicted)) +
geom_point(color = "black", alpha = 1 / 3) +
facet_grid2(Station ~ Method, scales = "free", independent = "all") +
xlab("Measured") +
ylab("Predicted") +
theme_bw() +
geom_smooth(method = "lm", se = FALSE) +
geom_ribbon(aes(ymax = fit_upr, ymin = fit_lwr),
colour = "green",
fill = NA) +
geom_ribbon(aes(ymax = pred_upr, ymin = pred_lwr),
colour = "red",
fill = NA) +
theme(panel.grid.minor = element_blank())
I would welcome a tidier answer! One would be to create a new stat_predict layer function, which is a little tricky but not impossible.
Edit - that thing I said was perhaps a good idea, maybe it is!
Out of curiosity, I thought worth making a stat_predict function. Source the code from this gist and then the simple code will work with above data:
# To source new function, either...
source("https://gist.githubusercontent.com/andrewbaxter439/b508a60786f8af3c0be7b381a667ae07/raw/f7f4672222f0b1024cf6bf536ed7f6059867b4f2/stat_predict.R")
# or devtools::source_gist("b508a60786f8af3c0be7b381a667ae07")
ggplot(data_calibration, aes(Observed,Predicted))+
geom_point(color="black",alpha = 1/3) +
facet_grid2(Station ~ Method, scales="free", independent = "all")+
xlab("Measured") +
ylab("Predicted") +
theme_bw()+
geom_smooth(method="lm", se = FALSE) +
stat_smooth(method = "lm", geom = "ribbon", fill = NA, colour = "green") +
stat_predict(method = "lm", geom = "ribbon", fill = NA, colour = "red") +
theme(panel.grid.minor = element_blank())
Footnote: here's an old discussion on whether a prediction interval function should be a part of ggplot2 or not

How to model the residual variance using varFunc from nlme?

To see whether a linear trend exists between age and quartiles of some variable, I fitted a linear model using lm. Plots of the residuals against fitted values as well as residuals against the quartiles indicate heterogeneity of variance.
This image was created through:
m1 <- lm(age ~ quartile, data = DF) #DF = dataframe
op <- par(mfrow = c(1,3))
plot(resid(m1) ~ fitted(m1)) #Homogeneity of variances: graphical
plot(resid(m1) ~ DF$quartile)
qqnorm(resid(m1));qqline(resid(m1))
par(op)
Within the GLS framework, I would like to have the residual variance to depend on the quartiles using one of the classes from the varFunc from the nlme package. I tried multiple functions, though without success.
The sample data below roughly yield the same pattern:
reconstruct <- structure(list(quartile = structure(c(2L, 1L, 4L, 3L, 1L, 1L,
3L, 4L, 3L, 2L, 2L, 3L, 3L, 1L, 2L, 4L, 2L, 2L, 2L, 1L, 1L, 3L,
1L, 1L, 1L, 3L, 3L, 1L, 4L, 3L, 3L, 3L, 2L, 4L, 1L, 1L, 3L, 1L,
3L, 2L, 2L, 4L, 3L, 4L, 1L, 4L, 1L, 4L, 3L, 1L, 1L, 2L, 4L, 2L,
2L, 2L, 1L, 1L, 4L, 1L, 4L, 4L, 3L, 3L, 4L, 4L, 1L, 1L, 2L, 1L,
4L, 3L, 4L, 2L, 3L, 3L, 3L, 1L, 1L, 4L, 1L, 2L, 1L, 2L, 1L, 1L,
2L, 4L, 1L, 3L, 4L, 2L, 4L, 1L, 4L, 4L, 1L, 3L, 4L, 2L, 2L, 1L,
1L, 4L, 2L, 4L, 3L, 4L, 4L, 4L, 3L, 3L, 3L, 3L, 2L, 2L, 4L, 2L,
4L, 1L, 4L, 3L, 4L, 1L, 2L, 1L, 4L, 2L, 1L, 3L, 1L, 4L, 1L, 4L,
4L, 4L, 1L, 1L, 4L, 2L, 4L, 3L, 2L, 2L, 1L, 3L, 1L, 4L, 2L, 3L,
4L, 3L, 4L, 1L, 1L, 2L, 2L, 4L, 1L, 2L, 4L, 2L, 1L, 2L, 1L, 1L,
4L, 3L, 2L, 3L, 2L, 4L, 3L, 4L, 1L, 4L, 1L, 3L, 4L, 4L, 4L, 1L,
4L, 3L, 2L, 4L, 3L, 3L, 2L, 1L, 1L, 4L, 1L, 4L, 2L, 2L, 2L, 4L,
2L, 3L), .Label = c("1", "2", "3", "4"), class = c("ordered",
"factor")), age = c(40.45, 33.49, 41.02, 53.06, 63.46, 47.17,
39.45, 60.71, 67.13, 53.12, 62.78, 70.39, 56.14, 50.55, 35.64,
38.5, 68.53, 53.69, 50.84, 38.66, 35.31, 57.03, 37.84, 35.82,
50.68, 56.44, 65.36, 58.64, 55.98, 56.13, 42.09, 54.91, 35.16,
63.68, 44.5, 51.79, 69.56, 59.11, 55.39, 43.87, 58.12, 65.59,
52.58, 60.17, 48.57, 52.09, 40.04, 35.61, 77.14, 43.82, 48.98,
36.26, 44.63, 62.13, 69.59, 41.22, 47.85, 53.5, 42.08, 49.08,
75.49, 52.39, 41.21, 58.25, 74.37, 64.28, 34.01, 42.99, 34.05,
60.99, 68.82, 41.3, 71.07, 55.21, 52.01, 37.76, 64.54, 57.43,
45.78, 62.9, 67.73, 49.25, 69.68, 51.85, 37.32, 47.37, 53.41,
68.55, 35.31, 63.59, 69.04, 48.03, 50.74, 42.93, 79.23, 72.22,
35.42, 43.26, 45.81, 37.92, 39.26, 60.97, 47.36, 50.19, 43.52,
41.82, 40.42, 54.87, 55.32, 75.74, 69.54, 56.44, 59.85, 50.02,
49.23, 48.38, 34.07, 38.57, 46.57, 35.29, 42.04, 63.35, 34.68,
50.34, 72.5, 40.27, 58.41, 37.79, 34.62, 75.47, 38.91, 46.21,
49.72, 40.55, 66.98, 59.07, 55.8, 38.86, 47.76, 59.16, 74.79,
57.87, 54.82, 43.58, 66.15, 34.55, 50.12, 67.68, 61.1, 40.29,
54.1, 69.8, 60.68, 36.7, 38.31, 46.15, 34.68, 41.92, 38.97, 50.67,
68.53, 40.06, 46.5, 44.38, 47.6, 37.95, 78.39, 54.73, 79.07,
40.05, 48.67, 58.71, 73.07, 75.65, 43.07, 48.25, 44.03, 51.37,
62.16, 54.78, 66.27, 50.25, 60.56, 32.77, 68.41, 37.74, 38.46,
46.33, 41.59, 64.52, 53.66, 71.04, 64.55, 53.25, 40.58, 52.33,
39.64, 52.76, 43.52, 48.45)), row.names = c(1:200), class = "data.frame")
To obtain the image:
m2 <- lm(age ~ quartile, data = reconstruct)
op <- par(mfrow = c(1,3))
plot(resid(m2) ~ fitted(m2))
plot(resid(m2) ~ reconstruct$quartile)
qqnorm(resid(m2));qqline(resid(m2))
par(op)
Any suggestions?

Agglomerative hierachial clustering using R

Plotting a dendogram from a agglomerative hierachial clustering does not yield the expected results. I have attached the example of the expected output in the image here . The y axis shows the treatment groups.
My MWE is
library(cluster)
dist<-daisy(cluster, metric = "gower")
kaari <-hclust(dist, method = "ward.D2")
plot(kaari,cex = 0.6, hang = -1)
Here is the data frame:
structure(list(Variety = structure(c(1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 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,
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, 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, 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, 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,
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, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("Cal J",
"Pesa F1", "Rambo F1", "Riograde"), class = "factor"), Sample.Part = structure(c(3L,
3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L,
4L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("% fruit damage",
"Intermediate", "Lower", "Upper"), class = "factor"), overall = c(8.33,
15.83, 18.33, 18.33, 16.67, 15.83, 17.5, 15, 14.17, 16.67, 15,
18.33, 6.67, 14.17, 6.67, 15.83, 10, 12.5, 10, 15, 35, 55, 50,
25, 12.5, 11.67, 12.5, 13.33, 15.83, 13.33, 14.17, 10, 11.67,
15.83, 8.33, 10.83, 7.5, 7.5, 10.83, 9.17, 5.83, 5.83, 10, 17.5,
20, 12.5, 20, 5, 18.33, 15, 15, 12.5, 10, 15.83, 20.83, 15.83,
18.33, 10, 11.67, 18.33, 10.83, 6.67, 7.5, 14.17, 6.67, 10.83,
37.5, 17.5, 25, 15, 30, 20, 24.17, 22.5, 16.67, 19.17, 14.17,
24.17, 26.67, 20.83, 16.67, 17.5, 14.17, 20, 12.5, 20.83, 11.67,
6.67, 12.5, 11.67, 55, 55, 55, 60, 55, 57.5, 24.17, 28.33, 19.17,
21.67, 20, 18.33, 24.17, 20.83, 17.5, 15, 16.67, 15, 15, 10.83,
11.67, 16.67, 14.17, 10, 30, 45, 55, 42.5, 55, 37.5, 33.33, 20.83,
20, 17.5, 18.33, 20, 28.33, 13.33, 17.5, 13.33, 20.83, 11.67,
11.67, 10.83, 13.33, 8.33, 8.33, 13.33, 55, 40, 55, 52.5, 45,
45, 12.5, 17.5, 15, 21.67, 17.5, 17.5, 14.17, 14.17, 16.67, 14.17,
19.17, 15, 10.83, 13.33, 6.67, 9.17, 8.33, 13.33, 45, 50, 40,
35, 55, 45, 10.83, 9.17, 23.33, 22.5, 15.83, 11.67, 26.67, 8.33,
20, 12.5, 10.83, 18.33, 9.17, 7.5, 9.17, 7.5, 5.83, 13.33, 37.5,
35, 45, 22.5, 30, 25, 15, 13.33, 20, 13.33, 20, 20, 9.17, 21.67,
12.5, 10, 14.17, 24.17, 10.83, 10, 13.33, 9.17, 11.67, 10.83,
45, 45, 42.5, 30, 55, 40, 11.67, 21.67, 18.33, 16.67, 16.67,
16.67, 14.17, 15, 15.83, 20.83, 12.5, 16.67, 10, 12.5, 9.17,
10, 7.5, 6.67, 27.5, 30, 32.5, 45, 17.5, 25, 15.83, 15.83, 17.5,
13.33, 12.5, 13.33, 13.33, 10.83, 19.17, 12.5, 13.33, 12.5, 7.5,
8.33, 9.17, 5.83, 10.83, 10.83, 47.5, 15, 20, 20, 30, 30, 10,
18.33, 12.5, 11.67, 10.83, 13.33, 13.33, 12.5, 10, 10, 13.33,
15, 6.67, 14.17, 7.5, 7.5, 10.83, 7.5, 22.5, 15, 22.5, 20, 25,
15)), .Names = c("Variety", "Sample.Part", "overall"), class = "data.frame", row.names = c(NA,
-288L))
My first and second columns in my data set are categorical while the third is numeric, I have attached the the data here.
Variety Sample.Part overall
Cal J Lower 8.33
Cal J Lower 15.83
Cal J Lower 18.33
Cal J Lower 18.33
Cal J Lower 16.67
Cal J Lower 15.83
Cal J Intermediate 17.50
Cal J Intermediate 15.00
Cal J Intermediate 14.17
Cal J Intermediate 16.67
Cal J Intermediate 15.00
Cal J Intermediate 18.33
Cal J Upper 6.67
Cal J Upper 14.17
Cal J Upper 6.67
Cal J Upper 15.83
Cal J Upper 10.00
Cal J Upper 12.50
Cal J % fruit damage 10.00
Cal J % fruit damage 15.00
Cal J % fruit damage 35.00
Cal J % fruit damage 55.00
Cal J % fruit damage 50.00
I would like to have the factor levels in the first column appear as leaf nodes in the y axis. Any help?

Using cast() or ddply() to summarise the mean for two continuous variables in one dataframe

The data (below) has two columns named "Date" and "Independent Variable (IV)" containing factors, plus two extra columns called "Independent_value" and "Sapflow" containing continuous values.
Column Descriptions:
Date = measurements of the independent variables over 5 months (June-October).
Independent Variable = 3 independent variables (i.e temperature, humidity, and radiation).
Independent Value = represents readings of temperature, radiation, and humidity over daily time steps from June to October.
Sapflow (dependent variable) = sapflow rates in tree species recorded over daily time steps from June to October and how the independent variables may affect these rates of sapflow.
Goal
In this instance, I would like to summarise the data (found below) by group (i.e. Date and Independent variable) using either cast() or ddply() to produce a new data frame showing the mean recorded value of each independent variable (temperature, humidity, and radiation) per month and the mean rate of sapflow for independent variables per month in the following format:-
*Key
*IV = independent variable (i.e.Temperature, Humidity, and Radation)
*Mean_IV = the mean of the independent variable
*Mean_Sapflow (dependent variable) = the mean sapflow rate per month per independent variable
Date IV Mean_IV Mean_Sapflow
1 June Humidity 19.67 14.97
2 June Humidity 18.82 16.31
3 June Humidity 20.38 17.52
4 June Humidity 14.94 7.45
5 June Humidity 12.92 12.18
6 June Humidity 15.28 15.82
Problem:
I have tried using ddply() and cast() and I cannot produce the dataframe format shown above. If anyone can help, I would be deeply appreciative.
*ddply
library(plyr)
summarised_Sapflow<-ddply(Sapflow_new, c("Date", "Independent_Variable"), summarise,
N=length(Independent_Value),
mean("Independent Value","Sapflow"))
The output is a series of warnings:
Warning messages:
1: In mean.default("Independent Value", "Sapflow") :
argument is not numeric or logical: returning NA
2: In mean.default("Independent Value", "Sapflow") :
argument is not numeric or logical: returning NA
3: In mean.default("Independent Value", "Sapflow") :
argument is not numeric or logical: returning NA
cast()
library(reshape)
Sapflow.Summary<-cast(Sapflow_new,
Date~Independent_Variable, mean,
value=c('Independent_Value','Sapflow'))
This output is very close to my goal but mean sapflow is missing and the months contained in the "Date" are organised in the wrong order because the arrangment of my code is probably incorrect.
Date Humidity Radiation Temperature
1 August 18.38968 178.9806 71.73355
2 July 21.80065 270.9065 61.33065
3 June 17.60733 263.6733 70.56133
4 October 11.34867 93.6000 81.74300
5 September 14.82200 152.2333 72.21367
Data:
structure(list(Date = structure(c(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, 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, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L,
5L, 5L, 5L, 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, 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, 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, 2L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 5L,
5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 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, 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, 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, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L,
5L, 5L, 5L, 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), .Label = c("August", "July", "June", "October",
"September"
), class = "factor"), Independent_Variable =
structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 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, 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, 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, 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, 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, 3L,
3L, 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, 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, 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, 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, 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, 2L, 2L), .Label = c("Humidity",
"Radiation",
"Temperature"), class = "factor"), Independent_Value =
c(19.67,
18.82, 20.38, 14.94, 12.92, 15.28, 15.12, 16.05, 15.19,
16.67,
18.69, 14.61, 16.71, 17.35, 16.98, 15.44, 15.21, 18.62,
20.11,
18.64, 15.66, 17.2, 18.21, 19.32, 23.02, 21.69, 18.03,
18.46,
18.45, 20.78, 23.04, 22.05, 19.71, 20.59, 24.89, 23.34,
24.7,
24.2, 22.43, 18.21, 17.66, 18.23, 20.36, 22.83, 23.52,
22.88,
19.59, 21.51, 22.25, 21.47, 22.03, 22.51, 25.54, 24.01,
24.28,
26.21, 23.72, 17.63, 17.27, 19.19, 19.97, 19.84, 22.78,
24.46,
23.05, 23.31, 24.75, 23.23, 18.91, 15.56, 13.51, 15.8,
17.67,
19.18, 18.93, 20.05, 17.1, 16.87, 18.77, 20.49, 21.5,
18.04,
18.82, 17.38, 13.05, 13.13, 13.48, 16.32, 16.74, 16.11,
15.77,
15.48, 18.17, 18.16, 18.44, 16.63, 16.64, 14.47, 13.07,
14.14,
17.27, 16.71, 18.22, 12.9, 13.95, 14.7, 15.78, 17.52,
19.66,
18.87, 18.07, 16.4, 12.92, 10.57, 10.04, 9.78, 10.24,
14.25,
15.92, 11.59, 9.25, 10.33, 11.22, 15.03, 13.67, 14.26,
15.42,
8.34, 8.56, 12.37, 14.38, 15.47, 16.4, 17.15, 20.05,
11.08, 10.63,
14.34, 13.27, 9.33, 8.1, 10.95, 12.79, 8.64, 11.42,
12.12, 9.91,
7.86, 3.51, 4.97, 3.63, 5.59, 85.07, 79.72, 72.83, 90.1,
83.02,
73.34, 77.11, 74.79, 81.66, 77.71, 66.14, 78.15, 69.33,
68.13,
60.31, 69.47, 81.86, 78.63, 77.69, 77.56, 52.88, 53.32,
53.74,
55.85, 49.56, 55.3, 69.25, 74.96, 69.29, 60.07, 54.31,
48.6,
55.73, 56.74, 47.66, 60.51, 55.64, 58.39, 63.8, 63.16,
73.65,
71.08, 64.34, 60.1, 51.61, 54.87, 58.23, 52.49, 52.56,
59.64,
67.85, 64.42, 60.08, 59.71, 57.12, 58.7, 68.85, 72.44,
89.13,
77.67, 62.17, 61.3, 63.58, 66.26, 60.09, 56.63, 53.11,
59.84,
60.06, 80.76, 79.51, 73.96, 84.58, 78.77, 71.65, 72.59,
77.52,
69.04, 78.26, 77.22, 73.75, 81.95, 82.04, 78.14, 73.41,
72.76,
90.68, 74.24, 71.3, 74.4, 60.26, 66.08, 65.18, 57.17,
66.88,
75.53, 71.52, 74.97, 66.02, 78.06, 73.58, 68.18, 83.55,
80.4,
66.28, 72.32, 72.39, 77.74, 69.81, 74.21, 77.37, 88.28,
65.33,
87.54, 80.49, 69.58, 68.18, 69.25, 60.06, 66.38, 68.51,
71.65,
63.29, 76.63, 80.46, 85.56, 81.25, 94.48, 73.87, 76.8,
72.83,
77.55, 81.5, 77.7, 75.79, 94.38, 99.55, 94.14, 87.29,
84.81,
82.63, 85.27, 84.52, 71.13, 76.28, 78.06, 82.83, 75.18,
83.8,
85.38, 84, 85.33, 197.8, 195.5, 288, 72, 160.5, 337.1,
176.9,
242.3, 189.4, 295.7, 363.2, 158, 290, 251.2, 297.3,
192.6, 163.5,
274.5, 210.7, 243.4, 287.4, 375.7, 290.5, 336.4, 361.6,
369.2,
302.6, 295.2, 348.5, 343.5, 327.6, 358.9, 358.6, 288.9,
325.6,
307.8, 321.3, 321.5, 280.6, 264.9, 253, 279.5, 318.1,
285.1,
330.8, 252, 201, 229.9, 259.3, 230.4, 265.5, 214.1, 307,
311.1,
282.5, 256.9, 227.2, 263.4, 68.2, 130.8, 276.6, 299.2,
276.5,
243.9, 291, 289.3, 290.6, 259.6, 220.5, 72.7, 158.9,
233.8, 105.9,
164.2, 168.1, 188.7, 120.1, 217.7, 111.2, 114.7, 143.6,
55.2,
108.5, 162.2, 185, 197.7, 54.1, 126.3, 111.2, 135.4,
228.3, 214.3,
240.1, 247.6, 173, 172.4, 131.9, 149.4, 203.1, 92.3,
168.5, 146.6,
65.9, 103.6, 200.2, 131.3, 183.5, 128.3, 140.6, 124.1,
125.9,
75.8, 173.2, 47.9, 111.7, 205.8, 188.3, 175.6, 193.7,
170.4,
188.3, 108, 171.1, 59.5, 87.7, 142.2, 111.8, 26.3,
129.9, 103.1,
158.7, 147.9, 109.8, 67.8, 106.6, 12.3, 15.8, 53, 63.4,
86.2,
123.3, 112.9, 128.2, 141.9, 81.6, 102, 86.8, 83.9, 50,
96.8,
100.5, 47), Sapflow = c(14.97, 16.31, 17.52, 7.45,
12.18, 15.82,
11.79, 14.45, 10.95, 13.62, 16.28, 11.42, 16.13, 15.09,
17.28,
14.43, 11.7, 16.06, 17.66, 16.33, 17.79, 18.58, 19.41,
19.8,
21.63, 21.35, 17.81, 17.56, 19.37, 21.27, 23.26, 23.67,
22.64,
21.85, 24.81, 22.36, 24.72, 23.87, 23.67, 22.01, 19.23,
19.92,
21.99, 23.6, 24.9, 24.46, 22.22, 23.95, 24.81, 23.88,
22.98,
24.47, 26.09, 25.97, 25.82, 26.24, 25.09, 22, 16.91,
21.35, 25.32,
25.76, 26.38, 25.78, 25.77, 25.15, 26.29, 26.22,
24.59, 18.26,
18.91, 21.57, 21.37, 21.29, 23.96, 24.85, 21.02, 23.05,
22.69,
23.9, 25.24, 25.4, 23.19, 22.8, 22.08, 21.86, 13.82,
22.05, 23.21,
20.12, 22.73, 21.88, 23.33, 24.76, 23.5, 22.06, 22.01,
20.65,
21.54, 19.9, 21.67, 21.84, 18.82, 17.99, 21.41, 23.53,
23.39,
25.75, 22.62, 22.25, 21.81, 16.81, 20.42, 12.08, 12.36,
15.31,
14.14, 15.48, 15.18, 14.19, 12.09, 12.39, 12.34, 12.61,
10.79,
10.53, 11.29, 9.92, 9.79, 10.86, 10.98, 10.58, 12.54,
12.52,
12.25, 6.38, 0.91, 5.24, 6.56, 5.72, 4.55, 4.99, 2.88,
0.99,
1.03, 1.57, 2.07, 2.3, 2.22, 2.11, 2.21, 2.29, 14.97,
16.31,
17.52, 7.45, 12.18, 15.82, 11.79, 14.45, 10.95, 13.62,
16.28,
11.42, 16.13, 15.09, 17.28, 14.43, 11.7, 16.06, 17.66,
16.33,
17.79, 18.58, 19.41, 19.8, 21.63, 21.35, 17.81, 17.56,
19.37,
21.27, 23.26, 23.67, 22.64, 21.85, 24.81, 22.36,
24.72, 23.87,
23.67, 22.01, 19.23, 19.92, 21.99, 23.6, 24.9, 24.46,
22.22,
23.95, 24.81, 23.88, 22.98, 24.47, 26.09, 25.97, 25.82,
26.24,
25.09, 22, 16.91, 21.35, 25.32, 25.76, 26.38, 25.78,
25.77, 25.15,
26.29, 26.22, 24.59, 18.26, 18.91, 21.57, 21.37, 21.29,
23.96,
24.85, 21.02, 23.05, 22.69, 23.9, 25.24, 25.4, 23.19,
22.8, 22.08,
21.86, 13.82, 22.05, 23.21, 20.12, 22.73, 21.88, 23.33,
24.76,
23.5, 22.06, 22.01, 20.65, 21.54, 19.9, 21.67, 21.84,
18.82,
17.99, 21.41, 23.53, 23.39, 25.75, 22.62, 22.25, 21.81,
16.81,
20.42, 12.08, 12.36, 15.31, 14.14, 15.48, 15.18, 14.19,
12.09,
12.39, 12.34, 12.61, 10.79, 10.53, 11.29, 9.92, 9.79,
10.86,
10.98, 10.58, 12.54, 12.52, 12.25, 6.38, 0.91, 5.24,
6.56, 5.72,
4.55, 4.99, 2.88, 0.99, 1.03, 1.57, 2.07, 2.3, 2.22,
2.11, 2.21,
2.29, 14.97, 16.31, 17.52, 7.45, 12.18, 15.82, 11.79,
14.45,
10.95, 13.62, 16.28, 11.42, 16.13, 15.09, 17.28, 14.43,
11.7,
16.06, 17.66, 16.33, 17.79, 18.58, 19.41, 19.8, 21.63,
21.35,
17.81, 17.56, 19.37, 21.27, 23.26, 23.67, 22.64, 21.85,
24.81,
22.36, 24.72, 23.87, 23.67, 22.01, 19.23, 19.92, 21.99,
23.6,
24.9, 24.46, 22.22, 23.95, 24.81, 23.88, 22.98, 24.47,
26.09,
25.97, 25.82, 26.24, 25.09, 22, 16.91, 21.35, 25.32,
25.76, 26.38,
25.78, 25.77, 25.15, 26.29, 26.22, 24.59, 18.26, 18.91,
21.57,
21.37, 21.29, 23.96, 24.85, 21.02, 23.05, 22.69, 23.9,
25.24,
25.4, 23.19, 22.8, 22.08, 21.86, 13.82, 22.05, 23.21,
20.12,
22.73, 21.88, 23.33, 24.76, 23.5, 22.06, 22.01, 20.65,
21.54,
19.9, 21.67, 21.84, 18.82, 17.99, 21.41, 23.53, 23.39,
25.75,
22.62, 22.25, 21.81, 16.81, 20.42, 12.08, 12.36, 15.31,
14.14,
15.48, 15.18, 14.19, 12.09, 12.39, 12.34, 12.61, 10.79,
10.53,
11.29, 9.92, 9.79, 10.86, 10.98, 10.58, 12.54, 12.52,
12.25,
6.38, 0.91, 5.24, 6.56, 5.72, 4.55, 4.99, 2.88, 0.99,
1.03, 1.57,
2.07, 2.3, 2.22, 2.11, 2.21, 2.29)), class =
"data.frame", row.names = c(NA,
-456L))
It is not a ddply() or a cast() solution, but using tidyverse and reshape2 you can do:
df %>%
group_by(Date, Independent_Variable) %>%
summarise(Independent_Value = mean(Independent_Value)) %>%
mutate(Independent_Variable = paste(Independent_Variable, "IV", sep = "_")) %>%
dcast(Date~Independent_Variable, value.var = "Independent_Value") %>%
arrange(factor(Date, levels = month.name)) %>%
left_join(df %>%
group_by(Date, Independent_Variable) %>%
summarise(Sapflow = mean(Sapflow)) %>%
mutate(Independent_Variable = paste(Independent_Variable, "Sapflow", sep = "_")) %>%
dcast(Date~Independent_Variable, value.var = "Sapflow") %>%
arrange(factor(Date, levels = month.name)),
by = c("Date" = "Date"))
Date Humidity_IV Radiation_IV Temperature_IV Humidity_Sapflow
1 June 17.60733 263.6733 70.56133 16.067000
2 July 21.80065 270.9065 61.33065 23.356774
3 August 18.38968 178.9806 71.73355 22.941613
4 September 14.82200 152.2333 72.21367 19.309333
5 October 11.34867 93.6000 81.74300 6.700667
Radiation_Sapflow Temperature_Sapflow
1 16.067000 16.067000
2 23.356774 23.356774
3 22.941613 22.941613
4 19.309333 19.309333
5 6.700667 6.700667
First, it is grouping by "Date" and "Independent_Variable" and summarising "Independent_Value". Second, it is adding "_IV" to the values in Independent_Variable. Third, it is reshaping the data and arranging according the real order of months. Fourth, it is doing the first three steps for "Sapflow". Finally, it is merging the two.
Or by using just tidyverse:
df %>%
group_by(Date, Independent_Variable) %>% #Grouping
summarise_all(funs(mean = mean(.))) %>% #Summarising all variables and adding "_mean" to the new variables
arrange(factor(Date, levels = month.name)) #Arranging according the real order of months
Date Independent_Variable Independent_Value_mean Sapflow_mean
<fct> <fct> <dbl> <dbl>
1 June Humidity 17.6 16.1
2 June Radiation 264. 16.1
3 June Temperature 70.6 16.1
4 July Humidity 21.8 23.4
5 July Radiation 271. 23.4
6 July Temperature 61.3 23.4

Different x and y axis scales in multifaceted scatter ggplot2

I have used lemon package with ggplot2 for plotting multifaceted scatter plot with regression and confidence interval line using the following code
library(tidyverse)
library(lemon)
#Plotting
ggplot(data_calibration, aes(Observed,Predicted))+
geom_point(color="black",alpha = 1/3) +
facet_rep_grid(Station ~ Method, scales="free",
repeat.tick.labels = "all")+
xlab("Measured") +
ylab("Predicted")+ theme_bw()+
geom_smooth(method="lm")
I want to have both x and y-axis scales to be free. But I am only getting free y-axis scale.
Also, I want to add the prediction interval to the plots.
Here is the dataset in dput() format.
data_calibration = structure(list(Observed = c(17229L, 15964L, 13373L, 17749L, 12457L,
7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L, 7197L, 7220L,
7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L, 11465L,
11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L, 10759L,
9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L, 3183L,
9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L, 17749L,
12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L, 7197L,
7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L, 17229L, 15964L, 13373L,
17749L, 12457L, 7166L, 7842L, 8675L, 11718L, 6049L, 4232L, 4126L,
7197L, 7220L, 7284L, 16410L, 15772L, 12166L, 11997L, 7827L, 13034L,
11465L, 11409L, 10165L, 9702L, 2942L, 2940L, 4361L, 6197L, 6144L,
10759L, 9720L, 8631L, 7354L, 7640L, 6653L, 7551L, 6791L, 9093L,
3183L, 9078L, 8688L, 11023L, 9000L, 9001L), Station = structure(c(1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Raigad",
"Ratnagiri", "Thane "), class = "factor"), Method = structure(c(6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 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, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
3L, 3L, 3L, 3L, 3L, 3L, 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, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
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, 4L, 4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), .Label = c("ANN",
"ELNET", "LASSO", "PCA-ANN", "PCA-MLR", "SMLR"), class = "factor"),
Predicted = c(14463L, 14285L, 14452L, 12765L, 11917L, 8143L,
11251L, 8611L, 6789L, 2059L, 2787L, 2201L, 3062L, 4508L,
4975L, 15357L, 15605L, 12326L, 10377L, 9113L, 13926L, 13142L,
11407L, 8711L, 7801L, 2064L, 4563L, 4725L, 6247L, 7170L,
9492L, 8857L, 10323L, 7389L, 6776L, 7842L, 8261L, 6156L,
8627L, 4326L, 8094L, 8897L, 10370L, 10214L, 8548L, 16043L,
16671L, 15831L, 13463L, 11921L, 10239L, 9110L, 8090L, 10794L,
5826L, 3621L, 5639L, 7364L, 8152L, 5515L, 15182L, 14370L,
13559L, 12748L, 11936L, 11125L, 10313L, 9502L, 8691L, 7879L,
7068L, 6257L, 5445L, 4634L, 3822L, 10045L, 9911L, 11038L,
9255L, 8736L, 8848L, 8063L, 7847L, 8538L, 6744L, 9583L, 10474L,
8343L, 10353L, 8791L, 13185L, 13331L, 13099L, 12557L, 11898L,
10474L, 11199L, 10255L, 9251L, 6148L, 6795L, 6166L, 7775L,
8157L, 7990L, 14843L, 15086L, 12585L, 10987L, 10193L, 13663L,
11317L, 11071L, 9392L, 6991L, 4484L, 4667L, 4846L, 5830L,
6577L, 9085L, 8802L, 9570L, 7770L, 7652L, 8006L, 7995L, 6599L,
9050L, 4876L, 8360L, 8981L, 9931L, 9479L, 8009L, 13775L,
13890L, 13416L, 12851L, 12141L, 10693L, 10834L, 10372L, 9585L,
5914L, 5930L, 5922L, 7854L, 7407L, 7697L, 14941L, 15174L,
12572L, 10817L, 10412L, 13705L, 11154L, 10886L, 9448L, 7215L,
4389L, 4875L, 4809L, 5747L, 6385L, 9034L, 8749L, 9410L, 7820L,
7798L, 7940L, 7957L, 6803L, 8844L, 5227L, 8369L, 8972L, 9789L,
9514L, 7940L, 15309L, 14477L, 14219L, 18581L, 12084L, 10550L,
8666L, 8812L, 11415L, 5566L, 3928L, 4592L, 7861L, 7489L,
6903L, 12509L, 13366L, 11956L, 11880L, 8711L, 12768L, 11690L,
10922L, 4101L, 10106L, 2811L, 2979L, 4785L, 5944L, 5901L,
10007L, 8710L, 8688L, 7383L, 7575L, 8047L, 7938L, 6585L,
9517L, 3729L, 8816L, 8704L, 10847L, 8812L, 8493L, 18115L,
15670L, 15931L, 16804L, 12450L, 7701L, 7588L, 8450L, 9205L,
5477L, 4666L, 4948L, 8262L, 7095L, 6798L, 12902L, 12883L,
12864L, 12788L, 12690L, 12896L, 12491L, 12199L, 11982L, 5213L,
5357L, 5053L, 5013L, 5321L, 5596L, 9467L, 8931L, 9305L, 7867L,
8427L, 8282L, 7291L, 6396L, 9725L, 5509L, 8545L, 8997L, 10171L,
10389L, 8700L)), class = "data.frame", row.names = c(NA,
-270L))
Thanks in advance for the help.
I have solved this issue after taking help from this post.
First, create two plots using facet_grid and facet_wrap.
g1 = ggplot(data_calibration, aes(Observed,Predicted))+
geom_point(color="black",alpha = 1/3) +
facet_wrap(Station ~ Method, scales="free", ncol=6)+
xlab("Measured") +
ylab("Predicted")+ theme_bw()+
geom_smooth(method="lm")+
theme(strip.background = element_blank(),
strip.text = element_blank())
g2 = ggplot(data_calibration, aes(Observed,Predicted))+
geom_point(color="black",alpha = 1/3) +
facet_grid(Station ~ Method, scales="free")+
xlab("Measured") +
ylab("Predicted")+ theme_bw()+
geom_smooth(method="lm")
Now replace the top facet strips of g1 with those from g2
library(grid)
library(gtable)
gt1 = ggplot_gtable(ggplot_build(g1))
gt2 = ggplot_gtable(ggplot_build(g2))
gt1$grobs[grep('strip-t.+1$', gt1$layout$name)] = gt2$grobs[grep('strip-t', gt2$layout$name)]
grid.draw(gt1)
Add the right-hand panel strips
gt1 = gtable_add_cols(gt1, widths=gt1$widths[1], pos = -1)
panel_id <- gt1$layout[grep('panel-.+1$', gt1$layout$name),]
gt.side1 = gtable_filter(gt2, 'strip-r-1')
gt.side2 = gtable_filter(gt2, 'strip-r-2')
gt.side3 = gtable_filter(gt2, 'strip-r-3')
gt1 = gtable_add_grob(gt1, zeroGrob(), t = 1, l = ncol(gt1), b=nrow(gt1))
gt1 = gtable_add_grob(gt1, gt.side1, t = panel_id$t[1], l = ncol(gt1))
gt1 = gtable_add_grob(gt1, gt.side2, t = panel_id$t[2], l = ncol(gt1))
gt1 = gtable_add_grob(gt1, gt.side3, t = panel_id$t[3], l = ncol(gt1))
grid.newpage()
grid.draw(gt1)
Update
I got a very nice solution using facet_grid2 function of ggh4x package. With just one line the task can be achieved like
ggplot(data_calibration, aes(Observed,Predicted))+
geom_point(color="black",alpha = 1/3) +
facet_grid2(Station ~ Method, scales="free", independent = "all")+
xlab("Measured") +
ylab("Predicted")+ theme_bw()+
geom_smooth(method="lm")

Resources