Первый и последний фасеты, использующие facet_wrap с ggplotly, больше, чем средние фасеты

Question

Использование данных примера:

library(tidyverse)
library(plotly)

myplot <- diamonds %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, ncol = 8, scales = "free", strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

ggplotly(myplot)

Возвращает что-то вроде:

, где внутренние грани ужасно масштабируются по сравнению с первый и последний и есть много дополнительных дополнений. Я пытался найти решение из этих вопросов:

ggplotly не работает должным образом, когда число больше фасетов

R: facet_wrap не правильно отображает с ggplotly в приложении Shiny

Методом проб и ошибок я использовал panel.spacing.x = unit(-0.5, "line") в theme(), и он выглядит немного лучше, с большим количеством лишних отступов, но внутренние грани все еще заметно меньше.

Также как дополнительный вопрос, но не так важно, полосовые метки являются главными в вызове ggplotly(), когда я их устанавливаю на дно. Похоже на текущую проблему здесь , есть ли у кого-нибудь хакерский обходной путь?

Редактировать: в моем реальном наборе данных мне нужны метки оси Y для каждой из граней, так как их масштабы весьма различны, поэтому Я держал их в примере и поэтому мне нужно facet_wrap. Скриншот моего реального набора данных для объяснения:

Answer 1

Обновленный ответ (2): просто используйте fixfacets()

Я собрал функцию fixfacets(fig, facets, domain_offset), которая превращает это:

... используя это:

f <- fixfacets(figure = fig, facets <- unique(df$clarity), domain_offset <- 0.06)

... в это:

Эта функция теперь должна быть достаточно гибкой в ​​отношении количества граней.

Полный код:

library(tidyverse)
library(plotly)

# YOUR SETUP:

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free', shrink = FALSE, ncol = 8, strip.position = "bottom", dir='h') +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())
fig <- ggplotly(myplot)

# Custom function that takes a ggplotly figure and its facets as arguments.
# The upper x-values for each domain is set programmatically, but you can adjust
# the look of the figure by adjusting the width of the facet domain and the 
# corresponding annotations labels through the domain_offset variable
fixfacets <- function(figure, facets, domain_offset){

  # split x ranges from 0 to 1 into
  # intervals corresponding to number of facets
  # xHi = highest x for shape
  xHi <- seq(0, 1, len = n_facets+1)
  xHi <- xHi[2:length(xHi)]

  xOs <- domain_offset

  # Shape manipulations, identified by dark grey backround: "rgba(217,217,217,1)"
  # structure: p$x$layout$shapes[[2]]$
  shp <- fig$x$layout$shapes
  j <- 1
  for (i in seq_along(shp)){
    if (shp[[i]]$fillcolor=="rgba(217,217,217,1)" & (!is.na(shp[[i]]$fillcolor))){
       #$x$layout$shapes[[i]]$fillcolor <- 'rgba(0,0,255,0.5)' # optionally change color for each label shape
       fig$x$layout$shapes[[i]]$x1 <- xHi[j]
       fig$x$layout$shapes[[i]]$x0 <- (xHi[j] - xOs)
       #fig$x$layout$shapes[[i]]$y <- -0.05
       j<-j+1
    }
  }

  # annotation manipulations, identified by label name
  # structure: p$x$layout$annotations[[2]]
  ann <- fig$x$layout$annotations
  annos <- facets
  j <- 1
  for (i in seq_along(ann)){
    if (ann[[i]]$text %in% annos){
       # but each annotation between high and low x,
       # and set adjustment to center
       fig$x$layout$annotations[[i]]$x <- (((xHi[j]-xOs)+xHi[j])/2)
       fig$x$layout$annotations[[i]]$xanchor <- 'center'
       #print(fig$x$layout$annotations[[i]]$y)
       #fig$x$layout$annotations[[i]]$y <- -0.05
       j<-j+1
    }
  }

  # domain manipulations
  # set high and low x for each facet domain
  xax <- names(fig$x$layout)
  j <- 1
  for (i in seq_along(xax)){
    if (!is.na(pmatch('xaxis', lot[i]))){
      #print(p[['x']][['layout']][[lot[i]]][['domain']][2])
      fig[['x']][['layout']][[xax[i]]][['domain']][2] <- xHi[j]
      fig[['x']][['layout']][[xax[i]]][['domain']][1] <- xHi[j] - xOs
      j<-j+1
    }
  }

  return(fig)
}

f <- fixfacets(figure = fig, facets <- unique(df$clarity), domain_offset <- 0.06)
f

Обновленный ответ (1): Как обрабатывать каждый элемент программно!

Элементами вашей фигуры, которые требуют некоторого редактирования для удовлетворения ваших потребностей в отношении поддержания масштабирования каждого фасета и исправления странного макета, являются:

1. x аннотации надписей через fig$x$layout$annotations,
2. x надписи формируются через fig$x$layout$shapes и
3. положение, где каждый фасет начинается и останавливается вдоль оси x до fig$x$layout$xaxis$domain

Единственной реальной проблемой было, например, указание правильных форм и аннотаций среди многих других форм и аннотаций. Приведенный ниже фрагмент кода будет делать именно это для создания следующего графика:

