繁体   English   中英

当我在ggplot中选择特定坐标时,闪亮的应用程序会崩溃

[英]Shiny app breaks down when I choose specific coordinates in a ggplot

我有一个闪亮的应用程序,它在mtcars数据集的选定变量之间创建一个散点图。 如您所见,我已经修改了数据标签,以便在每个点而不是xy坐标中显示汽车类型。 问题是当我点击我的趋势线时,在没有数据的地方 - 如果显示坐标 - 应用程序正在崩溃。 这是一个可重复的例子:

#ui.r
library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

fluidPage(

  # App title ----
  titlePanel(div("CROSS CORRELATION",style = "color:blue")),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(


    ),
    # Main panel for displaying outputs ----
    mainPanel(

      tabsetPanel(type = "tabs",

                  tabPanel("Correlation Plot",

                           fluidRow(
                             column(3, uiOutput("lx1")),
                           column(3,uiOutput("lx2"))),
                           hr(),
                           fluidRow(
                             tags$style(type="text/css",
                                        ".shiny-output-error { visibility: hidden; }",
                                        ".shiny-output-error:before { visibility: hidden; }"
                             )

                           ),
                           fluidRow(
                           plotlyOutput("sc"))
      )

      )
  )))
#server.r
function(input, output) {


  output$lx1<-renderUI({
    selectInput("lx1", label = h4("Select 1st Expression Profile"), 
                choices = colnames(mtcars[,2:5]), 
                selected = "Lex1")
  })
  output$lx2<-renderUI({
    selectInput("lx2", label = h4("Select 2nd Expression Profile"), 
                choices = colnames(mtcars[,2:5]), 
                selected = "Lex2")
  })



  # 1. create reactive values
  vals <- reactiveValues()
  # 2. create df to store clicks
  vals$click_all <- data.frame(x = numeric(),
                               y = numeric(),
                               label = character())
  # 3. add points upon plot click
  observe({
    # get clicked point
    click_data <- event_data("plotly_click", source = "select")
    # get data for current point
    label_data <- data.frame(x = click_data[["x"]],
                             y = click_data[["y"]],
                             label = click_data[["key"]],
                             stringsAsFactors = FALSE)
    # add current point to df of all clicks
    vals$click_all <- merge(vals$click_all,
                            label_data, 
                            all = TRUE)
  }) 

 output$sc<-renderPlotly({
   mtcars$car <- row.names(mtcars)
       p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "car",group="car"))+
         # Change the point options in geom_point
         geom_point(color = "darkblue") +

         # Change the title of the plot (can change axis titles
         # in this option as well and add subtitle)
         labs(title = "Cross Correlation") +
         # Change where the tick marks are
         # Change how the text looks for each element
         theme_bw()+


       geom_smooth(aes(group = 1))+
         # 4. add labels for clicked points
         geom_text(data = vals$click_all,
                   aes(x = x, y = y, label = label),
                   inherit.aes = FALSE, nudge_x = 0.25)

   ggplotly(p1,source = "select", tooltip = c("key")) %>%
     layout(hoverlabel = list(bgcolor = "white", 
                              font = list(family = "Calibri", 
                                          size = 9, 
                                          color = "black")))

 }) 





}

正如你所说,点击趋势线后应用程序崩溃,其中没有与汽车相对应的点。 让我们坚持这种情况。 您收到以下错误:

警告:data.frame中的错误:参数意味着不同的行数:1,0

出现此错误的原因是,在单击趋势线后,存储在click_data变量中的数据框不包含变量key

您尝试通过click_data[["key"]]无论如何都要访问此变量,并且它的输出为NULL因为它不存在。

在下一步中,您要构建一个新的data.frame label_data ,其中label被赋值为NULL ,因此也就是错误。

label_data <- data.frame(x = click_data[["x"]],     # it is fine because it is number
                             y = click_data[["y"]], # also fine
                             label = NULL,          # label gets NULL
                             stringsAsFactors = FALSE)

我们可以简单地重现这个错误

> data.frame(x = 1, y = 1, label = NULL)
Error in data.frame(x = 1, y = 1, label = NULL) : 
  arguments imply differing number of rows: 1, 0

