[英]R Shiny + plotly : change color of a trace with javascript without affecting markers and legend in multiple plots
[英]Change color of markers of a trace in plotly with plotly proxy without changing the marker size
我正在嘗試使用plotlyproxy
來改變trace
的color
,這有效,但問題是,它還會改變我的標記/ legendmarkers
標記的大小。
很久以前我發現(據我目前的研究表明)仍無法單獨設置圖例標記的大小與圖標記不同。
如果你想要在散點圖中繪制5000點,如果你問我最終得到的是小傳說或巨型情節標記,那就是一場災難。
所以問題是A或B解決方案類型:A:找到一種方法來使用plotlyproxy
而不改變我的legend
marker
size
或B:找到一種方法來分別調整legend
大小,以一種不受影響的方式當plotlyproxy
觸發時
我歡迎那些了解這個圖例大小問題的人的任何反饋。
注意:可能這可以用javascript完成,但如果在這種情況下,我可能需要提供更多關於我正在努力實現的實際應用程序的信息
這是顯示它的虛擬應用程序:
library(plotly)
library(shiny)
library(htmlwidgets)
library(colourpicker)
ui <- fluidPage(
fluidRow(
column(8,
plotlyOutput("plot1")
),
column(2,
colourpicker::colourInput(inputId = 'markercolor', label = 'X',
palette = "limited",
showColour = "background", returnName = TRUE),
selectInput(inputId = 'traceNo', label = 'Trace', choices = c(1:3), selected = 1),
br(),
h5('Switch'),
actionButton(inputId = 'Switch', label = icon('refresh'), style = "color: #f7ad6e; background-color: white; border-color: #f7ad6e;
height: 40px; width: 40px; border-radius: 6px; border-width: 2px; text-align: center; line-height: 50%; padding: 0px; display:block; margin: 2px")
)
)
)
server <- function(input, output, session) {
# values <- reactiveValues()
observeEvent(input$Switch, {
plotlyProxy("plot1", session) %>%
plotlyProxyInvoke("restyle", list(marker = list(color = input$markercolor)), list(as.numeric(input$traceNo)-1))
})
output$plot1 <- renderPlotly({
markersize <- 4
markerlegendsize <- 20
colors <- c('red', 'blue', 'black')
p1 <- plot_ly()
p1 <- add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
p1 <- layout(p1, title = 'mtcars group by cyl with switching colors')
p1 <- plotly_build(p1)
## this is a bit of a hack to change the size of the legend markers to not be equal to the plot marker size.
## it makes a list of 1 size value for each marker in de trace in the plot, and another half of with sizes that are a lot bigger.
## the legend marker size is effectively the average size of all markers of a trace
for(i in seq(1, length(sort(unique(mtcars$cyl) )))) {
length.group <- nrow(mtcars[which(mtcars$cyl == sort(unique(mtcars$cyl))[i]), ])
p1$x$data[[i]]$marker$size <- c(rep(markersize,length.group), rep(c(-markersize+2*markerlegendsize), length.group))
}
p1
})
}
shinyApp(ui, server)
您可以使用shinyJS注入custon javascript代碼。 在這里,我使用一些d3來選擇圖例項並更改它們的大小。 這是非常hacky但不幸的是,據我所知,情節上沒有提供內部解決方案。
library(plotly)
library(shiny)
library(htmlwidgets)
library(colourpicker)
library(shinyjs)
jsCode <- "shinyjs.changelegend = function(){
var paths = d3.select('#plot1').
select('.legend').
select('.scrollbox').
selectAll('.traces').
select('.scatterpts')
.attr('d','M8,0A8,8 0 1,1 0,-8A8,8 0 0,1 8,0Z');}"
ui <- fluidPage(
tags$script(src = "https://d3js.org/d3.v4.min.js"),
useShinyjs(),
extendShinyjs(text = jsCode),
fluidRow(
column(8,
plotlyOutput("plot1")
),
column(2,
colourpicker::colourInput(inputId = 'markercolor', label = 'X',
palette = "limited",
showColour = "background", returnName = TRUE),
selectInput(inputId = 'traceNo', label = 'Trace', choices = c(1:3), selected = 1),
br(),
h5('Switch'),
actionButton(inputId = 'Switch', label = icon('refresh'), style = "color: #f7ad6e; background-color: white; border-color: #f7ad6e;
height: 40px; width: 40px; border-radius: 6px; border-width: 2px; text-align: center; line-height: 50%; padding: 0px; display:block; margin: 2px")
)
),
tags$div(id = "test")
)
server <- function(input, output, session) {
# values <- reactiveValues()
observeEvent(input$Switch, {
plotlyProxy("plot1", session) %>%
plotlyProxyInvoke("restyle", list(marker = list(color = input$markercolor)), list(as.numeric(input$traceNo)-1))
})
observeEvent(input$Switch,{
js$changelegend()
})
output$plot1 <- renderPlotly({
markersize <- 4
markerlegendsize <- 20
colors <- c('red', 'blue', 'black')
p1 <- plot_ly()
p1 <- add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl), colors = colors)
p1 <- layout(p1, title = 'mtcars group by cyl with switching colors')
p1 <- plotly_build(p1)
# this is a bit of a hack to change the size of the legend markers to not be equal to the plot marker size.
# it makes a list of 1 size value for each marker in de trace in the plot, and another half of with sizes that are a lot bigger.
# the legend marker size is effectively the average size of all markers of a trace
for(i in seq(1, length(sort(unique(mtcars$cyl) )))) {
length.group <- nrow(mtcars[which(mtcars$cyl == sort(unique(mtcars$cyl))[i]), ])
p1$x$data[[i]]$marker$size <- c(rep(markersize,length.group), rep(c(-markersize+2*markerlegendsize), length.group))
}
return(p1)
})
}
shinyApp(ui, server)
自定義javascript代碼在jsCode
中定義, jsCode
在extendShinyjs()
初始化。 最后,只要單擊按鈕,就會在js$changelegend()
調用它。
如果你有多個圖並且你想要相同的行為,你可以將plot id作為參數傳遞給js$changelegend()
jsCode
js$changelegend()
並相應地更改jsCode
來處理它。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.