Для фрагмента кода может потребоваться тщательная настройка для каждого случая в отношении аспекта Имена и количество имен, но сам по себе код довольно прост c, поэтому у вас не должно быть никаких проблем с этим. Я полирую sh немного больше, когда найду время.

Полный код:

ibrary(tidyverse)
library(plotly)

# YOUR SETUP:

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free', shrink = FALSE, ncol = 8, strip.position = "bottom", dir='h') +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())
#fig <- ggplotly(myplot)

# MY SUGGESTED SOLUTION:

# get info about facets
# through unique levels of clarity
facets <- unique(df$clarity)
n_facets <- length(facets)

# split x ranges from 0 to 1 into
# intervals corresponding to number of facets
# xHi = highest x for shape
xHi <- seq(0, 1, len = n_facets+1)
xHi <- xHi[2:length(xHi)]

# specify an offset from highest to lowest x for shapes
xOs <- 0.06

# Shape manipulations, identified by dark grey backround: "rgba(217,217,217,1)"
# structure: p$x$layout$shapes[[2]]$
shp <- fig$x$layout$shapes
j <- 1
for (i in seq_along(shp)){
  if (shp[[i]]$fillcolor=="rgba(217,217,217,1)" & (!is.na(shp[[i]]$fillcolor))){
     #fig$x$layout$shapes[[i]]$fillcolor <- 'rgba(0,0,255,0.5)' # optionally change color for each label shape
     fig$x$layout$shapes[[i]]$x1 <- xHi[j]
     fig$x$layout$shapes[[i]]$x0 <- (xHi[j] - xOs)
     j<-j+1
  }
}

# annotation manipulations, identified by label name
# structure: p$x$layout$annotations[[2]]
ann <- fig$x$layout$annotations
annos <- facets
j <- 1
for (i in seq_along(ann)){
  if (ann[[i]]$text %in% annos){
     # but each annotation between high and low x,
     # and set adjustment to center
     fig$x$layout$annotations[[i]]$x <- (((xHi[j]-xOs)+xHi[j])/2)
     fig$x$layout$annotations[[i]]$xanchor <- 'center'

     j<-j+1
  }
}

# domain manipulations
# set high and low x for each facet domain
lot <- names(fig$x$layout)
j <- 1
for (i in seq_along(lot)){
  if (!is.na(pmatch('xaxis', lot[i]))){
    #print(p[['x']][['layout']][[lot[i]]][['domain']][2])
    fig[['x']][['layout']][[lot[i]]][['domain']][2] <- xHi[j]
    fig[['x']][['layout']][[lot[i]]][['domain']][1] <- xHi[j] - xOs
    j<-j+1
  }
}

fig

---

Первоначальные ответы, основанные на построенных -в функциональности

---

Со многими переменными очень разных значений кажется, что вы получите сложный формат, независимо от того, что означает

1. граней будет иметь различную ширину, или метки
2. будут закрывать грани или будут слишком маленькими, чтобы их можно было прочитать, или
3. рисунок будет слишком широким для отображения без полосы прокрутки.

Так что я бы посоветовал перемасштабировать столбец price для каждой уникальной ясности и установить scale='free_x. Я все еще надеюсь, что кто-то придумает лучший ответ. Но вот что я бы сделал:

График 1: Пересчитанные значения и scale='free_x

Код 1:

#install.packages("scales")
library(tidyverse)
library(plotly)
library(scales)

library(data.table)
setDT(df)

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

# rescale price for each clarity
setDT(df)
clarities <- unique(df$clarity)
for (c in clarities){
  df[clarity == c, price := rescale(price)]
}

df$price <- rescale(df$price)

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free_x', shrink = FALSE, ncol = 8, strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

p <- ggplotly(myplot)
p

Это, конечно, только даст представление о внутреннем распределении каждой категории, так как значения были изменены. Если вы хотите показать необработанные данные о ценах и сохранить удобочитаемость, я бы предложил освободить место для полосы прокрутки, установив достаточно большой width.

График 2: scales='free' и достаточно большой ширины:

Код 2:

library(tidyverse)
library(plotly)

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free', shrink = FALSE, ncol = 8, strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

p <- ggplotly(myplot, width = 1400)
p

И, конечно, если Ваши значения не сильно различаются по категориям, scales='free_x' будет работать просто отлично.

График 3: scales='free_x

Код 3:

library(tidyverse)
library(plotly)

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free_x', shrink = FALSE, ncol = 8, strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

p <- ggplotly(myplot)
p

Answer 2

иногда полезно рассмотреть другой сюжет вообще, если вы боретесь с выбранным сюжетом. Все зависит от того, что вы будете sh визуализировать. Иногда работают коробочные графики, иногда работают гистограммы и иногда работают плотности. Вот пример того, как график плотности может дать вам быстрое представление о распределении данных для многих параметров.

library(tidyverse)
library(plotly)
myplot <- diamonds %>% ggplot(aes(price, colour = clarity)) +
  geom_density(aes(fill = clarity), alpha = 0.25) +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())