Рассмотрим следующие примеры трехмерного графика поверхности, созданного с использованием графика и блестящего изображения.
library(shiny)
library(plotly)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("plotly_event problems"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("vis_type", "Select type of visualisation",
choices = c(
"x and y the same (ok)" = "x_y_same",
"x and y same step but diff length (ok)"= "x_y_same_step",
"x and y same step but diff length 2(fail)"= "x_y_same_step_2",
"x and y diff step but same length (fail)" = "x_y_diff_step",
"x and y diff step but same length 2 (ok)" = "x_y_diff_step_2"
),
selected = "x_y_same"
)
),
# Show a plot of the generated distribution
mainPanel(
plotlyOutput("examples"),
verbatimTextOutput("hover_output")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$examples <- renderPlotly({
if(input$vis_type == "x_y_same"){
x <- seq(0, 1, by = 0.01)
y <- seq(0, 1, by = 0.01)
z <- outer(X = x, Y = y)
cat(file = stderr(),
"vis_type: ", input$vis_type,
". len_x: ", length(x),
";len_y: ", length(y),
"; dim_z: ", dim(z), "\n")
p <- plot_ly(z = ~z) %>%
add_surface()
} else if (input$vis_type == "x_y_same_step") {
x <- seq(0, 2, by = 0.01)
y <- seq(0, 1, by = 0.01)
z <- outer(X = x, Y = y)
cat(file = stderr(),
"vis_type: ", input$vis_type,
". len_x: ", length(x),
";len_y: ", length(y),
"; dim_z: ", dim(z), "\n")
p <- plot_ly(z = ~z) %>%
add_surface()
} else if (input$vis_type == "x_y_diff_step"){
x <- seq(0,1,by= 0.02)
y <- seq(0,1, by = 0.01)
z <- outer(X = x, Y = y)
cat(file = stderr(),
"vis_type: ", input$vis_type,
". len_x: ", length(x),
";len_y: ", length(y),
"; dim_z: ", dim(z), "\n")
p <- plot_ly(z = ~z) %>%
add_surface()
} else if (input$vis_type == "x_y_same_step_2") {
x <- seq(0,1, by = 0.01)
y <- seq(0, 2, by = 0.01)
z <- outer(X = x, Y = y)
cat(file = stderr(),
"vis_type: ", input$vis_type,
". len_x: ", length(x),
";len_y: ", length(y),
"; dim_z: ", dim(z), "\n")
p <- plot_ly(z = ~z) %>%
add_surface()
} else if (input$vis_type == "x_y_diff_step_2"){
x <- seq(0, 1, by = 0.01)
y <- seq(0, 1, by = 0.02)
z <- outer(X = x, Y = y)
cat(file = stderr(),
"vis_type: ", input$vis_type,
". len_x: ", length(x),
";len_y: ", length(y),
"; dim_z: ", dim(z), "\n")
p <- plot_ly(z = ~z) %>%
add_surface()
}
return (p)
})
output$hover_output <- renderPrint({
s <- event_data("plotly_hover")
if (length(s) == 0){
"Move around!"
} else {
as.list(s)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Выводы cat следующие:
vis_type: x_y_same . len_x: 101 ;len_y: 101 ; dim_z: 101 101
vis_type: x_y_same_step . len_x: 201 ;len_y: 101 ; dim_z: 201 101
vis_type: x_y_same_step_2 . len_x: 101 ;len_y: 201 ; dim_z: 101 201
vis_type: x_y_diff_step . len_x: 51 ;len_y: 101 ; dim_z: 51 101
vis_type: x_y_diff_step_2 . len_x: 101 ;len_y: 51 ; dim_z: 101 51
В тех случаях, когда тусклое (z) 1 > = dim (z) 2 , выход event_data() правильно покрывает весь диапазон поверхности.См. Этот пример:
Однако в тех случаях, когда dim (z) 1 2 , выход event_data() правильно регистрируется только для значений, где dim (z) оба <= dim (z) <a href="https://i.stack.imgur.com/nx1JX.png" rel="nofollow noreferrer"> 1 , как в этих примерах:
Вопросы:
- Существуют ли какие-либо конкретные аргументы для заговора, которые исправят это поведение?
- Можете ли вы предложить какие-либо обходные решения этой проблемы, чтобы event_data правильно регистрировалась для всего отображаемого диапазона поверхности?
Большое спасибо, Джон