ggplot: facets with their own order of factors on x axis

There have been many similar questions but did not find exactly what I was looking for. I have the following dataset:

dat<-data.frame(Pal=rep(c("A","B","C","D"),each=5),
            Rol=c("aa","aa","aa","aa","bb","aa","aa","aa","aa","aa","cc","cc","cc","cc","cc","aa","aa","aa","aa","aa"),
            Cel=rep(c("home","tree","hat","ball","pen","rope"),times=c(5,3,2,5,2,3)),
            Value=c(7701.1,59897.3,59897.3,59897.3,744438.1,1226.4,1454.6,1454.6,1454.6,1454.6,56600,92400,5010000,7010000,15740000,28.5,34.2,39.9,48.5,57),
            Col=c("black","red","black","black","red","red","red","black","black","black","red","red","red","red","red","red","black","black","black","black"),
            Effect=c("length","length","length","length","height","weight","length","length","age of youngest individual found miles from the closest coastline","age of youngest individual found miles from the closest coastline","pressure","speed","rate","rate","length","length","rate","rate","O2","fecundity")
            )

I'm trying to build a slightly complex graph as the one you can see below:

highlights<-data.frame(Pal=c("A","B","C","D"))
highlights$Pal<-factor(highlights$Pal,levels=c("A","B","C","D"))

ggplot() + 
  geom_rect(data=highlights,aes(xmin=-Inf, xmax=Inf, ymin=1, ymax=1000000000), fill=c("yellow","blue","red","green"), alpha=0.05) +
  geom_point(data = dat, aes(x=Effect, y=Value, shape=Rol, col=Col)) +
  scale_color_manual(breaks=unique(dat$Col), values=as.character(unique(dat$Col))) +
  labs(x="",y="Activity") + facet_grid(.~Pal, scales = "free_x")+
  scale_y_log10(limits=c(1,1000000000),breaks = c(1,10,100,1000,10000,100000,1000000,10000000,100000000,100000000,1000000000)) +
  scale_x_discrete(labels = function(x) str_wrap(x, width = 40)) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1),
        panel.background = element_rect(fill = "white", colour = "white"),
        strip.background = element_rect(fill = "white", colour = "black"),
        legend.key = element_rect(fill = "white"))

I would like to have the data points to be in an increasing order within each facet. Since the data are already sorted in that way, I have tried to use the "facet_grid_sc" function from the "facetscales" library to create individual facet x-axis scale based on the unique "Effect" column I have in the data as following:

my_scales <- list(
  "A" = scale_x_discrete(limits = as.character(unique(dat[which(dat$Pal=="A"),"Effect"]))),
  "B" = scale_x_discrete(limits = as.character(unique(dat[which(dat$Pal=="B"),"Effect"]))),
  "C" = scale_x_discrete(limits = as.character(unique(dat[which(dat$Pal=="C"),"Effect"]))),
  "D" = scale_x_discrete(limits = as.character(unique(dat[which(dat$Pal=="D"),"Effect"])))
)


ggplot() + 
  geom_rect(data=highlights,aes(xmin=-Inf, xmax=Inf, ymin=1, ymax=1000000000), fill=c("yellow","blue","red","green"), alpha=0.05) +
  geom_point(data = dat, aes(x=Effect, y=Value, shape=Rol, col=Col)) +
  scale_color_manual(breaks=unique(dat$Col), values=as.character(unique(dat$Col))) +
  labs(x="",y="Activity") + facet_grid_sc(cols = vars(Pal), scales=list(x = my_scales)) +
  scale_y_log10(limits=c(1,1000000000),breaks = c(1,10,100,1000,10000,100000,1000000,10000000,100000000,100000000,1000000000)) +
  scale_x_discrete(labels = function(x) str_wrap(x, width = 40)) +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1),
        panel.background = element_rect(fill = "white", colour = "white"),
        strip.background = element_rect(fill = "white", colour = "black"),
        legend.key = element_rect(fill = "white"))

While this way it solves the problem as I have data points in an increasing order, it completely screws up the plot. Does any of you have a solution for this? Highly appreciated

Thanks

EDIT: Following @Quentin answer, I do provide a slightly larger randomly generated dataset for which the solution seems not to work:

dat<-data.frame(Pal=rep(c("A","B","C","D"),times=c(20,40,60,30)),
                Rol=c(rep("aa",15),rep("bb",5),rep("aa",40),rep("cc",60),rep("aa",30)),
                Cel=rep(c("home","tree","hat","ball","arm","leg","beer","stick","pen","rope"),times=c(15,13,12,12,13,12,15,18,17,23)),
                Value=c(runif(n=20,min = 7000, max = 100000),runif(n=40,min = 100, max = 100000),runif(n=60,min = 1000, max = 1000000),runif(n=30,min = 100000, max = 10000000)),
                Col=rep(c("red","black"),each=5,times=15),
                Effect=c(rep(c("length","height"),times=c(15,5)),rep(c("weight","length","age of youngest individual found miles from the closest coastline"),times=c(10,7,23)),rep(c("pressure","speed","rate","length"),times=c(10,3,7,40)),rep(c("length","rate","O2","fecundity"),times=c(3,4,7,16)))
)