现在我们知道为什么会出现错误,我们可以找到多个解决方案。 其中之一就是先要求

click_data <- event_data("plotly_click", source = "select")

返回一个数据框,如果它不包含key变量,我们将label的值设置为""

label_ <- ifelse(is.null(click_data[["key"]]),
                         yes = "", 
                         no = click_data[["key"]])

那是

observe({

        # get clicked point
        click_data <- event_data("plotly_click", source = "select")


        # Require that click_data is available (does not return NULL)
        req(click_data)

        label_ <- ifelse(is.null(click_data[["key"]]),
                         yes = "", 
                         no = click_data[["key"]])

        # get data for current point
        label_data <- data.frame(x = click_data[["x"]],
                                 y = click_data[["y"]],
                                 label = label_,
                                 stringsAsFactors = FALSE)
        # add current point to df of all clicks
        vals$click_all <- merge(vals$click_all,
                                label_data, 
                                all = TRUE)
    }) 

完整代码:

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(

    # App title ----
    titlePanel(div("CROSS CORRELATION",style = "color:blue")),

    # Sidebar layout with input and output definitions ----
    sidebarLayout(

        # Sidebar panel for inputs ----
        sidebarPanel(


        ),
        # Main panel for displaying outputs ----
        mainPanel(

            tabsetPanel(type = "tabs",

                        tabPanel("Correlation Plot",

                                 fluidRow(
                                     column(3, uiOutput("lx1")),
                                     column(3,uiOutput("lx2"))),
                                 hr(),
                                 fluidRow(
                                     tags$style(type="text/css",
                                                ".shiny-output-error { visibility: hidden; }",
                                                ".shiny-output-error:before { visibility: hidden; }"
                                     )

                                 ),
                                 fluidRow(
                                     plotlyOutput("sc"))
                        )

            )
        )))
#server.r
server <- function(input, output) {

    output$lx1<-renderUI({
        selectInput("lx1", label = h4("Select 1st Expression Profile"), 
                    choices = colnames(mtcars[,2:5]), 
                    selected = "Lex1")
    })
    output$lx2<-renderUI({
        selectInput("lx2", label = h4("Select 2nd Expression Profile"), 
                    choices = colnames(mtcars[,2:5]), 
                    selected = "Lex2")
    })



    # 1. create reactive values
    vals <- reactiveValues()
    # 2. create df to store clicks
    vals$click_all <- data.frame(x = numeric(),
                                 y = numeric(),
                                 label = character())
    # 3. add points upon plot click
    observe({

        # get clicked point
        click_data <- event_data("plotly_click", source = "select")


        # Require that click_data is available (does not return NULL)
        req(click_data)

        label_ <- ifelse(is.null(click_data[["key"]]),
                         yes = "", 
                         no = click_data[["key"]])

        # get data for current point
        label_data <- data.frame(x = click_data[["x"]],
                                 y = click_data[["y"]],
                                 label = label_,
                                 stringsAsFactors = FALSE)
        # add current point to df of all clicks
        vals$click_all <- merge(vals$click_all,
                                label_data, 
                                all = TRUE)
    }) 

    output$sc<-renderPlotly({
        mtcars$car <- row.names(mtcars)
        p1 <- ggplot(mtcars, aes_string(x = input$lx1, y = input$lx2,key = "car",group="car"))+
            # Change the point options in geom_point
            geom_point(color = "darkblue") +

            # Change the title of the plot (can change axis titles
            # in this option as well and add subtitle)
            labs(title = "Cross Correlation") +
            # Change where the tick marks are
            # Change how the text looks for each element
            theme_bw()+


            geom_smooth(aes(group = 1))+
            # 4. add labels for clicked points
            geom_text(data = vals$click_all,
                      aes(x = x, y = y, label = label),
                      inherit.aes = FALSE, nudge_x = 0.25)

        ggplotly(p1,source = "select", tooltip = c("key")) %>%
            layout(hoverlabel = list(bgcolor = "white", 
                                     font = list(family = "Calibri", 
                                                 size = 9, 
                                                 color = "black")))

    }) 
}

shinyApp(ui, server)

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM