Question

请考虑以下示例，这些示例通过绘制并闪亮而生成3D表面图。

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

在dim（z）1> = dim（z）2的情况下，event_data()输出正确覆盖了整个曲面范围。参见以下示例：

但是，在dim（z）1 2的情况下，event_data()输出仅正确注册dim（z）均为<= dim（z）1，如以下示例所示：

问题：

是否有任何具体的论点可以纠正这种行为？
您能建议解决此问题的任何方法，以便event_data在表面的整个显示范围内正确注册吗？

非常感谢，乔恩

原因当第一维<第二维时，event_data（）未注册整个曲面范围

0 个答案: