r - 在 ggplotly 中保持 x 和 y 比例相同(所以方形图)

Question

我创建了一个具有相同 x 和 y 限制、相同 x 和 y 刻度比例的图，因此保证实际图是完美的正方形。即使包含图例，下面的代码似乎也能保持静态图(sp 对象)本身完美的正方形，即使它所在的窗口被重新缩放:

library(ggplot2)
library(RColorBrewer)
set.seed(1)
x = abs(rnorm(30))
y = abs(rnorm(30))
value = runif(30, 1, 30)
myData <- data.frame(x=x, y=y, value=value)
cutList = c(5, 10, 15, 20, 25)
purples <- brewer.pal(length(cutList)+1, "Purples")
myData$valueColor <- cut(myData$value, breaks=c(0, cutList, 30), labels=rev(purples))
sp <- ggplot(myData, aes(x=x, y=y, fill=valueColor)) + geom_polygon(stat="identity") + scale_fill_manual(labels = as.character(c(0, cutList)), values = levels(myData$valueColor), name = "Value") + coord_fixed(xlim = c(0, 2.5), ylim = c(0, 2.5))

但是，我现在尝试通过 ggplotly() 将此静态图 (sp) 转换为可在 Shiny 应用程序中使用的交互式图 (ip)。我现在注意到交互图 (ip) 不再是方形的。显示这一点的 MWE 如下:

ui.R

library(shinydashboard)
library(shiny)
library(plotly)
library(ggplot2)
library(RColorBrewer)

sidebar <- dashboardSidebar(
  width = 180,
  hr(),
  sidebarMenu(id="tabs",
    menuItem("Example plot", tabName="exPlot", selected=TRUE)
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "exPlot",
      fluidRow(
        column(width = 8,
          box(width = NULL, plotlyOutput("exPlot"), collapsible = FALSE, background = "black", title = "Example plot", status = "primary", solidHeader = TRUE))))))

dashboardPage(
  dashboardHeader(title = "Title", titleWidth = 180),
  sidebar,
  body
)

服务器.R

library(shinydashboard)
library(shiny)
library(plotly)
library(ggplot2)
library(RColorBrewer)

set.seed(1)
x = abs(rnorm(30))
y = abs(rnorm(30))
value = runif(30, 1, 30)

myData <- data.frame(x=x, y=y, value=value)

cutList = c(5, 10, 15, 20, 25)
purples <- brewer.pal(length(cutList)+1, "Purples")
myData$valueColor <- cut(myData$value, breaks=c(0, cutList, 30), labels=rev(purples))

# Static plot
sp <- ggplot(myData, aes(x=x, y=y, fill=valueColor)) + geom_polygon(stat="identity") + scale_fill_manual(labels = as.character(c(0, cutList)), values = levels(myData$valueColor), name = "Value") + coord_fixed(xlim = c(0, 2.5), ylim = c(0, 2.5))

# Interactive plot
ip <- ggplotly(sp, height = 400)

shinyServer(function(input, output, session){

  output$exPlot <- renderPlotly({
    ip
  })

})

目前似乎可能没有内置/明确的解决方案( Keep aspect ratio when using ggplotly )。我还读过有关 HTMLwidget.resize 对象的信息，它可能有助于解决这样的问题( https://github.com/ropensci/plotly/pull/223/files#r47425101 )，但我未能成功确定如何将此类语法应用于当前问题。

如有任何建议，我们将不胜感激!

Answer 1

我尝试玩 fixed axis ratio没有效果。

设置绘图边距来创建方形图对我有用。

即使轴范围发生变化，绘图也保持正方形。

当轴比应该相同时(即单位是正方形但绘图不是)，需要稍微调整代码(答案将很快更新)。

library(ggplot2)
library(RColorBrewer)
set.seed(1)
x = abs(rnorm(30))
y = abs(rnorm(30))
value = runif(30, 1, 30)
myData <- data.frame(x=x, y=y, value=value)
cutList = c(5, 10, 15, 20, 25)
purples <- brewer.pal(length(cutList)+1, "Purples")
myData$valueColor <- cut(myData$value, breaks=c(0, cutList, 30), labels=rev(purples))
sp <- ggplot(myData, aes(x=x, y=y, fill=valueColor)) + geom_polygon(stat="identity") + scale_fill_manual(labels = as.character(c(0, cutList)), values = levels(myData$valueColor), name = "Value") + coord_fixed(xlim = c(0, 2.5), ylim = c(0, 2.5))
sp

#set the height and width of the plot (including legends, etc.)
height <- 500
width <- 500
ip <- ggplotly(sp, height = height, width = width)

#distance of legend
margin_layout <- 100
#minimal distance from the borders
margin_min <- 50

#calculate the available size for the plot itself
available_width <- width - margin_min - margin_layout
available_height <- height - 2 * margin_min

if (available_width > available_height) {
  available_width <- available_height
} else {
  available_height <- available_width
}
#adjust the plot margins
margin <- list(b=(height - available_height) / 2,
               t=(height - available_height) / 2,
               l=(width - available_width) / 2 - (margin_layout - margin_min),
               r=(width - available_width) / 2 + (margin_layout - margin_min))

ip <- layout(ip, margin=margin)
ip