Any fixing to this?

Thanks in advance

Solution

Edit after comment

You should slightly modify the reorder_within function, by setting max instead of mean like this:

dat<-data.frame(Pal=rep(c("A","B","C","D"),times=c(20,40,60,30)),
                Rol=c(rep("aa",15),rep("bb",5),rep("aa",40),rep("cc",60),rep("aa",30)),
                Cel=rep(c("home","tree","hat","ball","arm","leg","beer","stick","pen","rope"),times=c(15,13,12,12,13,12,15,18,17,23)),
                Value=c(runif(n=20,min = 7000, max = 100000),runif(n=40,min = 100, max = 100000),runif(n=60,min = 1000, max = 1000000),runif(n=30,min = 100000, max = 10000000)),
                Col=rep(c("red","black"),each=5,times=15),
                Effect=c(rep(c("length","height"),times=c(15,5)),rep(c("weight","length","age of youngest individual found miles from the closest coastline"),times=c(10,7,23)),rep(c("pressure","speed","rate","length"),times=c(10,3,7,40)),rep(c("length","rate","O2","fecundity"),times=c(3,4,7,16)))
)

library(ggplot2)
library(forcats)

reorder_within <- function(x, by, within, fun = max, sep = "___", ...) {
  new_x <- paste(x, within, sep = sep)
  stats::reorder(new_x, by, FUN = fun)
}

scale_x_reordered <- function(..., sep = "___") {
  reg <- paste0(sep, ".+$")
  ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}

highlights<-data.frame(Pal=c("A","B","C","D"))
highlights$Pal<-factor(highlights$Pal,levels=c("A","B","C","D"))

ggplot() + 
  geom_rect(data=highlights,aes(xmin=-Inf, xmax=Inf, ymin=1, ymax=1000000000), fill=c("yellow","blue","red","green"), alpha=0.05) +
  geom_point(data = dat, aes(x=reorder_within(Effect, Value, Pal), y=Value, shape=Rol, col=Col)) +
  scale_color_manual(breaks=unique(dat$Col), values=as.character(unique(dat$Col))) +
  labs(x="",y="Activity") + facet_grid(.~Pal, scales = "free_x")+
  scale_y_log10(limits=c(1,1000000000),breaks = c(1,10,100,1000,10000,100000,1000000,10000000,100000000,100000000,1000000000)) +
  scale_x_reordered() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1),
        panel.background = element_rect(fill = "white", colour = "white"),
        strip.background = element_rect(fill = "white", colour = "black"),
        legend.key = element_rect(fill = "white"))

^{Created on 2022-07-20 by the reprex package (v2.0.1)}

Old answer

You can use the functions reorder_within and scale_x_reordered from this GitHub like this:

dat<-data.frame(Pal=rep(c("A","B","C","D"),each=5),
                Rol=c("aa","aa","aa","aa","bb","aa","aa","aa","aa","aa","cc","cc","cc","cc","cc","aa","aa","aa","aa","aa"),
                Cel=rep(c("home","tree","hat","ball","pen","rope"),times=c(5,3,2,5,2,3)),
                Value=c(7701.1,59897.3,59897.3,59897.3,744438.1,1226.4,1454.6,1454.6,1454.6,1454.6,56600,92400,5010000,7010000,15740000,28.5,34.2,39.9,48.5,57),
                Col=c("black","red","black","black","red","red","red","black","black","black","red","red","red","red","red","red","black","black","black","black"),
                Effect=c("length","length","length","length","height","weight","length","length","age of youngest individual found miles from the closest coastline","age of youngest individual found miles from the closest coastline","pressure","speed","rate","rate","length","length","rate","rate","O2","fecundity")
)

library(ggplot2)
library(forcats)

reorder_within <- function(x, by, within, fun = mean, sep = "___", ...) {
  new_x <- paste(x, within, sep = sep)
  stats::reorder(new_x, by, FUN = fun)
}

scale_x_reordered <- function(..., sep = "___") {
  reg <- paste0(sep, ".+$")
  ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}

highlights<-data.frame(Pal=c("A","B","C","D"))
highlights$Pal<-factor(highlights$Pal,levels=c("A","B","C","D"))

ggplot() + 
  geom_rect(data=highlights,aes(xmin=-Inf, xmax=Inf, ymin=1, ymax=1000000000), fill=c("yellow","blue","red","green"), alpha=0.05) +
  geom_point(data = dat, aes(x=reorder_within(Effect, Value, Pal), y=Value, shape=Rol, col=Col)) +
  scale_color_manual(breaks=unique(dat$Col), values=as.character(unique(dat$Col))) +
  labs(x="",y="Activity") + facet_grid(.~Pal, scales = "free_x")+
  scale_y_log10(limits=c(1,1000000000),breaks = c(1,10,100,1000,10000,100000,1000000,10000000,100000000,100000000,1000000000)) +
  scale_x_reordered() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1),
        panel.background = element_rect(fill = "white", colour = "white"),
        strip.background = element_rect(fill = "white", colour = "black"),
        legend.key = element_rect(fill = "white"))

^{Created on 2022-07-20 by the reprex package (v2.0.1)}