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")