我找到了一个黑客来获得所需的输出,我将其发布在这里是为了其他人的利益。
library(plotly)
data <- data.frame(name = c('test1', 'test2', 'test3', 'test4'),
x = c(1, 15, 90, 45),
y = c(9, 43, 43, 53),
size = c(10000, 50000, 90000, 3000),
colour = c("rgba(230, 42, 56, 0.3)", "rgba(76, 175, 80, 0.3)",
"rgba(32, 169, 242, 0.3)", "rgba(255, 193, 7, 0.3)")
)
#Ranges
xmin <- - 0.2 * max(data[['x']])
xmax <- 1.8 * max(data[['x']])
ymin <- - 0.2 * max(data[['y']])
ymax <- 1.8 * max(data[['y']])
# Sum of the size variable
sum_size <- sum(data[['size']], na.rm = TRUE)
# Decimal size
data$size <- (data[['size']]/sum_size)
# Adjust for the smallest
data <- data %>% mutate(size = ifelse(size < 0.05, 0.05, size))
#Size Vector
size <- data$size * 100
# not used atm
min_size <- min(data$size, na.rm = TRUE)
max_size <- max(data$size, na.rm = TRUE)
# Number of unique groups
num_bubbles <- length(unique(data[['name']]))
# Artifical data used to resolve legend sizes
data2 <- data
data2$size <- min_size
data2[['x']] <- -2 * max(-xmin,-ymin)
data2[['y']] <- -2 * max(-xmin,-ymin)
# Bind the artifial data, plotly will only plot the original and this fixes the legend size issue
data <- rbind(data, data2)
plot <- plot_ly(data = data) %>%
add_trace(x = data[['x']],
y = data[['y']],
mode = 'markers',
type = 'scatter',
color = data[['name']],
marker = list(size = 10,
opacity = 1,sizemin=10,sizemax =100,sizeref = 100,
line = list(width = 2)),size = 30,showlegend=T,
hoverinfo = "text") %>%
add_trace( x = -2 * max(-xmin,-ymin) , y = -2 * max(-xmin,-ymin), type = "scatter", mode = "markers",
color= data[['name']], showlegend=F) %>% config(modeBarButtonsToRemove = list("sendDataToCloud","pan2d","select2d","lasso2d","zoomIn2d","zoomOut2d","autoScale2d","resetScale2d","hoverClosestCartesian","hoverCompareCartesian"), displaylogo = FALSE, doubleClick = "reset")
plot <- layout(plot,
title = NULL,
xaxis = list(
title = 'x',
range = c(xmin,xmax),
showgrid = F
),
yaxis = list(
title = 'y',
range = c(ymin,ymax)
))
plot <- plotly_build(plot)
for(i in seq(1,num_bubbles))
{
plot$x$data[[i]]$marker$size <- c(size[i]*10000,min(size)*10000)
}