感谢这个问题:SO-Q我现在已经了解了如何删除痕迹。在这种情况下,我只是删除0:2,但我可以将其更改为array(O:unique(factor(df$group)))
以删除我的模型在之前的运行中创建的许多组。
然而,我能够弄清楚的是,如何为目标列中的每个因素添加多条迹线,1,并按THECOLORS
library("shiny")
library("plotly")
rock[,2] <- sample(c('A', 'B', 'C'), 48, replace = T)
THECOLORS <- c('#383838', '#5b195b','#1A237E', '#000080', '#224D17', '#cccc00', '#b37400', '#990000')
ui <- fluidPage(
selectInput("dataset", "Choose a dataset:", choices = c("mtcars","rock")),
plotlyOutput("Plot1")
)
server <- function(input, output, session) {
dataSource <- reactive({switch(input$dataset,"rock" = rock,"mtcars" = mtcars)})
output$Plot1 <- renderPlotly({plot_ly(mtcars, x = ~mpg, y = ~hp, type = 'scatter', mode = 'markers', color = as.factor(mtcars$cyl), colors = THECOLORS) })
observeEvent(input$dataset, {
f <- list(
family = "Courier New, monospace",
size = 18,
color = "#7f7f7f"
)
x <- list(
title = "x Axis",
titlefont = f,
range = c(0,(max(dataSource()[,1])+ 0.1*max(dataSource()[,1])))
)
y <- list(
title = "y Axis",
titlefont = f,
range = c(0,(max(dataSource()[,4])+ 0.1*max(dataSource()[,4])))
)
plotlyProxy("Plot1", session) %>%
plotlyProxyInvoke("deleteTraces",array(0:2)) %>%
# lapply(unique(dataSource()[,2], function(x) { data <- dataSource()[which(dataSource()[,2] == x)],
# plotlyProxyInvoke("addTraces",
#
# x = data()[,1],
# y = data()[,4],
# type = 'scatter',
# mode = 'markers')}) %>%
plotlyProxyInvoke("relayout", list(xaxis = x, yaxis = y))
})
}
shinyApp(ui, server)
答案 0 :(得分:1)
基本上,当使用plotlyProxy而不是使用“addTraces”的plotlyProxyInvoke时,“addTraces”用于添加更多跟踪。 您必须创建列表列表,每个内部列表将包含每个跟踪的详细信息。 在你需要添加许多跟踪的情况下,purrr包中的一些函数可能有助于创建定义跟踪的列表列表。
看看下面的代码。这是一个非常简化的示例,仅添加两条跟踪,但列表方法列表就在那里。 关于你对速度的评论,也许你可以只在需要时加载数据,如果你的应用程序概念允许,则可以部分加载......
代码:
library("shiny")
library("plotly")
library(purrr)
ui <- fluidPage(
selectInput("dataset", "Choose a dataset:", choices = c("rock", "mtcars")),
plotlyOutput("Plot1")
)
server <- function(input, output, session) {
output$Plot1 <- renderPlotly({plot_ly(data = rock, x = ~area,
y =~peri, mode = 'markers', type = 'scatter')})
observeEvent(input$dataset, {
if (input$dataset == "rock") {
f <- list(
family = "Courier New, monospace",
size = 18,
color = "#7f7f7f"
)
x <- list(
title = "Area",
titlefont = f,
range = c(0, max(rock$area))
)
y <- list(
title = "Peri/Perm",
titlefont = f,
range = c(0, max(rock$peri))
)
plotlyProxyInvoke(plotlyProxy("Plot1", session), "addTraces", list(list(
x = rock$area,
y = rock$peri,
type = 'scatter',
mode = 'markers',
marker = list(size = 10,
color = 'rgba(255, 182, 193, .9)',
line = list(color = 'rgba(0, 255, 0, .3)',
width = 2))
),
list(
x = rock$area,
y = rock$perm,
type = 'scatter',
mode = 'markers',
marker = list(size = 10,
color = 'rgba(255, 182, 193, .9)',
line = list(color = 'rgba(152, 0, 0, .8)',
width = 2))
))
)
plotlyProxy("Plot1", session) %>%
plotlyProxyInvoke("deleteTraces", list(as.integer(0))) %>%
plotlyProxyInvoke("relayout", list(xaxis = x, yaxis = y))
} else {
f <- list(
family = "Courier New, monospace",
size = 18,
color = "#7f7f7f"
)
x <- list(
title = "hp",
titlefont = f,
range = c(0, max(mtcars$hp))
)
y <- list(
title = "mpg/cyl",
titlefont = f,
range = c(0, max(mtcars$mpg))
)
plotlyProxyInvoke(plotlyProxy("Plot1", session), "addTraces", list(list(
x = mtcars$hp,
y = mtcars$mpg,
type = 'scatter',
mode = 'markers',
marker = list(size = 10,
color = 'rgba(255, 182, 193, .9)',
line = list(color = 'rgba(0, 255, 0, .3)',
width = 2))
),
list(
x = mtcars$hp,
y = mtcars$cyl,
type = 'scatter',
mode = 'markers',
marker = list(size = 10,
color = 'rgba(255, 182, 193, .9)',
line = list(color = 'rgba(152, 0, 0, .8)',
width = 2))
))
)
plotlyProxy("Plot1", session) %>%
plotlyProxyInvoke("deleteTraces", list(as.integer(0))) %>%
plotlyProxyInvoke("relayout", list(xaxis = x, yaxis = y))
}
})
}
shinyApp(ui, server)