Блестящий реактивный selectInput в R - PullRequest
0 голосов
/ 24 марта 2020

У меня есть приложение блестящее, содержащее реактивные данные. Я хотел бы, чтобы приложение выбирало только непустые столбцы для осей X и Y. На данный момент я выбираю между colnames(TD[,3:7]), но есть также пустые значения для столбцов, поэтому я не хочу, чтобы эти столбцы отображались для выбора переменной. Ниже приведен пример и мой код:

type <- as.character(c('summer','summer','summer','summer','winter','winter','winter','winter'))
country <- as.character(c('A','A','B','B','A','A','B','B'))
year <- c(2011,2012,2013,2014,2011,2012,2013,2014)
col1 <- c(33,7,NA,NA,5,11,NA,NA)
col2 <- c(10,3,NA,NA,8,15,NA,NA)
col3 <- c(NA,NA,10,15,NA,NA,20,25)
col4 <- c(NA,NA,8,5,NA,NA,22,16)

TD <- data.frame(type,country,year,col1,col2,col3,col4,stringsAsFactors=FALSE)

library(readxl)
library(shiny)
library(ggplot2)
library(shinythemes)
library(DT)

ui <-shinyUI(fluidPage(pageWithSidebar(
  headerPanel("Test App"),
  sidebarPanel(
    selectInput("type","Choose a type", choices = c("All",unique(TD$type))),
    selectInput("country","Choose an country", choices = c("All",unique(TD$country))),
    selectInput("yaxis", "Choose a y variable", choices = colnames(TD[,3:7])),
    selectInput("xaxis", "Choose a x variable", choices = colnames(TD[,3:7])),
    actionButton("goButton", "Update")
  ),
  mainPanel(
    tabsetPanel(
      tabPanel('Plot', plotOutput("plot1"))
    ))
)
))

server <- shinyServer(function(input,output, session){

  data1 <- reactive({
    if(input$type == "All"){
      TD
    }
    else{
      TD[which(TD$type == input$type),]
    }
  })
  data2 <- eventReactive(input$goButton,{
    if (input$country == "All"){
      TD
    }else{

      TD[which(TD$country == input$country),]
    }
  })

  observe({
    if(input$type != "All"){
      updateSelectInput(session,"country","Choose a country", choices = c("All",unique(data1()$country)))
    }
    else if(input$country != 'All'){
      updateSelectInput(session,"type","Choose a type", choices = c('All',unique(data2()$type)))
    }
    else if (input$type == "All" & input$country == "All"){
      updateSelectInput(session,"country","Choose a country", choices = c('All',unique(TD$country)))
      updateSelectInput(session,"type","Choose a type", choices = c('All',unique(TD$type)))
    }
  })

  data3 <- eventReactive( input$goButton,{
    req(input$goButton)
    req(input$goButton)
    if(input$country == "All"){
      data1()
    }
    else if (input$type == "All"){
      data2()
    }
    else if (input$country == "All" & input$type == "All"){
      TD
    }
    else
    {
      TD[which(TD$country== input$country & TD$type == input$type),]
    }
  })

  x_var<- eventReactive(input$goButton, {
    input$xaxis
  })
  y_var <- eventReactive(input$goButton,{
    input$yaxis
  })

  output$plot1 <- renderPlot({
    x <- x_var()
    y <- y_var()
    p <- ggplot(data3(),aes(x=data3()[,x], y=data3()[,y])) + geom_line() + geom_point()
    p + labs(x = x_var(), y = y_var()) + theme(plot.title = element_text(hjust = 0.5, size=20))
  })
})

shinyApp(ui,server)

enter image description here

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