有条件显示地块的光泽

时间:2018-09-25 07:38:58

标签: r shiny

我正在尝试创建一个闪亮的应用程序,以允许用户显示他们想要显示的情节类型。

我尝试使用简单的if else语句来显示情节,但是,它似乎不起作用。

是因为我的反应功能吗?

library(shiny)
library(ggplot2)
library(shinyjs)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("File to Plot"),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(

      # Input: Select a file ----
      fileInput('file1', 'Choose CSV File',
                accept=c('text/csv', 
                         'text/comma-separated-values,text/plain', 
                         '.csv')),

      # Horizontal line ----
      tags$hr(),

      checkboxInput('header', 'Header', TRUE),
      radioButtons('sep', 'Separator',
                   c(Comma=',',
                     Semicolon=';',
                     Tab='\t'),
                   ','),
      radioButtons('quote', 'Quote',
                   c(None='',
                     'Double Quote'='"',
                     'Single Quote'="'"),
                   '"'),

      #implementing dropdown column 
      selectInput('xcol', 'X Variable', ""),
      selectInput('ycol', 'Y Variable', "", selected = ""),
      selectInput('color', 'Colour', "", selected = ""),

      tags$hr(),

      checkboxGroupInput("my_choices", "Plots to Display",
                         choices = c("Scatterplot", "CorrMat"), selected = "Scatterplot")

      ),

    # Show a plot of the generated distribution
    mainPanel(
      # Output: Data file ----
      plotOutput('Scatterplot'), #need to add in more plots into the UI
      plotOutput('CorrMat')
    )
  )
)

# Define server logic 
server <- function(input, output, session) {
  # added "session" because updateSelectInput requires it

  data <- reactive({ 
    req(input$file1) ## ?req #  require that the input is available

    inFile <- input$file1 

    # tested with a following dataset: write.csv(mtcars, "mtcars.csv")
    # and                              write.csv(iris, "iris.csv")
    df <- read.csv(inFile$datapath, header = input$header, sep = input$sep,
                   quote = input$quote)

    updateSelectInput(session, inputId = 'xcol', label = 'X Variable',
                      choices = names(df), selected = names(df))
    updateSelectInput(session, inputId = 'ycol', label = 'Y Variable',
                      choices = names(df), selected = names(df)[2])
    updateSelectInput(session, inputId = 'color', label = 'Colour',
                      choices = names(df), selected = names(df)[3])

    return(df)
  })

  # hide plots on start
  hide("Scatterplot");hide("CorrMat")

  output$Scatterplot <- renderPlot({
    ggplot(data = data(), aes_string(x = input$xcol, y = input$ycol, colour = input$color)) + 
      geom_point() +
      theme_bw()
  })

  output$CorrMat <- renderPlot({
    ggplot(data = data(), aes_string(x = input$xcol, y = input$ycol, colour = input$color)) + 
      geom_point() +
      theme_bw()
  })

  observeEvent(input$my_choices,{

    if(is.null(input$my_choices)){
      hide("Scatterplot"); hide("CorrMat")
    }

    else if(length(input$my_choices) == 1){
      if(input$my_choices == "Scatterplot"){
        show("Scatterplot");hide("CorrMat")
      }
      if(input$my_choices == "CorrMat"){
        hide("Scatterplot");show("CorrMat")
      }
    }

    else{

      if(all(c("Scatterplot","CorrMat") %in% input$my_choices)){
        show("Scatterplot");show("CorrMat")
      }
    }
  },ignoreNULL = F)
}

shinyApp(ui, server)

任何.csv文件都可以复制以上代码。非常感谢!

1 个答案:

答案 0 :(得分:2)

您的代码是正确的。您只需要在ui的开头包含此内容即可

ui <- fluidPage(

  useShinyjs(),  # add this

# rest of your ui code
)