在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）转换为交互式图（ip），可以在Shiny应用中使用。我现在注意到交互式情节（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
)

server.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