![](/img/trans.png)
[英]The downloadablePlot Shiny Module breaks down my shiny app upon launching
[英]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.