r - 使用 facet_wrap 和 ggplotly 的第一个和最后一个方面比中间方面大

标签 r ggplot2 plotly ggplotly

使用样本数据:

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)

返回类似:

enter image description here

与第一个和最后一个相比，内部刻面的缩放非常糟糕，并且有很多额外的填充。我试图从这些问题中找到解决方案:

ggplotly not working properly when number are facets are more

R: facet_wrap does not render correctly with ggplotly in Shiny app

经过反复试验，我使用了 panel.spacing.x = unit(-0.5, "line")在 theme()它看起来好一点，很多额外的填充消失了，但内部刻面仍然明显更小。

enter image description here

同样作为一个额外的问题，但不是那么重要，条形标签位于 ggplotly() 的顶部。调用，当我将它们设置在底部时。似乎是一个持续存在的问题 here ，有没有人有一个hacky的解决方法？

编辑:在我的真实数据集中，我需要每个方面的 y 轴标签，因为它们的比例非常不同，所以我将它们保留在示例中，这就是为什么我需要 facet_wrap .我的真实数据集的屏幕截图以供解释:

enter image description here

最佳答案

更新答案(2):只需使用 fixfacets()
我整理了一个函数 fixfacets(fig, facets, domain_offset)这变成了这个:

enter image description here

...通过使用这个:
f <- fixfacets(figure = fig, facets <- unique(df$clarity), domain_offset <- 0.06)
...进入这个:

enter image description here

这个函数现在应该在方面的数量方面非常灵活。

完整代码:

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):如何以编程方式处理每个元素!

需要进行一些编辑以满足您在保持每个方面的缩放比例和修复奇怪布局方面的需求的图形元素是:
  • x 标签注释通过 fig$x$layout$annotations ,
  • x 标签形状通过 fig$x$layout$shapes , 和
  • 每个面沿 x 轴开始和停止的位置到 fig$x$layout$xaxis$domain

    • 例如，唯一真正的挑战是在许多其他形状和注释中引用正确的形状和注释。下面的代码片段将完全执行此操作以生成以下图:

    enter image description here

    代码片段可能需要针对每种情况在构面名称和名称数量方面进行一些仔细调整，但代码本身非常基本，因此您应该不会有任何问题。有空我自己再打磨一下。

    完整代码:
    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

    基于内置功能的初步答案

    有许多值非常不同的变量，似乎无论如何你最终都会得到一个具有挑战性的格式，这意味着要么
  • 刻面将具有不同的宽度，或
  • 标签将覆盖面或太小而无法阅读，或
  • 如果没有滚动条，图形将太宽而无法显示。

    • 所以我的建议是重新调整您的 price每个独特的清晰度和设置的列scale='free_x .我仍然希望有人能提出更好的答案。但这是我会做的:

    图 1:重新调整的值和 scale='free_x
    enter image description here

    代码 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 为滚动条腾出空间。足够大。

    plotly 2: scales='free'和足够大的宽度:

    enter image description here

    代码 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
    enter image description here

    代码 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

    关于r - 使用 facet_wrap 和 ggplotly 的第一个和最后一个方面比中间方面大，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/61580973/

    上一篇：c# - Topshelf 与 .net 核心 worker 服务

    下一篇：google-apps-script - G Suite 插件拒绝连接到驱动器？如何解决 "drive.google.com refused to connect"错误？

    相关文章：

    r - 根据 ggplot2 分组对条形进行着色和阴影/纹理

    r - 如何为 R Plotly 表添加标题

    删除 R 中 ggplot2 中的单个 x 轴刻度线？

    r - ggplot2 图例 2 行

    javascript - 在 plot.ly 中将 y 轴格式化为百分比

    python - 单击 matplotlib(或可能是 plotly)中的阶梯图子图点时如何使标 checkout 现？

    sql - 从多边形区域中提取的邻居列表

    r - 具有多个自变量的单变量逻辑回归后，将系数、置信区间和优势比存储在一个数据框中

    r - R中有没有办法改变累积减法来更新相同的变异变量？

    r - 最大似然估计量的准确性

    ©2024 IT工具网  联系我们