предупреждение renderUI: длина логического индекса должна быть 1 или (длина данных), а не 0 - PullRequest
0 голосов
/ 01 ноября 2019

Я получаю предупреждение «Эстетика должна иметь длину 1 или ту же длину, что и данные (1)», когда я использую renderUI в программе «Сверкающий», чтобы выбрать значения для подмножества моих данных для построения. Он запускается в shinyapps, но в shinyapp.io ненадолго появляется предупреждение. https://nic01a.shinyapps.io/testUI/

Когда я не использую renderUI, я не получаю никаких предупреждений (см. Раздел с комментариями о пользовательском интерфейсе в коде).

При выполнении в RStudio появляется сообщение об ошибке / предупреждение "Эстетика"должен иметь длину 1 или совпадать с данными (1): x, y, color, linetype "появляется в консоли. У меня было «Длина логического индекса должна быть 1 или 1188 (строки данных), а не 0» для другого блестящего кода с той же проблемой.

Я думаю, что это связано с тем, как я использую renderUI в блестящем.

library(shiny)
library(shinythemes)
library(ggplot2)
library(ggthemes)
library(dplyr)
library(plotly)
library(shinycustomloader)

ui <- fluidPage(

titlePanel("Aesthetics must be either length 1 or the same as the data (1)"),

    sidebarLayout(position = "right",
       sidebarPanel(
          sliderInput("yr","Year:",
                min = 1997, max = 2018,
                value = c(2001,2018), sep = "") ,
          selectInput("loc", "Jurisdiction",
                c("Aus", "ACT", "NSW", "NT",
                "Qld", "Tas", "SA", "Vic", "WA"),"Aus") ,
          radioButtons("DropAllB", "Variable for dropdown list:",
                       choices = c(
                          "Type",
                          "Sex"
                       ),inline = T,
                       selected = c("Type")
          ),
############# This line might be a problem??? ############
          uiOutput("AllBControl")

##### This below works without error or warning #####
          # selectInput("x", "Sex",
          #     c("All"="All", "Females"="Female", "Males"="Male"),"All") ,
          # checkboxGroupInput("int", "Type",
          #  c("Accidental","All types"),"All types")
######################################################

       ) ,
      mainPanel(
   #Show a plot
         withLoader(plotlyOutput("test", width = "100%", height = "600px"), type = "html", loader = "loader4")
      )
   )
)

# Define server logic
server <- function(input, output, session) {

########### this section below might be the problem??? #############
  observe({
    if (input$DropAllB == "Type")
      x <- selectInput("int", label = NULL,
                       choices = c("All types", "Accidental"), selected = c("All types") )
    if (input$DropAllB == "Sex")
      x <- selectInput("x", label = NULL,
                       choices = c("All", "Female", "Male"), selected = c("All") )

    if (input$DropAllB == "Sex")
      y <- checkboxGroupInput(
        "int", "Type:",
        c("All types", "Accidental"),
        selected = c("All types", "Accidental")  )
    if (input$DropAllB == "Type")
      y <- checkboxGroupInput("x", "Sex:",
                              choices = c("Male", "Female", "All"),
                              selected = c("Male", "Female", "All"))

    output$AllBControl <- renderUI({
      tagList(x,y)
    })
######################################################################

     output$test <- renderPlotly({
        df <- readRDS("test.rds")
        plotdata <- subset(df, subset=(location %in% input$loc & 
                  sex %in% input$x & type %in% input$int))

       p <- ggplot(plotdata) + 
         aes(x = year, y = n, colour=sex, linetype=type, group=1,
             text = paste0(
                "Year: ", year,
                "<br>Number: ", n,
                "<br>Sex: ", sex,
                "<br>Location: ", location)) +
         geom_line() + xlim(input$yr) +
         scale_color_manual(values = c("All"="black", "Male"="blue", "Female"="red")) +
         scale_linetype_manual(values = c("All types"="solid", "Accidental"="twodash"))

       ggplotly(p, tooltip = "text")
   })
})
}

shinyApp(ui = ui, server = server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...