I am trying to make multiple plots of my data whilst colour coding them based on a grouping. I want to include legends on each plot that go outside the scope of the box. This works however, my first plot has no legend but the rest of my plots do.
For example:
library(faraway)
library(tidyverse)
library(glue)
data(savings)
group_data <- mapply(function(x, y) {
savings %>% mutate(test = ifelse(.[, y] > x, "Group 1 (GT)", "Group 2 (LT)"))
}, val, names(val), SIMPLIFY = FALSE) %>%
mapply(function(a,z) {
a %>% `colnames<-`(c(names(.)[-length(.)], glue("{z}_group")))
}, ., names(.), SIMPLIFY = FALSE) %>%
Reduce(cbind, .) %>%
.[, !duplicated(names(.))]
nn <- length(val)
ng <- names(group_data)[(length(group_data)-nn 1):length(group_data)]
n2 <- n2mfrow(nn, 2)
par(mfrow=n2, xpd=TRUE)
mapply(function(q, w){
form <- reformulate(q, response='sr')
plot(form, data=group_data, col=c('red', 'blue')[as.factor(group_data[,w])], pch=c(19, 19))
legend( x=0, 26,
legend=c("Group 1 (GT)","Group 2 (LT)"),
col=c("red","blue"), lwd=1, lty=c(0,0),
pch=c(19,19), bty='n' )
},names(val),ng, SIMPLIFY=FALSE)
The data val:
list(pop15 = 35, pop75 = 2.5, dpi = 2000, ddpi = 7)
With response to the comments by @Harre, the following manipulates x for the missing legend:
if(q == 'pop15'){
legend( x=21, 26,
legend=c("Group 1 (GT)","Group 2 (GT)"),
col=c("red","blue"), lwd=1, lty=c(0,0),
pch=c(19,19), bty='n' )} else{
legend( x=0, 26,
legend=c("Group 1 (GT)","Group 2 (LT)"),
col=c("red","blue"), lwd=1, lty=c(0,0),
pch=c(19,19), bty='n' )
}
And I see all 4 legends now.
Unfortunately, If I add more columns likeso:
savings$status <- savings$pop15 1
val <- c(val, status=list(37))
Then repeat the code I get the following:

With @Harre's answer I got led to the right solution:
group_data <- mapply(function(x, y) {
savings %>% mutate(group = ifelse(.[, y] > x, "Group 1 (GT)", "Group 2 (LT)"))
}, val, names(val), SIMPLIFY = FALSE) %>%
mapply(function(a,z) {
a %>% `colnames<-`(c(names(.)[-length(.)], glue("{z}_group")))
}, ., names(.), SIMPLIFY = FALSE) %>%
Reduce(cbind, .) %>%
.[, !duplicated(names(.))] %>% pivot_longer(-c(1:(length(.)-nn))) %>% dplyr::select(group=value) %>% cbind.data.frame(savings %>% pivot_longer(-c(1)), .)
val_hline <- val %>% unlist() %>% data.frame(hline=.) %>% rownames_to_column() %>% `colnames<-`(c('name', 'hline'))
kop <- inner_join(group_data, val_hline, by='name')
kop %>% ggplot(aes(x = value, y = sr, color = group))
geom_point()
facet_wrap(name ~ ., scales = "free") theme_bw()
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
strip.background = element_blank(),
panel.border = element_rect(colour = "black", fill = NA),
legend.position = "bottom")
stat_smooth(method='lm')
geom_vline(aes(xintercept=hline))
CodePudding user response:
A suggested ggplot-solution, in the case you want to explore:
savings |>
pivot_longer(-sr) |>
# I have collected your val's here for illustration; feel free to use the lists
mutate(group = case_when(name == "pop15" & value > 35 ~ "Group 1 (GT)",
name == "pop75" & value > 2.5 ~ "Group 1 (GT)",
name == "dpi" & value > 2000 ~ "Group 1 (GT)",
name == "ddpi" & value > 7 ~ "Group 1 (GT)",
TRUE ~ "Group 2 (GT)")) |>
ggplot(aes(x = value, y = sr, color = group))
geom_point()
facet_wrap(name ~ ., scales = "free")
theme(legend.position = "bottom")



